Add HTTP module for Matrix API requests
parent
7935e112ed
commit
2e8185841a
|
|
@ -0,0 +1,57 @@
|
|||
module Internal.Api.Api exposing (..)
|
||||
|
||||
{-|
|
||||
|
||||
|
||||
# API
|
||||
|
||||
The API module is a front-end for implementing API endpoints according to spec.
|
||||
|
||||
-}
|
||||
|
||||
import Internal.Api.Chain as C
|
||||
import Internal.Api.Request as R
|
||||
import Internal.Config.Log exposing (log)
|
||||
import Internal.Tools.Json as Json
|
||||
import Internal.Values.Context exposing (APIContext)
|
||||
import Internal.Values.Vault as V
|
||||
|
||||
|
||||
{-| A TaskChain helps create a chain of HTTP requests.
|
||||
-}
|
||||
type alias TaskChain ph1 ph2 =
|
||||
C.TaskChain R.Error V.VaultUpdate { ph1 | baseUrl : () } { ph2 | baseUrl : () }
|
||||
|
||||
|
||||
request :
|
||||
{ attributes : List (R.Attribute { ph1 | baseUrl : () })
|
||||
, coder : Json.Coder V.VaultUpdate
|
||||
, contextChange : V.VaultUpdate -> (APIContext { ph1 | baseUrl : () } -> APIContext { ph2 | baseUrl : () })
|
||||
, method : String
|
||||
, path : List String
|
||||
}
|
||||
-> TaskChain ph1 ph2
|
||||
request data =
|
||||
R.toChain
|
||||
{ logHttp =
|
||||
\r ->
|
||||
( V.HttpRequest r
|
||||
, String.concat
|
||||
-- TODO: Move this to Internal.Config.Text module
|
||||
[ "Matrix HTTP: "
|
||||
, r.method
|
||||
, " "
|
||||
, r.url
|
||||
]
|
||||
|> log.info
|
||||
|> List.singleton
|
||||
)
|
||||
, coder = data.coder
|
||||
, request =
|
||||
R.callAPI
|
||||
{ method = data.method
|
||||
, path = data.path
|
||||
}
|
||||
|> R.withAttributes data.attributes
|
||||
, toContextChange = data.contextChange
|
||||
}
|
||||
|
|
@ -1,4 +1,7 @@
|
|||
module Internal.Api.Chain exposing (TaskChain, IdemChain, CompleteChain)
|
||||
module Internal.Api.Chain exposing
|
||||
( TaskChain, CompleteChain
|
||||
, IdemChain, toTask
|
||||
)
|
||||
|
||||
{-|
|
||||
|
||||
|
|
@ -13,7 +16,12 @@ that all information is stored and values are dealt with appropriately.
|
|||
Elm's type checking system helps making this system sufficiently rigorous to
|
||||
avoid leaking values passing through the API in unexpected ways.
|
||||
|
||||
@docs TaskChain, IdemChain, CompleteChain
|
||||
@docs TaskChain, CompleteChain
|
||||
|
||||
|
||||
## Finished chain
|
||||
|
||||
@docs IdemChain, toTask
|
||||
|
||||
-}
|
||||
|
||||
|
|
@ -173,3 +181,17 @@ onError onErr f =
|
|||
succeed : TaskChainPiece u a b -> TaskChain err u a b
|
||||
succeed piece _ =
|
||||
Task.succeed piece
|
||||
|
||||
|
||||
{-| Once the chain is complete, turn it into a valid task.
|
||||
-}
|
||||
toTask : IdemChain Never u a -> APIContext a -> Task.Task Never (Backpacked u {})
|
||||
toTask chain context =
|
||||
chain context
|
||||
|> Task.onError (\e -> Task.succeed <| never e.error)
|
||||
|> Task.map
|
||||
(\backpack ->
|
||||
{ messages = backpack.messages
|
||||
, logs = backpack.logs
|
||||
}
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
module Internal.Api.Request exposing
|
||||
( ApiCall, ApiPlan, callAPI, withAttributes
|
||||
, accessToken, withTransactionId
|
||||
( ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
|
||||
, Request, Error(..)
|
||||
, accessToken, withTransactionId, timeout
|
||||
, fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
|
||||
, queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
|
||||
)
|
||||
|
|
@ -15,7 +16,11 @@ This module helps describe API requests.
|
|||
|
||||
## Plan
|
||||
|
||||
@docs ApiCall, ApiPlan, callAPI, withAttributes
|
||||
@docs ApiCall, ApiPlan, Attribute, callAPI, withAttributes, toChain
|
||||
|
||||
Sometimes, APIs might fail. As a result, you may receive an error.
|
||||
|
||||
@docs Request, Error
|
||||
|
||||
|
||||
## API attributes
|
||||
|
|
@ -23,7 +28,7 @@ This module helps describe API requests.
|
|||
|
||||
### General attributes
|
||||
|
||||
@docs accessToken, withTransactionId
|
||||
@docs accessToken, withTransactionId, timeout
|
||||
|
||||
|
||||
### Body
|
||||
|
|
@ -37,9 +42,16 @@ This module helps describe API requests.
|
|||
|
||||
-}
|
||||
|
||||
import Dict
|
||||
import Http
|
||||
import Internal.Api.Chain as C
|
||||
import Internal.Config.Log exposing (Log, log)
|
||||
import Internal.Config.Text as Text
|
||||
import Internal.Tools.Json as Json
|
||||
import Internal.Values.Context as Context exposing (APIContext)
|
||||
import Json.Decode as D
|
||||
import Json.Encode as E
|
||||
import Task
|
||||
import Url
|
||||
import Url.Builder as UrlBuilder
|
||||
|
||||
|
|
@ -52,6 +64,7 @@ type alias ApiCall ph =
|
|||
, baseUrl : String
|
||||
, context : APIContext ph
|
||||
, method : String
|
||||
, path : List String
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -77,8 +90,27 @@ type ContextAttr
|
|||
| NoAttr
|
||||
| QueryParam UrlBuilder.QueryParameter
|
||||
| ReplaceInUrl String String
|
||||
| StatusCodeResponse Int ( Error, List Log )
|
||||
| Timeout Float
|
||||
| UrlPath String
|
||||
|
||||
|
||||
{-| Error indicating that something went wrong.
|
||||
-}
|
||||
type Error
|
||||
= InternetException Http.Error
|
||||
| ServerReturnsBadJSON String
|
||||
|
||||
|
||||
{-| Ordinary shape of an HTTP request.
|
||||
-}
|
||||
type alias Request x a =
|
||||
{ headers : List Http.Header
|
||||
, body : Http.Body
|
||||
, method : String
|
||||
, url : String
|
||||
, resolver : Http.Resolver x a
|
||||
, timeout : Maybe Float
|
||||
}
|
||||
|
||||
|
||||
{-| Attribute that requires an access token to be present
|
||||
|
|
@ -171,19 +203,73 @@ bodyValue key value _ =
|
|||
-}
|
||||
callAPI : { method : String, path : List String } -> ApiPlan { a | baseUrl : () }
|
||||
callAPI { method, path } context =
|
||||
{ attributes =
|
||||
path
|
||||
|> List.map Url.percentEncode
|
||||
|> String.join "/"
|
||||
|> (++) "/"
|
||||
|> UrlPath
|
||||
|> List.singleton
|
||||
{ attributes = []
|
||||
, baseUrl = Context.getBaseUrl context
|
||||
, context = context
|
||||
, method = method
|
||||
, path = path
|
||||
}
|
||||
|
||||
|
||||
{-| Decode the server's response into (hopefully) something meaningful.
|
||||
-}
|
||||
decodeServerResponse : D.Decoder ( a, List Log ) -> String -> Maybe ( Error, List Log ) -> Result ( Error, List Log ) ( a, List Log )
|
||||
decodeServerResponse decoder body statusCodeError =
|
||||
case D.decodeString D.value body of
|
||||
Err e ->
|
||||
let
|
||||
description : String
|
||||
description =
|
||||
D.errorToString e
|
||||
in
|
||||
Err
|
||||
( ServerReturnsBadJSON description
|
||||
, description
|
||||
|> Text.logs.serverReturnedInvalidJSON
|
||||
|> log.error
|
||||
|> List.singleton
|
||||
)
|
||||
|
||||
Ok v ->
|
||||
decodeServerValue decoder v statusCodeError
|
||||
|
||||
|
||||
{-| Decode the server's response, assuming that it parses correctly to
|
||||
a JSON value.
|
||||
-}
|
||||
decodeServerValue : D.Decoder ( a, List Log ) -> Json.Value -> Maybe ( Error, List Log ) -> Result ( Error, List Log ) ( a, List Log )
|
||||
decodeServerValue decoder value statusCodeError =
|
||||
value
|
||||
|> D.decodeValue decoder
|
||||
|> Result.mapError
|
||||
(\err ->
|
||||
let
|
||||
description : String
|
||||
description =
|
||||
D.errorToString err
|
||||
|
||||
-- TODO: Parse errors returned by Matrix API
|
||||
error : Maybe ( Error, List Log )
|
||||
error =
|
||||
Nothing
|
||||
in
|
||||
case ( error, statusCodeError ) of
|
||||
( Just e, _ ) ->
|
||||
e
|
||||
|
||||
( Nothing, Just e ) ->
|
||||
e
|
||||
|
||||
( Nothing, Nothing ) ->
|
||||
( ServerReturnsBadJSON description
|
||||
, description
|
||||
|> Text.logs.serverReturnedUnknownJSON
|
||||
|> log.error
|
||||
|> List.singleton
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
{-| Add an empty attribute that does nothing.
|
||||
-}
|
||||
empty : Attribute a
|
||||
|
|
@ -198,6 +284,158 @@ fullBody value _ =
|
|||
FullBody value
|
||||
|
||||
|
||||
getBody : List ContextAttr -> Json.Value
|
||||
getBody attributes =
|
||||
attributes
|
||||
|> List.filterMap
|
||||
(\attr ->
|
||||
case attr of
|
||||
FullBody v ->
|
||||
Just v
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
)
|
||||
|> List.reverse
|
||||
|> List.head
|
||||
|> Maybe.withDefault
|
||||
(List.filterMap
|
||||
(\attr ->
|
||||
case attr of
|
||||
BodyParam key value ->
|
||||
Just ( key, value )
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
)
|
||||
attributes
|
||||
|> E.object
|
||||
)
|
||||
|
||||
|
||||
getHeaders : List ContextAttr -> List Http.Header
|
||||
getHeaders =
|
||||
List.filterMap
|
||||
(\attr ->
|
||||
case attr of
|
||||
Header h ->
|
||||
Just h
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
)
|
||||
|
||||
|
||||
getQueryParams : List ContextAttr -> List UrlBuilder.QueryParameter
|
||||
getQueryParams =
|
||||
List.filterMap
|
||||
(\attr ->
|
||||
case attr of
|
||||
QueryParam q ->
|
||||
Just q
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
)
|
||||
|
||||
|
||||
getStatusCodes : List ContextAttr -> Dict.Dict Int ( Error, List Log )
|
||||
getStatusCodes =
|
||||
List.filterMap
|
||||
(\attr ->
|
||||
case attr of
|
||||
StatusCodeResponse code err ->
|
||||
Just ( code, err )
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
)
|
||||
>> Dict.fromList
|
||||
|
||||
|
||||
getTimeout : List ContextAttr -> Maybe Float
|
||||
getTimeout =
|
||||
List.filterMap
|
||||
(\attr ->
|
||||
case attr of
|
||||
Timeout f ->
|
||||
Just f
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
)
|
||||
>> List.reverse
|
||||
>> List.head
|
||||
|
||||
|
||||
getUrl : ApiCall a -> String
|
||||
getUrl { attributes, baseUrl, path } =
|
||||
UrlBuilder.crossOrigin
|
||||
baseUrl
|
||||
(path
|
||||
|> List.map
|
||||
(\p ->
|
||||
List.foldl
|
||||
(\attr cp ->
|
||||
case attr of
|
||||
ReplaceInUrl from to ->
|
||||
if from == cp then
|
||||
to
|
||||
|
||||
else
|
||||
cp
|
||||
|
||||
_ ->
|
||||
cp
|
||||
)
|
||||
p
|
||||
attributes
|
||||
)
|
||||
|> List.map Url.percentEncode
|
||||
)
|
||||
(getQueryParams attributes)
|
||||
|
||||
|
||||
{-| Resolve the response of a Matrix API call.
|
||||
-}
|
||||
rawApiCallResolver : Json.Coder a -> Dict.Dict Int ( Error, List Log ) -> Http.Resolver ( Error, List Log ) ( a, List Log )
|
||||
rawApiCallResolver coder statusCodeErrors =
|
||||
Http.stringResolver
|
||||
(\response ->
|
||||
case response of
|
||||
Http.BadUrl_ s ->
|
||||
Http.BadUrl s
|
||||
|> InternetException
|
||||
|> Tuple.pair
|
||||
|> (|>) []
|
||||
|> Err
|
||||
|
||||
Http.Timeout_ ->
|
||||
Http.Timeout
|
||||
|> InternetException
|
||||
|> Tuple.pair
|
||||
|> (|>) []
|
||||
|> Err
|
||||
|
||||
Http.NetworkError_ ->
|
||||
Http.NetworkError
|
||||
|> InternetException
|
||||
|> Tuple.pair
|
||||
|> (|>) []
|
||||
|> Err
|
||||
|
||||
Http.BadStatus_ metadata body ->
|
||||
statusCodeErrors
|
||||
|> Dict.get metadata.statusCode
|
||||
|> decodeServerResponse (Json.decode coder) body
|
||||
|
||||
Http.GoodStatus_ metadata body ->
|
||||
statusCodeErrors
|
||||
|> Dict.get metadata.statusCode
|
||||
|> decodeServerResponse (Json.decode coder) body
|
||||
)
|
||||
|
||||
|
||||
{-| Add a boolean value as a query parameter to the URL.
|
||||
-}
|
||||
queryBool : String -> Bool -> Attribute a
|
||||
|
|
@ -262,6 +500,54 @@ queryString key value _ =
|
|||
QueryParam <| UrlBuilder.string key value
|
||||
|
||||
|
||||
timeout : Float -> Attribute a
|
||||
timeout f _ =
|
||||
Timeout f
|
||||
|
||||
|
||||
{-| Transform an APICall to a TaskChain.
|
||||
-}
|
||||
toChain :
|
||||
{ logHttp : Request ( Error, List Log ) ( update, List Log ) -> ( update, List Log )
|
||||
, coder : Json.Coder update
|
||||
, request : ApiPlan ph1
|
||||
, toContextChange : update -> (APIContext ph1 -> APIContext ph2)
|
||||
}
|
||||
-> C.TaskChain Error update ph1 ph2
|
||||
toChain data apiContext =
|
||||
data.request apiContext
|
||||
|> (\call ->
|
||||
let
|
||||
r : Request ( Error, List Log ) ( update, List Log )
|
||||
r =
|
||||
{ method = call.method
|
||||
, headers = getHeaders call.attributes
|
||||
, url = getUrl call
|
||||
, body = Http.jsonBody (getBody call.attributes)
|
||||
, resolver = rawApiCallResolver data.coder (getStatusCodes call.attributes)
|
||||
, timeout = getTimeout call.attributes
|
||||
}
|
||||
in
|
||||
case data.logHttp r of
|
||||
( httpU, httpLogs ) ->
|
||||
Http.task r
|
||||
|> Task.map
|
||||
(\( u, logs ) ->
|
||||
{ contextChange = data.toContextChange u
|
||||
, logs = List.append httpLogs logs
|
||||
, messages = [ httpU, u ]
|
||||
}
|
||||
)
|
||||
|> Task.mapError
|
||||
(\( err, logs ) ->
|
||||
{ error = err
|
||||
, logs = List.append httpLogs logs
|
||||
, messages = [ httpU ]
|
||||
}
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
{-| Add more attributes to the API plan.
|
||||
-}
|
||||
withAttributes : List (Attribute a) -> ApiPlan a -> ApiPlan a
|
||||
|
|
|
|||
|
|
@ -0,0 +1,39 @@
|
|||
module Internal.Api.Task exposing (..)
|
||||
|
||||
import Internal.Api.Chain as C
|
||||
import Internal.Api.Request as Request
|
||||
import Internal.Config.Log exposing (Log)
|
||||
import Internal.Values.Context exposing (APIContext)
|
||||
import Internal.Values.Envelope exposing (EnvelopeUpdate(..))
|
||||
import Internal.Values.Room exposing (RoomUpdate(..))
|
||||
import Internal.Values.Vault exposing (VaultUpdate(..))
|
||||
import Task
|
||||
|
||||
|
||||
{-| A Backpack is the ultimate message type that gets sent back by the Elm
|
||||
runtime, which can be accessed, viewed and inspected.
|
||||
-}
|
||||
type alias Backpack =
|
||||
{ messages : List (EnvelopeUpdate VaultUpdate), logs : List Log }
|
||||
|
||||
|
||||
{-| A Task is a task that is ready to be sent to the outside world.
|
||||
-}
|
||||
type alias Task =
|
||||
C.TaskChain Never (EnvelopeUpdate VaultUpdate) {} {}
|
||||
|
||||
|
||||
{-| An UnFinished Task that is used somewhere else in this module to write a
|
||||
complete Task type.
|
||||
-}
|
||||
type alias UFTask a b =
|
||||
C.TaskChain Request.Error (EnvelopeUpdate VaultUpdate) a b
|
||||
|
||||
|
||||
{-| Transform a completed task into a Cmd.
|
||||
-}
|
||||
run : (Backpack -> msg) -> Task -> APIContext {} -> Cmd msg
|
||||
run toMsg task context =
|
||||
context
|
||||
|> C.toTask task
|
||||
|> Task.perform toMsg
|
||||
|
|
@ -535,7 +535,11 @@ leakingValueFound leaking_value =
|
|||
happened. Most of these unexpected results, are taken account of by the Elm SDK,
|
||||
but logged so that the programmer can do something about it.
|
||||
-}
|
||||
logs : { keyIsNotAnInt : String -> String }
|
||||
logs :
|
||||
{ keyIsNotAnInt : String -> String
|
||||
, serverReturnedInvalidJSON : String -> String
|
||||
, serverReturnedUnknownJSON : String -> String
|
||||
}
|
||||
logs =
|
||||
{ keyIsNotAnInt =
|
||||
\key ->
|
||||
|
|
@ -544,6 +548,8 @@ logs =
|
|||
, key
|
||||
, "` that cannot be converted to an Int"
|
||||
]
|
||||
, serverReturnedInvalidJSON = (++) "The server returned invalid JSON: "
|
||||
, serverReturnedUnknownJSON = (++) "The server returned JSON that doesn't seem to live up to spec rules: "
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -33,6 +33,8 @@ Rooms are environments where people can have a conversation with each other.
|
|||
-}
|
||||
|
||||
import FastDict as Dict exposing (Dict)
|
||||
import Internal.Api.Request as Request
|
||||
import Internal.Config.Log exposing (Log)
|
||||
import Internal.Config.Text as Text
|
||||
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
|
||||
import Internal.Tools.Json as Json
|
||||
|
|
@ -52,6 +54,7 @@ based on new information provided by the Matrix API.
|
|||
-}
|
||||
type VaultUpdate
|
||||
= CreateRoomIfNotExists String
|
||||
| HttpRequest (Request.Request ( Request.Error, List Log ) ( VaultUpdate, List Log ))
|
||||
| MapRoom String Room.RoomUpdate
|
||||
| More (List VaultUpdate)
|
||||
| SetAccountData String Json.Value
|
||||
|
|
@ -126,6 +129,11 @@ update vu vault =
|
|||
(Maybe.withDefault (Room.init roomId) >> Maybe.Just)
|
||||
vault
|
||||
|
||||
-- The HTTP request currently isn't used anywhere other than for
|
||||
-- auditing the requests that the Vault is making
|
||||
HttpRequest _ ->
|
||||
vault
|
||||
|
||||
MapRoom roomId ru ->
|
||||
mapRoom roomId (Room.update ru) vault
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue