Add Task Chain + API setup

elm.json

@@ -14,9 +14,11 @@
     "elm-version": "0.19.0 <= v < 0.20.0",
     "dependencies": {
         "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/parser": "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",
         "miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0"
     },

src/Internal/Api/Chain.elm

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

src/Internal/Api/Request.elm

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