Add Task Chain + API setup

4-compiler-bug
Bram 2024-05-10 15:26:18 +02:00
parent 2baf012345
commit 7935e112ed
3 changed files with 461 additions and 0 deletions

View File

@ -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"
}, },

175
src/Internal/Api/Chain.elm Normal file
View File

@ -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

View File

@ -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"