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.Config.Log exposing (Log, log)
import Internal.Tools.Json as Json import Internal.Tools.Json as Json
import Internal.Values.Context as Context exposing (APIContext, Versions) import Internal.Values.Context as Context exposing (APIContext, Versions)
import Internal.Values.Envelope as E
import Internal.Values.Vault as V import Internal.Values.Vault as V
import Recursion import Recursion
import Set import Set
@ -39,7 +40,7 @@ import Set
{-| A TaskChain helps create a chain of HTTP requests. {-| A TaskChain helps create a chain of HTTP requests.
-} -}
type alias TaskChain ph1 ph2 = 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. {-| Make an HTTP request that adheres to the Matrix spec rules.
@ -47,17 +48,17 @@ type alias TaskChain ph1 ph2 =
request : request :
{ attributes : List (R.Attribute { ph1 | baseUrl : () }) { attributes : List (R.Attribute { ph1 | baseUrl : () })
, coder : Json.Coder returnValue , coder : Json.Coder returnValue
, contextChange : V.VaultUpdate -> (APIContext { ph1 | baseUrl : () } -> APIContext { ph2 | baseUrl : () }) , contextChange : returnValue -> (APIContext { ph1 | baseUrl : () } -> APIContext { ph2 | baseUrl : () })
, method : String , method : String
, path : List String , path : List String
, toUpdate : returnValue -> ( V.VaultUpdate, List Log ) , toUpdate : returnValue -> ( E.EnvelopeUpdate V.VaultUpdate, List Log )
} }
-> TaskChain ph1 ph2 -> TaskChain ph1 ph2
request data = request data =
R.toChain R.toChain
{ logHttp = { logHttp =
\r -> \r ->
( V.HttpRequest r ( E.HttpRequest r
, String.concat , String.concat
-- TODO: Move this to Internal.Config.Text module -- TODO: Move this to Internal.Config.Text module
[ "Matrix HTTP: " [ "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. {-| Add a boolean value as a query parameter to the URL.
-} -}
queryBool : String -> Bool -> Attribute a queryBool : String -> Bool -> Attribute a
@ -545,6 +487,46 @@ queryString key value _ =
QueryParam <| UrlBuilder.string 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. {-| Configure the HTTP request to time out after a given expiry time.
-} -}
timeout : Float -> Attribute a timeout : Float -> Attribute a
@ -558,7 +540,7 @@ toChain :
{ logHttp : Request ( Error, List Log ) ( update, List Log ) -> ( update, List Log ) { logHttp : Request ( Error, List Log ) ( update, List Log ) -> ( update, List Log )
, coder : Json.Coder httpOut , coder : Json.Coder httpOut
, request : ApiPlan ph1 , request : ApiPlan ph1
, toContextChange : update -> (APIContext ph1 -> APIContext ph2) , toContextChange : httpOut -> (APIContext ph1 -> APIContext ph2)
, toUpdate : httpOut -> ( update, List Log ) , toUpdate : httpOut -> ( update, List Log )
} }
-> C.TaskChain Error update ph1 ph2 -> C.TaskChain Error update ph1 ph2
@ -566,23 +548,45 @@ toChain data apiContext =
data.request apiContext data.request apiContext
|> (\call -> |> (\call ->
let let
r : Request ( Error, List Log ) ( update, List Log ) r : Request ( Error, List Log ) ( httpOut, List Log )
r = r =
{ method = call.method { method = call.method
, headers = getHeaders call.attributes , headers = getHeaders call.attributes
, url = getUrl call , url = getUrl call
, body = Http.jsonBody (getBody call.attributes) , 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 , timeout = getTimeout call.attributes
} }
in in
case data.logHttp r of case data.logHttp logR of
( httpU, httpLogs ) -> ( httpU, httpLogs ) ->
Http.task r Http.task r
|> Task.map |> Task.map
(\( u, logs ) -> (\( httpO, logs ) ->
{ contextChange = data.toContextChange u case data.toUpdate httpO of
, logs = List.append httpLogs logs ( u, uLogs ) ->
{ contextChange = data.toContextChange httpO
, logs = List.concat [ httpLogs, logs, uLogs ]
, messages = [ httpU, u ] , messages = [ httpU, u ]
} }
) )

View File

@ -1,6 +1,6 @@
module Internal.Values.Context exposing module Internal.Values.Context exposing
( Context, init, coder, encode, decoder ( Context, init, coder, encode, decoder
, APIContext, apiFormat , APIContext, apiFormat, fromApiFormat
, setAccessToken, getAccessToken , setAccessToken, getAccessToken
, setBaseUrl, getBaseUrl , setBaseUrl, getBaseUrl
, setTransaction, getTransaction , setTransaction, getTransaction
@ -22,7 +22,7 @@ the Matrix API.
Once the API starts needing information, that's when we use the APIContext type 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. 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 Once the APIContext is ready, there's helper functions for each piece of
information that can be inserted. information that can be inserted.
@ -52,6 +52,7 @@ information that can be inserted.
import Internal.Config.Leaks as L import Internal.Config.Leaks as L
import Internal.Config.Text as Text import Internal.Config.Text as Text
import Internal.Tools.Json as Json import Internal.Tools.Json as Json
import Json.Encode as E
import Set exposing (Set) import Set exposing (Set)
@ -61,12 +62,12 @@ static and hence can be passed on easily.
type alias Context = type alias Context =
{ accessToken : Maybe String { accessToken : Maybe String
, baseUrl : Maybe String , baseUrl : Maybe String
, experimental : Maybe (Set String)
, password : Maybe String , password : Maybe String
, refreshToken : Maybe String , refreshToken : Maybe String
, username : Maybe String , serverName : String
, transaction : Maybe 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 , baseUrl = context.baseUrl |> Maybe.withDefault L.baseUrl
, context = context , context = context
, transaction = context.transaction |> Maybe.withDefault L.transaction , transaction = context.transaction |> Maybe.withDefault L.transaction
, versions = , versions = context.versions |> Maybe.withDefault L.versions
{ versions = context.versions |> Maybe.withDefault L.versions
, unstableFeatures = context.experimental |> Maybe.withDefault Set.empty
}
} }
{-| 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. {-| Define how a Context can be encoded to and decoded from a JSON object.
-} -}
coder : Json.Coder Context coder : Json.Coder Context
@ -127,13 +133,6 @@ coder =
, coder = Json.string , 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 (Json.field.optional.value
{ fieldName = "password" { fieldName = "password"
, toField = .password , toField = .password
@ -148,10 +147,10 @@ coder =
, coder = Json.string , coder = Json.string
} }
) )
(Json.field.optional.value (Json.field.required
{ fieldName = "username" { fieldName = "serverName"
, toField = .username , toField = .serverName
, description = Text.fields.context.username , description = Text.fields.context.serverName
, coder = Json.string , coder = Json.string
} }
) )
@ -162,11 +161,18 @@ coder =
, coder = Json.string , coder = Json.string
} }
) )
(Json.field.optional.value
{ fieldName = "username"
, toField = .username
, description = Text.fields.context.username
, coder = Json.string
}
)
(Json.field.optional.value (Json.field.optional.value
{ fieldName = "versions" { fieldName = "versions"
, toField = .versions , toField = .versions
, description = Text.fields.context.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. {-| A basic, untouched version of the Context, containing no information.
-} -}
init : Context init : String -> Context
init = init sn =
{ accessToken = Nothing { accessToken = Nothing
, baseUrl = Nothing , baseUrl = Nothing
, experimental = Nothing
, refreshToken = Nothing , refreshToken = Nothing
, password = Nothing , password = Nothing
, username = Nothing , serverName = sn
, transaction = Nothing , transaction = Nothing
, username = Nothing
, versions = Nothing , versions = Nothing
} }
@ -254,3 +260,28 @@ getVersions (APIContext c) =
setVersions : Versions -> APIContext a -> APIContext { a | versions : () } setVersions : Versions -> APIContext a -> APIContext { a | versions : () }
setVersions value (APIContext c) = setVersions value (APIContext c) =
APIContext { c | versions = value } 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
}
)