Refactor Context

4-compiler-bug
Bram 2024-05-22 19:12:34 +02:00
parent b6e4396138
commit 3ee6debf44
3 changed files with 132 additions and 96 deletions

View File

@ -31,6 +31,7 @@ import Internal.Api.Request as R
import Internal.Config.Log exposing (Log, log)
import Internal.Tools.Json as Json
import Internal.Values.Context as Context exposing (APIContext, Versions)
import Internal.Values.Envelope as E
import Internal.Values.Vault as V
import Recursion
import Set
@ -39,7 +40,7 @@ import Set
{-| A TaskChain helps create a chain of HTTP requests.
-}
type alias TaskChain ph1 ph2 =
C.TaskChain R.Error V.VaultUpdate { ph1 | baseUrl : () } { ph2 | baseUrl : () }
C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) { ph1 | baseUrl : () } { ph2 | baseUrl : () }
{-| Make an HTTP request that adheres to the Matrix spec rules.
@ -47,17 +48,17 @@ type alias TaskChain ph1 ph2 =
request :
{ attributes : List (R.Attribute { ph1 | baseUrl : () })
, coder : Json.Coder returnValue
, contextChange : V.VaultUpdate -> (APIContext { ph1 | baseUrl : () } -> APIContext { ph2 | baseUrl : () })
, contextChange : returnValue -> (APIContext { ph1 | baseUrl : () } -> APIContext { ph2 | baseUrl : () })
, method : String
, path : List String
, toUpdate : returnValue -> ( V.VaultUpdate, List Log )
, toUpdate : returnValue -> ( E.EnvelopeUpdate V.VaultUpdate, List Log )
}
-> TaskChain ph1 ph2
request data =
R.toChain
{ logHttp =
\r ->
( V.HttpRequest r
( E.HttpRequest r
, String.concat
-- TODO: Move this to Internal.Config.Text module
[ "Matrix HTTP: "

View File

@ -423,64 +423,6 @@ onStatusCode code err _ =
)
{-| Resolve the response of a Matrix API call.
-}
rawApiCallResolver : Json.Coder a -> (a -> ( b, List Log )) -> Dict.Dict Int ( Error, List Log ) -> Http.Resolver ( Error, List Log ) ( b, List Log )
rawApiCallResolver coder f 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
|> D.map
(\( u, l ) ->
case f u of
( u2, l2 ) ->
( u2, List.append l l2 )
)
)
body
Http.GoodStatus_ metadata body ->
statusCodeErrors
|> Dict.get metadata.statusCode
|> decodeServerResponse
(Json.decode coder
|> D.map
(\( u, l ) ->
case f u of
( u2, l2 ) ->
( u2, List.append l l2 )
)
)
body
)
{-| Add a boolean value as a query parameter to the URL.
-}
queryBool : String -> Bool -> Attribute a
@ -545,6 +487,46 @@ queryString key value _ =
QueryParam <| UrlBuilder.string key value
{-| Resolve the response of a Matrix API call.
-}
rawApiCallResolver : D.Decoder ( a, List Log ) -> Dict.Dict Int ( Error, List Log ) -> Http.Resolver ( Error, List Log ) ( a, List Log )
rawApiCallResolver decoder 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 decoder body
Http.GoodStatus_ metadata body ->
statusCodeErrors
|> Dict.get metadata.statusCode
|> decodeServerResponse decoder body
)
{-| Configure the HTTP request to time out after a given expiry time.
-}
timeout : Float -> Attribute a
@ -558,7 +540,7 @@ toChain :
{ logHttp : Request ( Error, List Log ) ( update, List Log ) -> ( update, List Log )
, coder : Json.Coder httpOut
, request : ApiPlan ph1
, toContextChange : update -> (APIContext ph1 -> APIContext ph2)
, toContextChange : httpOut -> (APIContext ph1 -> APIContext ph2)
, toUpdate : httpOut -> ( update, List Log )
}
-> C.TaskChain Error update ph1 ph2
@ -566,25 +548,47 @@ toChain data apiContext =
data.request apiContext
|> (\call ->
let
r : Request ( Error, List Log ) ( update, List Log )
r : Request ( Error, List Log ) ( httpOut, List Log )
r =
{ method = call.method
, headers = getHeaders call.attributes
, url = getUrl call
, body = Http.jsonBody (getBody call.attributes)
, resolver = rawApiCallResolver data.coder data.toUpdate (getStatusCodes call.attributes)
, resolver = rawApiCallResolver (Json.decode data.coder) (getStatusCodes call.attributes)
, timeout = getTimeout call.attributes
}
logR : Request ( Error, List Log ) ( update, List Log )
logR =
{ method = call.method
, headers = getHeaders call.attributes
, url = getUrl call
, body = Http.jsonBody (getBody call.attributes)
, resolver =
rawApiCallResolver
(Json.decode data.coder
|> D.map
(\( out, logs ) ->
case data.toUpdate out of
( u, uLogs ) ->
( u, List.append logs uLogs )
)
)
(getStatusCodes call.attributes)
, timeout = getTimeout call.attributes
}
in
case data.logHttp r of
case data.logHttp logR of
( httpU, httpLogs ) ->
Http.task r
|> Task.map
(\( u, logs ) ->
{ contextChange = data.toContextChange u
, logs = List.append httpLogs logs
, messages = [ httpU, u ]
}
(\( httpO, logs ) ->
case data.toUpdate httpO of
( u, uLogs ) ->
{ contextChange = data.toContextChange httpO
, logs = List.concat [ httpLogs, logs, uLogs ]
, messages = [ httpU, u ]
}
)
|> Task.mapError
(\( err, logs ) ->

View File

@ -1,6 +1,6 @@
module Internal.Values.Context exposing
( Context, init, coder, encode, decoder
, APIContext, apiFormat
, APIContext, apiFormat, fromApiFormat
, setAccessToken, getAccessToken
, setBaseUrl, getBaseUrl
, setTransaction, getTransaction
@ -22,7 +22,7 @@ the Matrix API.
Once the API starts needing information, that's when we use the APIContext type
to build the right environment for the API communication to work with.
@docs APIContext, apiFormat
@docs APIContext, apiFormat, fromApiFormat
Once the APIContext is ready, there's helper functions for each piece of
information that can be inserted.
@ -52,6 +52,7 @@ information that can be inserted.
import Internal.Config.Leaks as L
import Internal.Config.Text as Text
import Internal.Tools.Json as Json
import Json.Encode as E
import Set exposing (Set)
@ -61,12 +62,12 @@ static and hence can be passed on easily.
type alias Context =
{ accessToken : Maybe String
, baseUrl : Maybe String
, experimental : Maybe (Set String)
, password : Maybe String
, refreshToken : Maybe String
, username : Maybe String
, serverName : String
, transaction : Maybe String
, versions : Maybe (List String)
, username : Maybe String
, versions : Maybe Versions
}
@ -97,13 +98,18 @@ apiFormat context =
, baseUrl = context.baseUrl |> Maybe.withDefault L.baseUrl
, context = context
, transaction = context.transaction |> Maybe.withDefault L.transaction
, versions =
{ versions = context.versions |> Maybe.withDefault L.versions
, unstableFeatures = context.experimental |> Maybe.withDefault Set.empty
}
, versions = context.versions |> Maybe.withDefault L.versions
}
{-| Get the original context that contains all values from before any were
gotten from the Matrix API.
-}
fromApiFormat : APIContext a -> Context
fromApiFormat (APIContext c) =
c.context
{-| Define how a Context can be encoded to and decoded from a JSON object.
-}
coder : Json.Coder Context
@ -127,13 +133,6 @@ coder =
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "experimental"
, toField = .experimental
, description = Text.fields.context.experimental
, coder = Json.set Json.string
}
)
(Json.field.optional.value
{ fieldName = "password"
, toField = .password
@ -148,10 +147,10 @@ coder =
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "username"
, toField = .username
, description = Text.fields.context.username
(Json.field.required
{ fieldName = "serverName"
, toField = .serverName
, description = Text.fields.context.serverName
, coder = Json.string
}
)
@ -162,11 +161,18 @@ coder =
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "username"
, toField = .username
, description = Text.fields.context.username
, coder = Json.string
}
)
(Json.field.optional.value
{ fieldName = "versions"
, toField = .versions
, description = Text.fields.context.versions
, coder = Json.list Json.string
, coder = versionsCoder
}
)
@ -187,15 +193,15 @@ encode =
{-| A basic, untouched version of the Context, containing no information.
-}
init : Context
init =
init : String -> Context
init sn =
{ accessToken = Nothing
, baseUrl = Nothing
, experimental = Nothing
, refreshToken = Nothing
, password = Nothing
, username = Nothing
, serverName = sn
, transaction = Nothing
, username = Nothing
, versions = Nothing
}
@ -254,3 +260,28 @@ getVersions (APIContext c) =
setVersions : Versions -> APIContext a -> APIContext { a | versions : () }
setVersions value (APIContext c) =
APIContext { c | versions = value }
versionsCoder : Json.Coder Versions
versionsCoder =
Json.object2
{ name = Debug.todo "Add name" -- Text.docs.versions.name
, description = Debug.todo "Add description" -- Text.docs.versions.description
, init = Versions
}
(Json.field.required
{ fieldName = "versions"
, toField = .versions
, description = Debug.todo "Add description"
, coder = Json.list Json.string
}
)
(Json.field.optional.withDefault
{ fieldName = "unstableFeatures"
, toField = .unstableFeatures
, description = Debug.todo "Add description"
, coder = Json.set Json.string
, default = ( Set.empty, [] )
, defaultToString = Json.encode (Json.set Json.string) >> E.encode 0
}
)