291 lines
7.4 KiB
Elm
291 lines
7.4 KiB
Elm
port module Api exposing (Cred, addServerError, application, decodeErrors, delete, get, login, logout, post, put, register, settings, storeCredWith, username, viewerChanges)
|
|
|
|
{-| This module is responsible for communicating to the Conduit API.
|
|
It exposes an opaque Endpoint type which is guaranteed to point to the correct URL.
|
|
-}
|
|
|
|
import Api.Endpoint as Endpoint exposing (Endpoint)
|
|
import Avatar exposing (Avatar)
|
|
import Browser
|
|
import Browser.Navigation as Nav
|
|
import Http exposing (Body, Expect)
|
|
import Json.Decode as Decode exposing (Decoder, Value, decodeString, field, string)
|
|
import Json.Encode as Encode
|
|
import Url exposing (Url)
|
|
import Username exposing (Username)
|
|
|
|
|
|
|
|
-- CRED
|
|
|
|
|
|
{-| The authentication credentials for the Viewer (that is, the currently logged-in user.)
|
|
This includes:
|
|
|
|
- The cred's Username
|
|
- The cred's authentication token
|
|
By design, there is no way to access the token directly as a String.
|
|
It can be encoded for persistence, and it can be added to a header
|
|
to a HttpBuilder for a request, but that's it.
|
|
This token should never be rendered to the end user, and with this API, it
|
|
can't be!
|
|
|
|
-}
|
|
type Cred
|
|
= Cred Username String
|
|
|
|
|
|
username : Cred -> Username
|
|
username (Cred val _) =
|
|
val
|
|
|
|
|
|
credHeader : Cred -> Http.Header
|
|
credHeader (Cred _ str) =
|
|
Http.header "authorization" ("Token " ++ str)
|
|
|
|
|
|
{-| It's important that this is never exposed!
|
|
We expose `login` and `application` instead, so we can be certain that if anyone
|
|
ever has access to a `Cred` value, it came from either the login API endpoint
|
|
or was passed in via flags.
|
|
-}
|
|
credDecoder : Decoder Cred
|
|
credDecoder =
|
|
Decode.succeed Cred
|
|
|> field "username" Username.decoder
|
|
|> field "token" Decode.string
|
|
|
|
|
|
|
|
-- PERSISTENCE
|
|
|
|
|
|
decode : Decoder (Cred -> viewer) -> Value -> Result Decode.Error viewer
|
|
decode decoder value =
|
|
-- It's stored in localStorage as a JSON String;
|
|
-- first decode the Value as a String, then
|
|
-- decode that String as JSON.
|
|
Decode.decodeValue Decode.string value
|
|
|> Result.andThen (\str -> Decode.decodeString (Decode.field "user" (decoderFromCred decoder)) str)
|
|
|
|
|
|
port onStoreChange : (Value -> msg) -> Sub msg
|
|
|
|
|
|
viewerChanges : (Maybe viewer -> msg) -> Decoder (Cred -> viewer) -> Sub msg
|
|
viewerChanges toMsg decoder =
|
|
onStoreChange (\value -> toMsg (decodeFromChange decoder value))
|
|
|
|
|
|
decodeFromChange : Decoder (Cred -> viewer) -> Value -> Maybe viewer
|
|
decodeFromChange viewerDecoder val =
|
|
-- It's stored in localStorage as a JSON String;
|
|
-- first decode the Value as a String, then
|
|
-- decode that String as JSON.
|
|
Decode.decodeValue (storageDecoder viewerDecoder) val
|
|
|> Result.toMaybe
|
|
|
|
|
|
storeCredWith : Cred -> Avatar -> Cmd msg
|
|
storeCredWith (Cred uname token) avatar =
|
|
let
|
|
json =
|
|
Encode.object
|
|
[ ( "user"
|
|
, Encode.object
|
|
[ ( "username", Username.encode uname )
|
|
, ( "token", Encode.string token )
|
|
, ( "image", Avatar.encode avatar )
|
|
]
|
|
)
|
|
]
|
|
in
|
|
storeCache (Just json)
|
|
|
|
|
|
logout : Cmd msg
|
|
logout =
|
|
storeCache Nothing
|
|
|
|
|
|
port storeCache : Maybe Value -> Cmd msg
|
|
|
|
|
|
|
|
-- SERIALIZATION
|
|
-- APPLICATION
|
|
|
|
|
|
application :
|
|
Decoder (Cred -> viewer)
|
|
->
|
|
{ init : Maybe viewer -> Url -> Nav.Key -> ( model, Cmd msg )
|
|
, onUrlChange : Url -> msg
|
|
, onUrlRequest : Browser.UrlRequest -> msg
|
|
, subscriptions : model -> Sub msg
|
|
, update : msg -> model -> ( model, Cmd msg )
|
|
, view : model -> Browser.Document msg
|
|
}
|
|
-> Program Value model msg
|
|
application viewerDecoder config =
|
|
let
|
|
init flags url navKey =
|
|
let
|
|
maybeViewer =
|
|
Decode.decodeValue Decode.string flags
|
|
|> Result.andThen (Decode.decodeString (storageDecoder viewerDecoder))
|
|
|> Result.toMaybe
|
|
in
|
|
config.init maybeViewer url navKey
|
|
in
|
|
Browser.application
|
|
{ init = init
|
|
, onUrlChange = config.onUrlChange
|
|
, onUrlRequest = config.onUrlRequest
|
|
, subscriptions = config.subscriptions
|
|
, update = config.update
|
|
, view = config.view
|
|
}
|
|
|
|
|
|
storageDecoder : Decoder (Cred -> viewer) -> Decoder viewer
|
|
storageDecoder viewerDecoder =
|
|
Decode.field "user" (decoderFromCred viewerDecoder)
|
|
|
|
|
|
|
|
-- HTTP
|
|
|
|
|
|
get : Endpoint -> Maybe Cred -> Decoder a -> Cmd a
|
|
get url maybeCred decoder =
|
|
Endpoint.request
|
|
{ method = "GET"
|
|
, url = url
|
|
, expect = Http.expectJson decoder
|
|
, headers =
|
|
case maybeCred of
|
|
Just cred ->
|
|
[ credHeader cred ]
|
|
|
|
Nothing ->
|
|
[]
|
|
, body = Http.emptyBody
|
|
, timeout = Nothing
|
|
, withCredentials = False
|
|
}
|
|
|
|
|
|
put : Endpoint -> Cred -> Body -> Decoder a -> Cmd a
|
|
put url cred body decoder =
|
|
Endpoint.request
|
|
{ method = "PUT"
|
|
, url = url
|
|
, expect = Http.expectJson decoder
|
|
, headers = [ credHeader cred ]
|
|
, body = body
|
|
, timeout = Nothing
|
|
, withCredentials = False
|
|
}
|
|
|
|
|
|
post : Endpoint -> Maybe Cred -> Body -> Decoder a -> Cmd a
|
|
post url maybeCred body decoder =
|
|
Endpoint.request
|
|
{ method = "POST"
|
|
, url = url
|
|
, expect = Http.expectJson decoder
|
|
, headers =
|
|
case maybeCred of
|
|
Just cred ->
|
|
[ credHeader cred ]
|
|
|
|
Nothing ->
|
|
[]
|
|
, body = body
|
|
, timeout = Nothing
|
|
, withCredentials = False
|
|
}
|
|
|
|
|
|
delete : Endpoint -> Cred -> Body -> Decoder a -> Cmd a
|
|
delete url cred body decoder =
|
|
Endpoint.request
|
|
{ method = "DELETE"
|
|
, url = url
|
|
, expect = Http.expectJson decoder
|
|
, headers = [ credHeader cred ]
|
|
, body = body
|
|
, timeout = Nothing
|
|
, withCredentials = False
|
|
}
|
|
|
|
|
|
login : Http.Body -> Decoder (Cred -> a) -> Cmd a
|
|
login body decoder =
|
|
post Endpoint.login Nothing body (Decode.field "user" (decoderFromCred decoder))
|
|
|
|
|
|
register : Http.Body -> Decoder (Cred -> a) -> Cmd a
|
|
register body decoder =
|
|
post Endpoint.users Nothing body (Decode.field "user" (decoderFromCred decoder))
|
|
|
|
|
|
settings : Cred -> Http.Body -> Decoder (Cred -> a) -> Cmd a
|
|
settings cred body decoder =
|
|
put Endpoint.user cred body (Decode.field "user" (decoderFromCred decoder))
|
|
|
|
|
|
decoderFromCred : Decoder (Cred -> a) -> Decoder a
|
|
decoderFromCred decoder =
|
|
Decode.map2 (\fromCred cred -> fromCred cred)
|
|
decoder
|
|
credDecoder
|
|
|
|
|
|
|
|
-- ERRORS
|
|
|
|
|
|
addServerError : List String -> List String
|
|
addServerError list =
|
|
"Server error" :: list
|
|
|
|
|
|
{-| Many API endpoints include an "errors" field in their BadStatus responses.
|
|
-}
|
|
decodeErrors : Http.Error -> List String
|
|
decodeErrors error =
|
|
case error of
|
|
Http.BadStatus errid ->
|
|
[ Int.toString errid ]
|
|
|
|
err ->
|
|
[ "Server error" ]
|
|
|
|
|
|
errorsDecoder : Decoder (List String)
|
|
errorsDecoder =
|
|
Decode.keyValuePairs (Decode.list Decode.string)
|
|
|> Decode.map (List.concatMap fromPair)
|
|
|
|
|
|
fromPair : ( String, List String ) -> List String
|
|
fromPair ( field, errors ) =
|
|
List.map (\error -> field ++ " " ++ error) errors
|
|
|
|
|
|
|
|
-- LOCALSTORAGE KEYS
|
|
|
|
|
|
cacheStorageKey : String
|
|
cacheStorageKey =
|
|
"cache"
|
|
|
|
|
|
credStorageKey : String
|
|
credStorageKey =
|
|
"cred"
|