diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/client/Main.elm | 15 | ||||
| -rw-r--r-- | src/client/Update.elm | 4 | ||||
| -rw-r--r-- | src/server/Application.hs | 11 |
3 files changed, 24 insertions, 6 deletions
diff --git a/src/client/Main.elm b/src/client/Main.elm index e79fe2b..519360a 100644 --- a/src/client/Main.elm +++ b/src/client/Main.elm @@ -15,6 +15,7 @@ import Model exposing (Model, initialModel) import Model.Payment exposing (Payments, paymentsDecoder) import Update exposing (Action(..), actions, updateModel) +import Update.SignIn exposing (..) import View.Page exposing (renderPage) @@ -28,13 +29,21 @@ main = Signal.map renderPage model model : Signal Model model = Signal.foldp updateModel initialModel actions.signal +------------------------- + +port signInError : Maybe String + --------------------------------------- port fetchPayments : Task Http.Error () port fetchPayments = - getPayments - |> flip Task.andThen reportSuccess - |> flip Task.onError reportError + case signInError of + Just msg -> + Signal.send actions.address (SignInError msg) + Nothing -> + getPayments + |> flip Task.andThen reportSuccess + |> flip Task.onError reportError reportSuccess : Payments -> Task x () reportSuccess payments = Signal.send actions.address (UpdatePayments payments) diff --git a/src/client/Update.elm b/src/client/Update.elm index 1d0fe95..508ee2f 100644 --- a/src/client/Update.elm +++ b/src/client/Update.elm @@ -14,6 +14,7 @@ import Update.SignIn exposing (..) type Action = NoOp | SignIn + | SignInError String | UpdateSignIn SignInAction | UpdatePayments Payments @@ -27,6 +28,9 @@ updateModel action model = model SignIn -> { model | view <- SignInView initSignIn } + SignInError msg -> + let signIn = { initSignIn | result <- Just (Err msg) } + in { model | view <- SignInView signIn } UpdateSignIn signInAction -> case model.view of SignInView signIn -> diff --git a/src/server/Application.hs b/src/server/Application.hs index 739fe33..7e93fe1 100644 --- a/src/server/Application.hs +++ b/src/server/Application.hs @@ -23,6 +23,7 @@ import Control.Monad.IO.Class (liftIO) import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE import Data.String (fromString) import Data.Time.Clock (getCurrentTime, diffUTCTime) @@ -109,18 +110,22 @@ validateSignInAction token = do Just signIn -> if signInIsUsed . entityVal $ signIn then - errorResponse "The token has already been used." + redirectError "The token has already been used." else let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn) in if diffTime > 2 * 60 -- 2 minutes then - errorResponse "The token has expired." + redirectError "The token has expired." else do LoginSession.put (signInEmail . entityVal $ signIn) liftIO . runDb . signInTokenToUsed . entityKey $ signIn redirect "/" Nothing -> - errorResponse "The token is invalid." + redirectError "The token is invalid." + +redirectError :: Text -> ActionM () +redirectError msg = + redirect . TL.fromStrict . T.concat $ ["/?signInError=", msg] signOutAction :: ActionM () signOutAction = do |