Prevent to send multiple payments if the server is not answering

16 files changed, 131 insertions, 60 deletions

diff --git a/src/client/elm/Model/Action.elm b/src/client/elm/Model/Action.elm
index d0fe597..033467d 100644
--- a/src/client/elm/Model/Action.elm
+++ b/src/client/elm/Model/Action.elm
@@ -17,7 +17,7 @@ type Action =
   | ServerCommunication Communication
   | SignIn String
   | UpdateTime Time
-  | GoSignInView
   | GoLoggedInView Users UserId Payments Payments Int Payers
   | UpdateSignIn SignInAction
   | UpdateLoggedIn LoggedInAction
+  | GoSignInView
diff --git a/src/client/elm/Model/Action/AddPaymentAction.elm b/src/client/elm/Model/Action/AddPaymentAction.elm
index 172f35f..a109a49 100644
--- a/src/client/elm/Model/Action/AddPaymentAction.elm
+++ b/src/client/elm/Model/Action/AddPaymentAction.elm
@@ -7,3 +7,4 @@ type AddPaymentAction =
   | UpdateCost String
   | AddError (Maybe String) (Maybe String)
   | ToggleFrequency
+  | WaitingServer
diff --git a/src/client/elm/Model/Action/LoggedInAction.elm b/src/client/elm/Model/Action/LoggedInAction.elm
index aaf3c7f..18d2224 100644
--- a/src/client/elm/Model/Action/LoggedInAction.elm
+++ b/src/client/elm/Model/Action/LoggedInAction.elm
@@ -10,7 +10,8 @@ import Model.Action.AddPaymentAction exposing (AddPaymentAction)
 type LoggedInAction =
   UpdateAdd AddPaymentAction
   | UpdatePayments Payments
-  | AddPayment PaymentId String Int PaymentFrequency
+  | AddPayment String Int PaymentFrequency
+  | ValidateAddPayment PaymentId String Int PaymentFrequency
   | DeletePayment Payment PaymentFrequency
   | ToggleEdit PaymentId
   | UpdatePage Int
diff --git a/src/client/elm/Model/Action/SignInAction.elm b/src/client/elm/Model/Action/SignInAction.elm
index ed64c1d..eaa9f8b 100644
--- a/src/client/elm/Model/Action/SignInAction.elm
+++ b/src/client/elm/Model/Action/SignInAction.elm
@@ -3,5 +3,5 @@ module Model.Action.SignInAction
   ) where
 
 type SignInAction =
-  Connecting
+  WaitingServer
   | ErrorLogin String
diff --git a/src/client/elm/Model/View/LoggedIn/AddPayment.elm b/src/client/elm/Model/View/LoggedIn/AddPayment.elm
index fc4d3a0..3a14b00 100644
--- a/src/client/elm/Model/View/LoggedIn/AddPayment.elm
+++ b/src/client/elm/Model/View/LoggedIn/AddPayment.elm
@@ -18,6 +18,7 @@ type alias AddPayment =
   , cost : String
   , costError : Maybe String
   , frequency : PaymentFrequency
+  , waitingServer : Bool
   }
 
 initAddPayment : PaymentFrequency -> AddPayment
@@ -27,6 +28,7 @@ initAddPayment frequency =
   , cost = ""
   , costError = Nothing
   , frequency = frequency
+  , waitingServer = False
   }
 
 validateName : String -> Translations -> Result String String
diff --git a/src/client/elm/Model/View/SignInView.elm b/src/client/elm/Model/View/SignInView.elm
index cf7e6b2..a950867 100644
--- a/src/client/elm/Model/View/SignInView.elm
+++ b/src/client/elm/Model/View/SignInView.elm
@@ -4,12 +4,12 @@ module Model.View.SignInView
   ) where
 
 type alias SignInView =
-  { connecting : Bool
+  { waitingServer : Bool
   , error : Maybe String
   }
 
 initSignInView : SignInView
 initSignInView =
-  { connecting = False
+  { waitingServer = False
   , error = Nothing
   }
diff --git a/src/client/elm/ServerCommunication.elm b/src/client/elm/ServerCommunication.elm
index 53612d8..7c46d79 100644
--- a/src/client/elm/ServerCommunication.elm
+++ b/src/client/elm/ServerCommunication.elm
@@ -35,7 +35,7 @@ sendRequest communication =
     AddPayment name cost frequency ->
       post (addPaymentURL name cost frequency)
         |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
-        |> Task.map (\paymentId -> (U.UpdateLoggedIn (UL.AddPayment paymentId name cost frequency)))
+        |> Task.map (\paymentId -> (U.UpdateLoggedIn (UL.ValidateAddPayment paymentId name cost frequency)))
 
     DeletePayment payment frequency ->
       post (deletePaymentURL payment.id)
diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm
index 73dde9b..a33d47d 100644
--- a/src/client/elm/Update.elm
+++ b/src/client/elm/Update.elm
@@ -31,7 +31,7 @@ update action model =
       (model, Effects.none)
 
     SignIn assertion ->
-      ( applySignIn model (SignInAction.Connecting)
+      ( applySignIn model (SignInAction.WaitingServer)
       , sendRequest (Communication.SignIn assertion)
           |> flip Task.onError (\_ ->
                Task.succeed (UpdateSignIn (SignInAction.ErrorLogin (getMessage "ErrorSignIn" model.translations)))
@@ -61,16 +61,23 @@ update action model =
       (applySignIn model signInAction, Effects.none)
 
     UpdateLoggedIn loggedInAction ->
-      (applyLoggedIn model loggedInAction, Effects.none)
+      applyLoggedIn model loggedInAction
 
 applySignIn : Model -> SignInAction -> Model
 applySignIn model signInAction =
   case model.view of
-    V.SignInView signInView -> { model | view = V.SignInView (updateSignIn signInAction signInView) }
-    _ -> model
+    V.SignInView signInView ->
+      { model | view = V.SignInView (updateSignIn signInAction signInView) }
+    _ ->
+      model
 
-applyLoggedIn : Model -> LoggedInAction -> Model
+applyLoggedIn : Model -> LoggedInAction -> (Model, Effects Action)
 applyLoggedIn model loggedInAction =
   case model.view of
-    V.LoggedInView loggedInView -> { model | view = V.LoggedInView (updateLoggedIn model loggedInAction loggedInView) }
-    _ -> model
+    V.LoggedInView loggedInView ->
+      let (loggedInView, effects) = updateLoggedIn model loggedInAction loggedInView
+      in  ( { model | view = V.LoggedInView loggedInView }
+          , effects
+          )
+    _ ->
+      (model, Effects.none)
diff --git a/src/client/elm/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm
index 704dd7f..fe53af7 100644
--- a/src/client/elm/Update/LoggedIn.elm
+++ b/src/client/elm/Update/LoggedIn.elm
@@ -5,12 +5,20 @@ module Update.LoggedIn
 import Date
 import Dict
 
+import Effects exposing (Effects)
+import Task
+
+import ServerCommunication exposing (sendRequest)
+
 import Model exposing (Model)
 import Model.User exposing (UserId)
 import Model.Payment exposing (..)
+import Model.Action exposing (..)
 import Model.Action.LoggedInAction exposing (..)
 import Model.Action.AccountAction exposing (..)
 import Model.Action.MonthlyAction as Monthly
+import Model.Action.AddPaymentAction as AddPayment
+import Model.Communication as Communication exposing (Communication)
 import Model.View.LoggedInView exposing (..)
 import Model.View.LoggedIn.AddPayment exposing (..)
 
@@ -18,49 +26,82 @@ import Update.LoggedIn.AddPayment exposing (updateAddPayment)
 import Update.LoggedIn.Monthly exposing (updateMonthly)
 import Update.LoggedIn.Account exposing (updateAccount)
 
-updateLoggedIn : Model -> LoggedInAction -> LoggedInView -> LoggedInView
+updateLoggedIn : Model -> LoggedInAction -> LoggedInView -> (LoggedInView, Effects Action)
 updateLoggedIn model action loggedInView =
   case action of
+
     UpdateAdd addPaymentAction ->
-      { loggedInView | add = updateAddPayment addPaymentAction loggedInView.add }
+      ( { loggedInView | add = updateAddPayment addPaymentAction loggedInView.add }
+      , Effects.none
+      )
+
     UpdatePayments payments ->
-      { loggedInView | payments = payments }
-    AddPayment paymentId name cost frequency ->
+      ( { loggedInView | payments = payments }
+      , Effects.none
+      )
+
+    AddPayment name cost frequency ->
+      ( { loggedInView | add = updateAddPayment AddPayment.WaitingServer loggedInView.add }
+      , sendRequest (Communication.AddPayment name cost frequency)
+          |> flip Task.onError (always <| Task.succeed NoOp)
+          |> Effects.task
+      )
+
+    ValidateAddPayment paymentId name cost frequency ->
       let newPayment = Payment paymentId (Date.fromTime model.currentTime) name cost loggedInView.account.me
           newAdd = initAddPayment frequency
-      in  if frequency == Punctual
-             then
-               { loggedInView
-               | currentPage = 1
-               , add = newAdd
-               , account = updateAccount (UpdatePayer loggedInView.account.me model.currentTime cost) loggedInView.account
-               , payments = newPayment :: loggedInView.payments
-               , paymentsCount = loggedInView.paymentsCount + 1
-               }
-             else
-               { loggedInView
-               | add = newAdd
-               , monthly = updateMonthly (Monthly.AddPayment newPayment) loggedInView.monthly
-               }
+      in  case frequency of
+            Punctual ->
+              ( { loggedInView
+                | currentPage = 1
+                , add = newAdd
+                , account = updateAccount (UpdatePayer loggedInView.account.me model.currentTime cost) loggedInView.account
+                , payments = newPayment :: loggedInView.payments
+                , paymentsCount = loggedInView.paymentsCount + 1
+                }
+              , Effects.none
+              )
+            Monthly ->
+              ( { loggedInView
+                | add = newAdd
+                , monthly = updateMonthly (Monthly.AddPayment newPayment) loggedInView.monthly
+                }
+              , Effects.none
+              )
+
     ToggleEdit id ->
-      { loggedInView | paymentEdition = if loggedInView.paymentEdition == Just id then Nothing else Just id }
+      ( { loggedInView | paymentEdition = if loggedInView.paymentEdition == Just id then Nothing else Just id }
+      , Effects.none
+      )
+
     DeletePayment payment frequency ->
       case frequency of
         Monthly ->
-          { loggedInView
-          | monthly = updateMonthly (Monthly.DeletePayment payment) loggedInView.monthly
-          }
+          ( { loggedInView
+            | monthly = updateMonthly (Monthly.DeletePayment payment) loggedInView.monthly
+            }
+          , Effects.none
+          )
         Punctual ->
-          { loggedInView
-          | account = updateAccount (UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account
-          , payments = deletePayment payment.id loggedInView.payments
-          , paymentsCount = loggedInView.paymentsCount - 1
-          }
+          ( { loggedInView
+            | account = updateAccount (UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account
+            , payments = deletePayment payment.id loggedInView.payments
+            , paymentsCount = loggedInView.paymentsCount - 1
+            }
+          , Effects.none
+          )
+
     UpdatePage page ->
-      { loggedInView
-      | currentPage = page
-      }
+      ( { loggedInView | currentPage = page }
+      , Effects.none
+      )
+
     UpdateMonthly monthlyAction ->
-      { loggedInView | monthly = updateMonthly monthlyAction loggedInView.monthly }
+      ( { loggedInView | monthly = updateMonthly monthlyAction loggedInView.monthly }
+      , Effects.none
+      )
+
     UpdateAccount accountAction ->
-      { loggedInView | account = updateAccount accountAction loggedInView.account }
+      ( { loggedInView | account = updateAccount accountAction loggedInView.account }
+      , Effects.none
+      )
diff --git a/src/client/elm/Update/LoggedIn/AddPayment.elm b/src/client/elm/Update/LoggedIn/AddPayment.elm
index 978980d..3eb2ea4 100644
--- a/src/client/elm/Update/LoggedIn/AddPayment.elm
+++ b/src/client/elm/Update/LoggedIn/AddPayment.elm
@@ -22,3 +22,5 @@ updateAddPayment action addPayment =
       { addPayment
       | frequency = if addPayment.frequency == Punctual then Monthly else Punctual
       }
+    WaitingServer ->
+      { addPayment | waitingServer = True }
diff --git a/src/client/elm/Update/SignIn.elm b/src/client/elm/Update/SignIn.elm
index 5e8a9bb..94963c8 100644
--- a/src/client/elm/Update/SignIn.elm
+++ b/src/client/elm/Update/SignIn.elm
@@ -8,10 +8,10 @@ import Model.View.SignInView exposing (..)
 updateSignIn : SignInAction -> SignInView -> SignInView
 updateSignIn action signInView =
   case action of
-    Connecting ->
-      { signInView | connecting = True }
+    WaitingServer ->
+      { signInView | waitingServer = True }
     ErrorLogin message ->
       { signInView
       | error = Just message
-      , connecting = False
+      , waitingServer = False
       }
diff --git a/src/client/elm/View/LoggedIn/AddPayment.elm b/src/client/elm/View/LoggedIn/AddPayment.elm
index 5739a95..283d392 100644
--- a/src/client/elm/View/LoggedIn/AddPayment.elm
+++ b/src/client/elm/View/LoggedIn/AddPayment.elm
@@ -14,7 +14,7 @@ import Model exposing (Model)
 import Model.Payment exposing (PaymentFrequency(..))
 import Model.Translations exposing (getMessage)
 import Model.Action exposing (..)
-import Model.Action.LoggedInAction exposing (..)
+import Model.Action.LoggedInAction as LoggedInAction exposing (..)
 import Model.Action.AddPaymentAction exposing (..)
 import Model.Communication as Communication
 
@@ -22,7 +22,7 @@ import Model.View.LoggedIn.AddPayment exposing (..)
 import Model.View.LoggedInView exposing (LoggedInView)
 
 import View.Events exposing (onSubmitPrevDefault)
-import View.Icon exposing (renderIcon)
+import View.Icon exposing (..)
 
 import Utils.Maybe exposing (isJust)
 import Utils.Either exposing (toMaybeError)
@@ -30,11 +30,16 @@ import Utils.Either exposing (toMaybeError)
 addPayment : Address Action -> Model -> LoggedInView -> Html
 addPayment address model loggedInView =
   H.form
-    [ case (validateName loggedInView.add.name model.translations, validateCost loggedInView.add.cost model.translations) of
-        (Ok name, Ok cost) ->
-          onSubmitPrevDefault address (ServerCommunication (Communication.AddPayment name cost loggedInView.add.frequency))
-        (resName, resCost) ->
-          onSubmitPrevDefault address (UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
+    [ let update =
+            if loggedInView.add.waitingServer
+              then NoOp
+              else
+                case (validateName loggedInView.add.name model.translations, validateCost loggedInView.add.cost model.translations) of
+                  (Ok name, Ok cost) ->
+                    UpdateLoggedIn <| LoggedInAction.AddPayment name cost loggedInView.add.frequency
+                  (resName, resCost) ->
+                    UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost)
+      in  onSubmitPrevDefault address update
     , class "addPayment"
     ]
     [ addPaymentName address loggedInView.add
@@ -42,8 +47,14 @@ addPayment address model loggedInView =
     , paymentFrequency address model loggedInView.add
     , button
         [ type' "submit"
-        , class "add" ]
-        [ text (getMessage "Add" model.translations)]
+        , classList
+            [ ("add", True)
+            , ("waitingServer", loggedInView.add.waitingServer)
+            ]
+        ]
+        [ text (getMessage "Add" model.translations)
+        , if loggedInView.add.waitingServer then renderSpinIcon else text ""
+        ]
     ]
 
 addPaymentName : Address Action -> AddPayment -> Html
diff --git a/src/client/elm/View/SignIn.elm b/src/client/elm/View/SignIn.elm
index ba16561..4b9f2bb 100644
--- a/src/client/elm/View/SignIn.elm
+++ b/src/client/elm/View/SignIn.elm
@@ -25,9 +25,12 @@ renderSignIn address model signInView =
   div
     [ class "signIn" ]
     [ button
-        [ onClick operations.address Persona.SignIn ]
+        ( if signInView.waitingServer
+            then []
+            else [ onClick operations.address Persona.SignIn ]
+        )
         [ span [] [ text (getMessage "SignIn" model.translations) ]
-        , if signInView.connecting
+        , if signInView.waitingServer
             then renderSpinIcon
             else renderIcon "power-off"
         ]
diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs
index bd11766..40218f8 100644
--- a/src/server/Design/Helper.hs
+++ b/src/server/Design/Helper.hs
@@ -47,7 +47,7 @@ iconButton backgroundCol textCol h = do
     display inlineBlock
     marginLeft (px 20)
   i ? do
-    marginLeft (px 20)
+    marginLeft (px 15)
     marginRight (px 20)
   hover & i ? transform (scale 1.2 1.2)
 
diff --git a/src/server/Design/LoggedIn/Add.hs b/src/server/Design/LoggedIn/Add.hs
index 579cead..3bdfb65 100644
--- a/src/server/Design/LoggedIn/Add.hs
+++ b/src/server/Design/LoggedIn/Add.hs
@@ -65,6 +65,8 @@ addDesign =
       defaultButton C.red C.white (px inputHeight)
       paddingLeft (px 15)
       paddingRight (px 15)
+      i ? marginLeft (px 10)
+      ".waitingServer" & ("cursor" -: "not-allowed")
 
     ".name.error" <> ".cost.error" ? do
       input ? borderColor C.redError
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 3ac489e..9f21873 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -5,6 +5,7 @@ import Web.Scotty
 import Network.Wai.Middleware.Static
 
 import Control.Concurrent (forkIO)
+
 import MonthlyPaymentJob (monthlyPaymentJobListener)
 
 import Data.Text (Text)