aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/elm')
-rw-r--r--src/client/elm/Main.elm11
-rw-r--r--src/client/elm/Model/Action/SignInAction.elm4
-rw-r--r--src/client/elm/Model/View/SignInView.elm10
-rw-r--r--src/client/elm/Persona.elm11
-rw-r--r--src/client/elm/Server.elm4
-rw-r--r--src/client/elm/Update.elm11
-rw-r--r--src/client/elm/Update/SignIn.elm18
-rw-r--r--src/client/elm/Utils/Http.elm21
-rw-r--r--src/client/elm/View/SignIn.elm54
9 files changed, 83 insertions, 61 deletions
diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm
index 7d13376..b4b440b 100644
--- a/src/client/elm/Main.elm
+++ b/src/client/elm/Main.elm
@@ -18,8 +18,6 @@ import Update exposing (update)
import View exposing (view)
-import Persona as Persona exposing (operations)
-
import Server
main : Signal Html
@@ -36,10 +34,7 @@ app = StartApp.start
)
, view = view
, update = update
- , inputs =
- [ Signal.map UpdateTime (Time.every 1000)
- , Signal.map SignIn validateSignIn
- ]
+ , inputs = [ Signal.map UpdateTime (Time.every 1000) ]
}
port tasks : Signal (Task.Task Never ())
@@ -50,9 +45,7 @@ port tasks = app.tasks
port initialTime : Time
port translations : String
port config : String
-port validateSignIn : Signal String
-- Output ports
-port askSignIn : Signal String
-port askSignIn = Signal.map toString operations.signal
+port signInError : Maybe String
diff --git a/src/client/elm/Model/Action/SignInAction.elm b/src/client/elm/Model/Action/SignInAction.elm
index eaa9f8b..619dbda 100644
--- a/src/client/elm/Model/Action/SignInAction.elm
+++ b/src/client/elm/Model/Action/SignInAction.elm
@@ -3,5 +3,7 @@ module Model.Action.SignInAction
) where
type SignInAction =
- WaitingServer
+ UpdateLogin String
+ | WaitingServer
+ | ValidLogin String
| ErrorLogin String
diff --git a/src/client/elm/Model/View/SignInView.elm b/src/client/elm/Model/View/SignInView.elm
index a950867..0d69445 100644
--- a/src/client/elm/Model/View/SignInView.elm
+++ b/src/client/elm/Model/View/SignInView.elm
@@ -4,12 +4,14 @@ module Model.View.SignInView
) where
type alias SignInView =
- { waitingServer : Bool
- , error : Maybe String
+ { login : String
+ , waitingServer : Bool
+ , result : Maybe (Result String String)
}
initSignInView : SignInView
initSignInView =
- { waitingServer = False
- , error = Nothing
+ { login = ""
+ , waitingServer = False
+ , result = Nothing
}
diff --git a/src/client/elm/Persona.elm b/src/client/elm/Persona.elm
deleted file mode 100644
index d5e1d6a..0000000
--- a/src/client/elm/Persona.elm
+++ /dev/null
@@ -1,11 +0,0 @@
-module Persona
- ( Operation(..)
- , operations
- ) where
-
-type Operation =
- NoOp
- | SignIn
-
-operations : Signal.Mailbox Operation
-operations = Signal.mailbox NoOp
diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm
index 7b03a98..9478f2a 100644
--- a/src/client/elm/Server.elm
+++ b/src/client/elm/Server.elm
@@ -31,8 +31,8 @@ init =
`Task.andMap` (Http.get payersDecoder "/payers")
signIn : String -> Task Http.Error Init
-signIn assertion =
- post ("/signIn?assertion=" ++ assertion)
+signIn email =
+ post ("/signIn?email=" ++ email)
|> flip Task.andThen (always init)
addPayment : String -> String -> PaymentFrequency -> Task Http.Error PaymentId
diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm
index bfc3bf6..948ab1f 100644
--- a/src/client/elm/Update.elm
+++ b/src/client/elm/Update.elm
@@ -20,6 +20,8 @@ import Model.View.LoggedInView exposing (..)
import Update.LoggedIn exposing (updateLoggedIn)
import Update.SignIn exposing (updateSignIn)
+import Utils.Http exposing (errorKey)
+
update : Action -> Model -> (Model, Effects Action)
update action model =
case action of
@@ -27,12 +29,13 @@ update action model =
NoOp ->
(model, Effects.none)
- SignIn assertion ->
+ SignIn email ->
( applySignIn model (SignInAction.WaitingServer)
- , Server.signIn assertion
+ , Server.signIn email
|> Task.map GoLoggedInView
- |> flip Task.onError (\_ ->
- Task.succeed (UpdateSignIn (SignInAction.ErrorLogin (getMessage "ErrorSignIn" model.translations)))
+ |> flip Task.onError (\error ->
+ let errorMessage = getMessage (errorKey error) model.translations
+ in Task.succeed (UpdateSignIn (SignInAction.ErrorLogin errorMessage))
)
|> Effects.task
)
diff --git a/src/client/elm/Update/SignIn.elm b/src/client/elm/Update/SignIn.elm
index 94963c8..f55ce6d 100644
--- a/src/client/elm/Update/SignIn.elm
+++ b/src/client/elm/Update/SignIn.elm
@@ -2,16 +2,28 @@ module Update.SignIn
( updateSignIn
) where
-import Model.Action.SignInAction exposing (..)
import Model.View.SignInView exposing (..)
+import Model.Action.SignInAction exposing (..)
updateSignIn : SignInAction -> SignInView -> SignInView
updateSignIn action signInView =
case action of
+ UpdateLogin login ->
+ { signInView |
+ login = login
+ }
WaitingServer ->
- { signInView | waitingServer = True }
+ { signInView
+ | waitingServer = True
+ }
+ ValidLogin message ->
+ { signInView
+ | login = ""
+ , result = Just (Ok message)
+ , waitingServer = False
+ }
ErrorLogin message ->
{ signInView
- | error = Just message
+ | result = Just (Err message)
, waitingServer = False
}
diff --git a/src/client/elm/Utils/Http.elm b/src/client/elm/Utils/Http.elm
index 2cf1294..bd6e2ac 100644
--- a/src/client/elm/Utils/Http.elm
+++ b/src/client/elm/Utils/Http.elm
@@ -1,6 +1,7 @@
module Utils.Http
( post
, decodeHttpValue
+ , errorKey
) where
import Http exposing (..)
@@ -18,6 +19,12 @@ post url =
|> mapError promoteError
|> flip Task.andThen handleResponse
+promoteError : RawError -> Error
+promoteError rawError =
+ case rawError of
+ RawTimeout -> Timeout
+ RawNetworkError -> NetworkError
+
handleResponse : Response -> Task Error Value
handleResponse response =
if 200 <= response.status && response.status < 300
@@ -30,12 +37,6 @@ responseString value =
Text str -> str
_ -> ""
-promoteError : RawError -> Error
-promoteError rawError =
- case rawError of
- RawTimeout -> Timeout
- RawNetworkError -> NetworkError
-
decodeHttpValue : Decoder a -> Value -> Task Error a
decodeHttpValue decoder value =
case value of
@@ -45,3 +46,11 @@ decodeHttpValue decoder value =
Err msg -> fail (UnexpectedPayload msg)
_ ->
fail (UnexpectedPayload "Response body is a blob, expecting a string.")
+
+errorKey : Error -> String
+errorKey error =
+ case error of
+ Timeout -> "Timeout"
+ NetworkError -> "NetworkError"
+ UnexpectedPayload _ -> "UnexpectedPayload"
+ BadResponse _ key -> key
diff --git a/src/client/elm/View/SignIn.elm b/src/client/elm/View/SignIn.elm
index c21c16c..908ab62 100644
--- a/src/client/elm/View/SignIn.elm
+++ b/src/client/elm/View/SignIn.elm
@@ -2,12 +2,14 @@ module View.SignIn
( renderSignIn
) where
-import Json.Decode as Json
-import Signal exposing (Address)
-
import Html as H exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
+import Signal exposing (Address)
+import Json.Decode as Json
+
+import Update exposing (..)
+import Update.SignIn exposing (..)
import Model exposing (Model)
import Model.Action exposing (..)
@@ -16,33 +18,43 @@ import Model.View.SignInView exposing (..)
import Model.Translations exposing (getMessage)
import View.Events exposing (onSubmitPrevDefault)
-import View.Icon exposing (..)
-
-import Persona exposing (operations)
+import View.Icon exposing (renderSpinIcon)
renderSignIn : Address Action -> Model -> SignInView -> Html
renderSignIn address model signInView =
div
[ class "signIn" ]
- [ button
- ( if signInView.waitingServer
- then [ class "waitingServer" ]
- else [ onClick operations.address Persona.SignIn ]
- )
- [ span [] [ text (getMessage "SignIn" model.translations) ]
- , if signInView.waitingServer
- then renderSpinIcon
- else renderIcon "power-off"
+ [ H.form
+ [ onSubmitPrevDefault address (SignIn signInView.login) ]
+ [ input
+ [ value signInView.login
+ , on "input" targetValue (Signal.message address << UpdateSignIn << UpdateLogin)
+ ]
+ []
+ , button
+ []
+ [ if signInView.waitingServer
+ then renderSpinIcon
+ else text (getMessage "SignIn" model.translations)
+ ]
]
- , signInResult model signInView
+ , div
+ [ class "result" ]
+ [ signInResult model signInView ]
]
signInResult : Model -> SignInView -> Html
signInResult model signInView =
- case signInView.error of
- Just error ->
- div
- [ class "error" ]
- [ text error ]
+ case signInView.result of
+ Just result ->
+ case result of
+ Ok login ->
+ div
+ [ class "success" ]
+ [ text (getMessage "SignInEmailSent" model.translations) ]
+ Err error ->
+ div
+ [ class "error" ]
+ [ text error ]
Nothing ->
text ""
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 08:33:02 +0000