Add Task Chain + API setup
parent
2baf012345
commit
7935e112ed
2
elm.json
2
elm.json
|
@ -14,9 +14,11 @@
|
||||||
"elm-version": "0.19.0 <= v < 0.20.0",
|
"elm-version": "0.19.0 <= v < 0.20.0",
|
||||||
"dependencies": {
|
"dependencies": {
|
||||||
"elm/core": "1.0.0 <= v < 2.0.0",
|
"elm/core": "1.0.0 <= v < 2.0.0",
|
||||||
|
"elm/http": "2.0.0 <= v < 3.0.0",
|
||||||
"elm/json": "1.0.0 <= v < 2.0.0",
|
"elm/json": "1.0.0 <= v < 2.0.0",
|
||||||
"elm/parser": "1.0.0 <= v < 2.0.0",
|
"elm/parser": "1.0.0 <= v < 2.0.0",
|
||||||
"elm/time": "1.0.0 <= v < 2.0.0",
|
"elm/time": "1.0.0 <= v < 2.0.0",
|
||||||
|
"elm/url": "1.0.0 <= v < 2.0.0",
|
||||||
"micahhahn/elm-safe-recursion": "2.0.0 <= v < 3.0.0",
|
"micahhahn/elm-safe-recursion": "2.0.0 <= v < 3.0.0",
|
||||||
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0"
|
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0"
|
||||||
},
|
},
|
||||||
|
|
|
@ -0,0 +1,175 @@
|
||||||
|
module Internal.Api.Chain exposing (TaskChain, IdemChain, CompleteChain)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# Task chains
|
||||||
|
|
||||||
|
Elm uses a `Task` type to avoid issues that JavaScript deals with, yet the same
|
||||||
|
**callback hell** issue might appear that JavaScript developers often deal with.
|
||||||
|
For this reason, this module helps chain different `Task` types together such
|
||||||
|
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
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Internal.Config.Log exposing (Log)
|
||||||
|
import Internal.Values.Context as Context exposing (APIContext)
|
||||||
|
import Task
|
||||||
|
|
||||||
|
|
||||||
|
type alias Backpacked u a =
|
||||||
|
{ a | messages : List u, logs : List Log }
|
||||||
|
|
||||||
|
|
||||||
|
{-| The TaskChain is a piece in the long chain of tasks that need to be completed.
|
||||||
|
The type defines four variables:
|
||||||
|
|
||||||
|
- `err` value that may arise on an error
|
||||||
|
- `u` the update msg that should be returned
|
||||||
|
- `a` phantom type before executing the chain's context
|
||||||
|
- `b` phantom type after executing the chain's context
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias TaskChain err u a b =
|
||||||
|
APIContext a -> Task.Task (FailedChainPiece err u) (TaskChainPiece u a b)
|
||||||
|
|
||||||
|
|
||||||
|
{-| An IdemChain is a TaskChain that does not influence the chain's context
|
||||||
|
|
||||||
|
- `err` value that may arise on an error
|
||||||
|
- `u` the update msg that should be executed
|
||||||
|
- `a` phantom type before, during and after the chain's context
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias IdemChain err u a =
|
||||||
|
TaskChain err u a a
|
||||||
|
|
||||||
|
|
||||||
|
{-| A CompleteChain is a complete task chain where all necessary information
|
||||||
|
has been defined. In simple terms, whenever a Matrix API call is made, all
|
||||||
|
necessary information for that endpoint:
|
||||||
|
|
||||||
|
1. Was previously known and has been inserted, or
|
||||||
|
2. Was acquired before actually making the API call.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias CompleteChain u =
|
||||||
|
TaskChain Never u {} {}
|
||||||
|
|
||||||
|
|
||||||
|
{-| A TaskChainPiece is a piece that updates the chain's context.
|
||||||
|
|
||||||
|
Once a chain is executed, the process will add the `messages` value to its list
|
||||||
|
of updates, and it will update its context according to the `contextChange`
|
||||||
|
function.
|
||||||
|
|
||||||
|
-}
|
||||||
|
type alias TaskChainPiece u a b =
|
||||||
|
Backpacked u { contextChange : APIContext a -> APIContext b }
|
||||||
|
|
||||||
|
|
||||||
|
{-| A FailedChainPiece initiates an early breakdown of a chain. Unless caught,
|
||||||
|
this halts execution of the chain. The process will add the `messages` value to
|
||||||
|
its list of updates, and it will return the given `err` value for a direct
|
||||||
|
explanation of what went wrong.
|
||||||
|
-}
|
||||||
|
type alias FailedChainPiece err u =
|
||||||
|
Backpacked u { error : err }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Chain two tasks together. The second task will only run if the first one
|
||||||
|
succeeds.
|
||||||
|
-}
|
||||||
|
andThen : TaskChain err u b c -> TaskChain err u a b -> TaskChain err u a c
|
||||||
|
andThen f2 f1 =
|
||||||
|
\context ->
|
||||||
|
f1 context
|
||||||
|
|> Task.andThen
|
||||||
|
(\old ->
|
||||||
|
context
|
||||||
|
|> old.contextChange
|
||||||
|
|> f2
|
||||||
|
|> Task.map
|
||||||
|
(\new ->
|
||||||
|
{ contextChange = old.contextChange >> new.contextChange
|
||||||
|
, logs = List.append old.logs new.logs
|
||||||
|
, messages = List.append old.messages new.messages
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|> Task.mapError
|
||||||
|
(\new ->
|
||||||
|
{ error = new.error
|
||||||
|
, logs = List.append old.logs new.logs
|
||||||
|
, messages = List.append old.messages new.messages
|
||||||
|
}
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| When an error has occurred, "fix" it with an artificial task chain result.
|
||||||
|
-}
|
||||||
|
catchWith : (err -> TaskChainPiece u a b) -> TaskChain err u a b -> TaskChain err u a b
|
||||||
|
catchWith onErr f =
|
||||||
|
onError (\e -> succeed <| onErr e) f
|
||||||
|
|
||||||
|
|
||||||
|
{-| Creates a task that always fails.
|
||||||
|
-}
|
||||||
|
fail : err -> TaskChain err u a b
|
||||||
|
fail e _ =
|
||||||
|
Task.fail { error = e, logs = [], messages = [] }
|
||||||
|
|
||||||
|
|
||||||
|
{-| Optionally run a task that doesn't need to succeed.
|
||||||
|
|
||||||
|
If the provided chain fails, it will be ignored. This way, the chain can be
|
||||||
|
executed without breaking the whole chain if it fails. This can be useful for:
|
||||||
|
|
||||||
|
1. Sending information to the Matrix API and not caring if it actually arrives
|
||||||
|
2. Gaining optional information that might be nice to know, but not necessary
|
||||||
|
|
||||||
|
Consequently, the optional chain cannot add any information that the rest of
|
||||||
|
the chain relies on.
|
||||||
|
|
||||||
|
-}
|
||||||
|
maybe : IdemChain err u a -> IdemChain err2 u a
|
||||||
|
maybe f =
|
||||||
|
{ contextChange = identity
|
||||||
|
, logs = []
|
||||||
|
, messages = []
|
||||||
|
}
|
||||||
|
|> succeed
|
||||||
|
|> always
|
||||||
|
|> onError
|
||||||
|
|> (|>) f
|
||||||
|
|
||||||
|
|
||||||
|
{-| When an error occurs, this function allows the task chain to go down a
|
||||||
|
similar but different route.
|
||||||
|
-}
|
||||||
|
onError : (err -> TaskChain err2 u a b) -> TaskChain err u a b -> TaskChain err2 u a b
|
||||||
|
onError onErr f =
|
||||||
|
\context ->
|
||||||
|
f context
|
||||||
|
|> Task.onError
|
||||||
|
(\old ->
|
||||||
|
{ contextChange = identity
|
||||||
|
, logs = old.logs
|
||||||
|
, messages = old.messages
|
||||||
|
}
|
||||||
|
|> succeed
|
||||||
|
|> andThen (onErr old.error)
|
||||||
|
|> (|>) context
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Creates a task that always succeeds.
|
||||||
|
-}
|
||||||
|
succeed : TaskChainPiece u a b -> TaskChain err u a b
|
||||||
|
succeed piece _ =
|
||||||
|
Task.succeed piece
|
|
@ -0,0 +1,284 @@
|
||||||
|
module Internal.Api.Request exposing
|
||||||
|
( ApiCall, ApiPlan, callAPI, withAttributes
|
||||||
|
, accessToken, withTransactionId
|
||||||
|
, fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
|
||||||
|
, queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
|
||||||
|
)
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
|
||||||
|
# API module
|
||||||
|
|
||||||
|
This module helps describe API requests.
|
||||||
|
|
||||||
|
|
||||||
|
## Plan
|
||||||
|
|
||||||
|
@docs ApiCall, ApiPlan, callAPI, withAttributes
|
||||||
|
|
||||||
|
|
||||||
|
## API attributes
|
||||||
|
|
||||||
|
|
||||||
|
### General attributes
|
||||||
|
|
||||||
|
@docs accessToken, withTransactionId
|
||||||
|
|
||||||
|
|
||||||
|
### Body
|
||||||
|
|
||||||
|
@docs fullBody, bodyBool, bodyInt, bodyString, bodyValue, bodyOpBool, bodyOpInt, bodyOpString, bodyOpValue
|
||||||
|
|
||||||
|
|
||||||
|
### Query parameters
|
||||||
|
|
||||||
|
@docs queryBool, queryInt, queryString, queryOpBool, queryOpInt, queryOpString
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
import Http
|
||||||
|
import Internal.Tools.Json as Json
|
||||||
|
import Internal.Values.Context as Context exposing (APIContext)
|
||||||
|
import Url
|
||||||
|
import Url.Builder as UrlBuilder
|
||||||
|
|
||||||
|
|
||||||
|
{-| The API call is a plan that describes how an interaction is planned with
|
||||||
|
the Matrix API.
|
||||||
|
-}
|
||||||
|
type alias ApiCall ph =
|
||||||
|
{ attributes : List ContextAttr
|
||||||
|
, baseUrl : String
|
||||||
|
, context : APIContext ph
|
||||||
|
, method : String
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Shortcut definition to define a function that bases an APICall on a given
|
||||||
|
APIContext.
|
||||||
|
-}
|
||||||
|
type alias ApiPlan a =
|
||||||
|
APIContext a -> ApiCall a
|
||||||
|
|
||||||
|
|
||||||
|
{-| An attribute maps a given context to an attribute for an API call.
|
||||||
|
-}
|
||||||
|
type alias Attribute a =
|
||||||
|
APIContext a -> ContextAttr
|
||||||
|
|
||||||
|
|
||||||
|
{-| A context attribute describes one aspect of the API call that is to be made.
|
||||||
|
-}
|
||||||
|
type ContextAttr
|
||||||
|
= BodyParam String Json.Value
|
||||||
|
| FullBody Json.Value
|
||||||
|
| Header Http.Header
|
||||||
|
| NoAttr
|
||||||
|
| QueryParam UrlBuilder.QueryParameter
|
||||||
|
| ReplaceInUrl String String
|
||||||
|
| Timeout Float
|
||||||
|
| UrlPath String
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that requires an access token to be present
|
||||||
|
-}
|
||||||
|
accessToken : Attribute { a | accessToken : () }
|
||||||
|
accessToken =
|
||||||
|
Context.getAccessToken
|
||||||
|
>> (++) "Bearer "
|
||||||
|
>> Http.header "Authorization"
|
||||||
|
>> Header
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a boolean value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyBool : String -> Bool -> Attribute a
|
||||||
|
bodyBool key value =
|
||||||
|
bodyValue key <| Json.encode Json.bool value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds an integer value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyInt : String -> Int -> Attribute a
|
||||||
|
bodyInt key value =
|
||||||
|
bodyValue key <| Json.encode Json.int value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a boolean to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpBool : String -> Maybe Bool -> Attribute a
|
||||||
|
bodyOpBool key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyBool key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds an integer value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpInt : String -> Maybe Int -> Attribute a
|
||||||
|
bodyOpInt key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyInt key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a string value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpString : String -> Maybe String -> Attribute a
|
||||||
|
bodyOpString key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyString key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a JSON value to the HTTP body if it is given.
|
||||||
|
-}
|
||||||
|
bodyOpValue : String -> Maybe Json.Value -> Attribute a
|
||||||
|
bodyOpValue key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
bodyValue key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a string value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyString : String -> String -> Attribute a
|
||||||
|
bodyString key value =
|
||||||
|
bodyValue key <| Json.encode Json.string value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that adds a JSON value to the HTTP body.
|
||||||
|
-}
|
||||||
|
bodyValue : String -> Json.Value -> Attribute a
|
||||||
|
bodyValue key value _ =
|
||||||
|
BodyParam key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Create a plan to create an API call.
|
||||||
|
-}
|
||||||
|
callAPI : { method : String, path : List String } -> ApiPlan { a | baseUrl : () }
|
||||||
|
callAPI { method, path } context =
|
||||||
|
{ attributes =
|
||||||
|
path
|
||||||
|
|> List.map Url.percentEncode
|
||||||
|
|> String.join "/"
|
||||||
|
|> (++) "/"
|
||||||
|
|> UrlPath
|
||||||
|
|> List.singleton
|
||||||
|
, baseUrl = Context.getBaseUrl context
|
||||||
|
, context = context
|
||||||
|
, method = method
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an empty attribute that does nothing.
|
||||||
|
-}
|
||||||
|
empty : Attribute a
|
||||||
|
empty =
|
||||||
|
always NoAttr
|
||||||
|
|
||||||
|
|
||||||
|
{-| Adds a JSON value as the HTTP body.
|
||||||
|
-}
|
||||||
|
fullBody : Json.Value -> Attribute a
|
||||||
|
fullBody value _ =
|
||||||
|
FullBody value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a boolean value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryBool : String -> Bool -> Attribute a
|
||||||
|
queryBool key value _ =
|
||||||
|
(if value then
|
||||||
|
"true"
|
||||||
|
|
||||||
|
else
|
||||||
|
"false"
|
||||||
|
)
|
||||||
|
|> UrlBuilder.string key
|
||||||
|
|> QueryParam
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an integer value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryInt : String -> Int -> Attribute a
|
||||||
|
queryInt key value _ =
|
||||||
|
QueryParam <| UrlBuilder.int key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a boolean value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpBool : String -> Maybe Bool -> Attribute a
|
||||||
|
queryOpBool key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryBool key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add an integer value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpInt : String -> Maybe Int -> Attribute a
|
||||||
|
queryOpInt key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryInt key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a string value as a query parameter to the URL if it exists.
|
||||||
|
-}
|
||||||
|
queryOpString : String -> Maybe String -> Attribute a
|
||||||
|
queryOpString key value =
|
||||||
|
case value of
|
||||||
|
Just v ->
|
||||||
|
queryString key v
|
||||||
|
|
||||||
|
Nothing ->
|
||||||
|
empty
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add a string value as a query parameter to the URL.
|
||||||
|
-}
|
||||||
|
queryString : String -> String -> Attribute a
|
||||||
|
queryString key value _ =
|
||||||
|
QueryParam <| UrlBuilder.string key value
|
||||||
|
|
||||||
|
|
||||||
|
{-| Add more attributes to the API plan.
|
||||||
|
-}
|
||||||
|
withAttributes : List (Attribute a) -> ApiPlan a -> ApiPlan a
|
||||||
|
withAttributes attrs f context =
|
||||||
|
f context
|
||||||
|
|> (\data ->
|
||||||
|
{ data
|
||||||
|
| attributes =
|
||||||
|
attrs
|
||||||
|
|> List.map (\attr -> attr data.context)
|
||||||
|
|> List.append data.attributes
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
{-| Attribute that requires a transaction id to be present.
|
||||||
|
-}
|
||||||
|
withTransactionId : Attribute { a | transaction : () }
|
||||||
|
withTransactionId =
|
||||||
|
Context.getTransaction >> ReplaceInUrl "txnId"
|
Loading…
Reference in New Issue