From 0cba27cba2b44756389d50bc113f23a2be87e978 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Jan 2016 00:19:55 +0100 Subject: Prevent to send multiple payments if the server is not answering --- src/client/elm/Model/Action.elm | 2 +- src/client/elm/Model/Action/AddPaymentAction.elm | 1 + src/client/elm/Model/Action/LoggedInAction.elm | 3 +- src/client/elm/Model/Action/SignInAction.elm | 2 +- src/client/elm/Model/View/LoggedIn/AddPayment.elm | 2 + src/client/elm/Model/View/SignInView.elm | 4 +- src/client/elm/ServerCommunication.elm | 2 +- src/client/elm/Update.elm | 21 +++-- src/client/elm/Update/LoggedIn.elm | 105 +++++++++++++++------- src/client/elm/Update/LoggedIn/AddPayment.elm | 2 + src/client/elm/Update/SignIn.elm | 6 +- src/client/elm/View/LoggedIn/AddPayment.elm | 29 ++++-- src/client/elm/View/SignIn.elm | 7 +- src/server/Design/Helper.hs | 2 +- src/server/Design/LoggedIn/Add.hs | 2 + src/server/Main.hs | 1 + 16 files changed, 131 insertions(+), 60 deletions(-) (limited to 'src') 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) -- cgit v1.2.3