Effect Manager for token authentication in Elm

Api.elm

-- Api Effect Manager

effect module Api where { command = MyCmd } exposing (request, Response)

import Task exposing (..)
import Http
import Process
import Json.Decode as Json exposing ((:=))
import Native.Api


type Response
    = Success Http.Response
    | Failure Int String



-- COMMANDS


type MyCmd msg
    = ApiRequest Http.Request (Response -> msg) (Http.Response -> msg)


request : (Response -> msg) -> (Http.Response -> msg) -> Http.Request -> Cmd msg
request failureMsg successMsg request =
    command (ApiRequest request failureMsg successMsg)


cmdMap : (msg -> msg') -> MyCmd msg -> MyCmd msg'
cmdMap func (ApiRequest request failureMsg successMsg) =
    ApiRequest request (failureMsg >> func) (successMsg >> func)



-- MANAGER


type alias State msg =
    { token : Token
    , requestQueue : List (MyCmd (Http.Response -> msg))
    }


type Token
    = Valid String
    | Invalid
    | Refreshing


init : Task Never (State msg)
init =
    Task.succeed (State Invalid [])



-- HANDLE APP MESSAGES


onEffects :
    Platform.Router (Http.Response -> msg) Msg
    -> List (MyCmd (Http.Response -> msg))
    -> State msg
    -> Task Never (State msg)
onEffects router cmds state =
    case state.token of
        Invalid ->
            refreshToken router
                &> Task.succeed (State Refreshing (List.append cmds state.requestQueue))

        Refreshing ->
            Task.succeed (State state.token (List.append cmds state.requestQueue))

        Valid secret ->
            let
                cmdsWithToken =
                    List.map (addTokenToCmds secret) <| List.append state.requestQueue cmds
            in
                Task.sequence (List.map (sendCmd router) cmdsWithToken)
                    &> Task.succeed { state | requestQueue = [] }


sendCmd : Platform.Router (Http.Response -> msg) Msg -> MyCmd (Http.Response -> msg) -> Task Never Process.Id
sendCmd router (ApiRequest request failureMsg successMsg) =
    Process.spawn
        <| Http.send Http.defaultSettings request
        `andThen` (validateResponse failureMsg successMsg >> Platform.sendToApp router)
        `onError` (\_ -> Platform.sendToApp router (failureMsg (Failure 0 "Server did not respond")))


validateResponse : (Response -> msg) -> (Http.Response -> msg) -> Http.Response -> msg
validateResponse failureMsg successMsg response =
    if 200 <= response.status && response.status < 300 then
        successMsg response
    else
        failureMsg (Failure response.status response.statusText)


addTokenToCmds : String -> MyCmd msg -> MyCmd msg
addTokenToCmds token cmd =
    case cmd of
        ApiRequest request failureMsg successMsg ->
            -- TODO: remove headers as an option
            let
                headers =
                    List.append
                        [ ( "Authorization", "Bearer " ++ token )
                        , ( "Accept", "application/json" )
                        , ( "Content-Type", "application/json" )
                        ]
                        request.headers
            in
                ApiRequest { request | headers = headers } failureMsg successMsg



-- HANDLE SELF MESSAGES


type Msg
    = RefreshSuccess String
    | RefreshFailure Http.Error


onSelfMsg : Platform.Router (Http.Response -> msg) Msg -> Msg -> State msg -> Task Never (State msg)
onSelfMsg router selfMsg state =
    case selfMsg of
        RefreshSuccess token ->
            let
                cmdsWithToken =
                    List.map (addTokenToCmds token) state.requestQueue
            in
                Task.sequence (List.map (sendCmd router) cmdsWithToken)
                    &> Task.succeed { state | requestQueue = [], token = Valid token }

        RefreshFailure error ->
            case error of
                Http.UnexpectedPayload payload ->
                    Process.spawn (redirect "/login")
                        &> Task.succeed state

                _ ->
                    -- TODO: backoff strategy
                    Task.succeed state


refreshToken : Platform.Router msg Msg -> Task Never Process.Id
refreshToken router =
    let
        refreshSuccess token =
            Platform.sendToSelf router (RefreshSuccess token)

        refreshFailure error =
            Platform.sendToSelf router (RefreshFailure error)

        attemptRefresh =
            requestNewToken
                `andThen` refreshSuccess
                `onError` refreshFailure
    in
        Process.spawn attemptRefresh


requestNewToken : Task Http.Error String
requestNewToken =
    Http.send Http.defaultSettings
        { verb = "POST"
        , headers =
            [ ( "Accept", "application/json" )
            , ( "Content-Type", "application/json" )
            ]
        , url = "/get_token"
        , body = Http.empty
        }
        |> Http.fromJson ("token" := Json.string)



-- Helpers


(&>) : Task.Task a b -> Task.Task a c -> Task.Task a c
(&>) task1 task2 =
    task1 `Task.andThen` \_ -> task2



-- Native


redirect : String -> Task x ()
redirect path =
    Native.Api.redirect path