Skip to content

Instantly share code, notes, and snippets.

@maxhoffmann
Created June 1, 2016 09:23
Show Gist options
  • Save maxhoffmann/240574e892bf9118aeb2dd1e8a645e0a to your computer and use it in GitHub Desktop.
Save maxhoffmann/240574e892bf9118aeb2dd1e8a645e0a to your computer and use it in GitHub Desktop.
Effect Manager for token authentication in 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment