From d9df5c3fcffe12aac239b58ccf2fd82c19c3be62 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Jan 2016 23:37:14 +0100 Subject: Validate add payment server side --- src/client/elm/Model/Action/AddPaymentAction.elm | 3 ++- src/client/elm/Model/Action/LoggedInAction.elm | 2 +- src/client/elm/Model/View/LoggedIn/Account.elm | 12 ++++++--- src/client/elm/Model/View/LoggedIn/AddPayment.elm | 16 +----------- src/client/elm/Native/Reads.js | 22 ---------------- src/client/elm/Reads.elm | 10 -------- src/client/elm/Server.elm | 17 ++++++++++--- src/client/elm/SimpleHTTP.elm | 8 +++++- src/client/elm/Update/LoggedIn.elm | 18 ++++++++++--- src/client/elm/Update/LoggedIn/AddPayment.elm | 28 ++++++++++++++++++++ src/client/elm/Utils/Validation.elm | 23 ----------------- src/client/elm/View/LoggedIn/AddPayment.elm | 10 +++----- src/client/elm/View/LoggedIn/Paging.elm | 4 +-- src/server/Controller/Payment.hs | 18 ++++++++----- src/server/Design/LoggedIn/Table.hs | 1 + src/server/Main.hs | 2 +- src/server/Model/Database.hs | 3 +++ src/server/Model/Json/PaymentId.hs | 17 ------------- src/server/Model/Payment.hs | 31 ++++++++++++++++++++--- src/server/Validation.hs | 23 +++++++++++++++++ 20 files changed, 146 insertions(+), 122 deletions(-) delete mode 100644 src/client/elm/Native/Reads.js delete mode 100644 src/client/elm/Reads.elm delete mode 100644 src/client/elm/Utils/Validation.elm delete mode 100644 src/server/Model/Json/PaymentId.hs create mode 100644 src/server/Validation.hs diff --git a/src/client/elm/Model/Action/AddPaymentAction.elm b/src/client/elm/Model/Action/AddPaymentAction.elm index a109a49..2d4f92a 100644 --- a/src/client/elm/Model/Action/AddPaymentAction.elm +++ b/src/client/elm/Model/Action/AddPaymentAction.elm @@ -3,7 +3,8 @@ module Model.Action.AddPaymentAction ) where type AddPaymentAction = - UpdateName String + NoOp + | UpdateName String | UpdateCost String | AddError (Maybe String) (Maybe String) | ToggleFrequency diff --git a/src/client/elm/Model/Action/LoggedInAction.elm b/src/client/elm/Model/Action/LoggedInAction.elm index ef81b09..4538ec7 100644 --- a/src/client/elm/Model/Action/LoggedInAction.elm +++ b/src/client/elm/Model/Action/LoggedInAction.elm @@ -11,7 +11,7 @@ type LoggedInAction = NoOp | UpdateAdd AddPaymentAction | UpdatePayments Payments - | AddPayment String Int PaymentFrequency + | AddPayment String String PaymentFrequency | ValidateAddPayment PaymentId String Int PaymentFrequency | DeletePayment Payment PaymentFrequency | ValidateDeletePayment Payment PaymentFrequency diff --git a/src/client/elm/Model/View/LoggedIn/Account.elm b/src/client/elm/Model/View/LoggedIn/Account.elm index 4638c8d..d03d84f 100644 --- a/src/client/elm/Model/View/LoggedIn/Account.elm +++ b/src/client/elm/Model/View/LoggedIn/Account.elm @@ -9,8 +9,8 @@ module Model.View.LoggedIn.Account import Result as Result exposing (Result(..)) import Dict +import String -import Utils.Validation exposing (..) import Utils.Dict exposing (mapValues) import Model.Translations exposing (..) @@ -62,6 +62,10 @@ initIncomeEdition income = validateIncome : String -> Translations -> Result String Int validateIncome amount translations = - amount - |> validateNonEmpty (getMessage "IncomeRequired" translations) - |> flip Result.andThen (validateNumber (getMessage "IncomeMustBePositiveNumber" translations) (\number -> number > 0)) + case String.toInt amount of + Ok number -> + if number > 0 + then Ok number + else Err <| getMessage "IncomeMustBePositiveNumber" translations + Err _ -> + Err <| getMessage "IncomeRequired" translations diff --git a/src/client/elm/Model/View/LoggedIn/AddPayment.elm b/src/client/elm/Model/View/LoggedIn/AddPayment.elm index 3a14b00..c7680bb 100644 --- a/src/client/elm/Model/View/LoggedIn/AddPayment.elm +++ b/src/client/elm/Model/View/LoggedIn/AddPayment.elm @@ -1,13 +1,10 @@ module Model.View.LoggedIn.AddPayment ( AddPayment , initAddPayment - , validateName - , validateCost ) where import Result as Result exposing (Result(..)) - -import Utils.Validation exposing (..) +import Json.Decode exposing ((:=)) import Model.Translations exposing (..) import Model.Payment exposing (PaymentFrequency(..)) @@ -30,14 +27,3 @@ initAddPayment frequency = , frequency = frequency , waitingServer = False } - -validateName : String -> Translations -> Result String String -validateName name translations = - name - |> validateNonEmpty (getMessage "CategoryRequired" translations) - -validateCost : String -> Translations -> Result String Int -validateCost cost translations = - cost - |> validateNonEmpty (getMessage "CostRequired" translations) - |> flip Result.andThen (validateNumber (getMessage "CostRequired" translations) ((/=) 0)) diff --git a/src/client/elm/Native/Reads.js b/src/client/elm/Native/Reads.js deleted file mode 100644 index 5785aed..0000000 --- a/src/client/elm/Native/Reads.js +++ /dev/null @@ -1,22 +0,0 @@ -Elm.Native.Reads = {}; -Elm.Native.Reads.make = function(localRuntime) { - - localRuntime.Native = localRuntime.Native || {}; - localRuntime.Native.Reads = localRuntime.Native.Reads || {}; - if(localRuntime.Native.Reads.values) { - return localRuntime.Native.Reads.values; - } - - var Maybe = Elm.Maybe.make(localRuntime); - - function readInt(str) { - var number = Number(str); - return isNaN(number) || str === '' - ? Maybe.Nothing - : Maybe.Just(number); - } - - return localRuntime.Native.Reads.values = { - readInt: readInt - }; -}; diff --git a/src/client/elm/Reads.elm b/src/client/elm/Reads.elm deleted file mode 100644 index f855802..0000000 --- a/src/client/elm/Reads.elm +++ /dev/null @@ -1,10 +0,0 @@ -module Reads - ( readInt - ) where - - -import Native.Reads -import Result exposing (Result) - -readInt : String -> Maybe Int -readInt = Native.Reads.readInt diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm index 3a6c86a..e50de7e 100644 --- a/src/client/elm/Server.elm +++ b/src/client/elm/Server.elm @@ -14,16 +14,19 @@ import Json.Decode as Json exposing ((:=)) import Date import Time exposing (Time) import Debug +import String import SimpleHTTP exposing (..) import Model.Action as U exposing (Action) +import Model.Action.AddPaymentAction as AddPayment import Model.Action.LoggedInAction as UL exposing (LoggedInAction) import Model.Action.MonthlyAction as UM exposing (MonthlyAction) import Model.Action.AccountAction as UA exposing (AccountAction) import Model.Payment exposing (..) import Model.Payer exposing (Payers, payersDecoder) import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder) +import Model.Translations exposing (Translations, getMessage) import Update.SignIn exposing (updateSignIn) @@ -32,11 +35,17 @@ signIn assertion = post ("/signIn?assertion=" ++ assertion) |> flip Task.andThen (always initViewAction) -addPayment : String -> Int -> PaymentFrequency -> Task Http.Error LoggedInAction -addPayment name cost frequency = - post ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency)) +addPayment : Translations -> String -> String -> PaymentFrequency -> Task Http.Error LoggedInAction +addPayment translations name cost frequency = + post ("/payment/add?name=" ++ name ++ "&cost=" ++ cost ++ "&frequency=" ++ (toString frequency)) |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder) - |> Task.map (\paymentId -> (UL.ValidateAddPayment paymentId name cost frequency)) + |> Task.map (\paymentId -> + case String.toInt cost of + Err _ -> + UL.UpdateAdd (AddPayment.AddError Nothing (Just (getMessage "CostRequired" translations))) + Ok costNumber -> + UL.ValidateAddPayment paymentId name costNumber frequency + ) deletePayment : Payment -> PaymentFrequency -> Task Http.Error LoggedInAction deletePayment payment frequency = diff --git a/src/client/elm/SimpleHTTP.elm b/src/client/elm/SimpleHTTP.elm index 99a7056..3e01178 100644 --- a/src/client/elm/SimpleHTTP.elm +++ b/src/client/elm/SimpleHTTP.elm @@ -22,7 +22,13 @@ handleResponse : Response -> Task Error Value handleResponse response = if 200 <= response.status && response.status < 300 then Task.succeed response.value - else fail (BadResponse response.status response.statusText) + else fail (BadResponse response.status (responseString response.value)) + +responseString : Value -> String +responseString value = + case value of + Text str -> str + _ -> "" promoteError : RawError -> Error promoteError rawError = diff --git a/src/client/elm/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm index 74e213a..134aec2 100644 --- a/src/client/elm/Update/LoggedIn.elm +++ b/src/client/elm/Update/LoggedIn.elm @@ -4,9 +4,11 @@ module Update.LoggedIn import Date import Dict +import Debug +import Task import Effects exposing (Effects) -import Task +import Http exposing (Error(..)) import Server @@ -20,7 +22,7 @@ import Model.Action.AddPaymentAction as AddPayment import Model.View.LoggedInView exposing (..) import Model.View.LoggedIn.AddPayment exposing (..) -import Update.LoggedIn.AddPayment exposing (updateAddPayment) +import Update.LoggedIn.AddPayment exposing (updateAddPayment, addPaymentError) import Update.LoggedIn.Monthly exposing (updateMonthly) import Update.LoggedIn.Account exposing (updateAccount) @@ -42,8 +44,16 @@ updateLoggedIn model action loggedInView = AddPayment name cost frequency -> ( { loggedInView | add = updateAddPayment AddPayment.WaitingServer loggedInView.add } - , Server.addPayment name cost frequency - |> flip Task.onError (always <| Task.succeed NoOp) + , Server.addPayment model.translations name cost frequency + |> flip Task.onError (\err -> + case err of + BadResponse 400 jsonErr -> + case addPaymentError model.translations jsonErr of + Just addPaymentAction -> Task.succeed (UpdateAdd addPaymentAction) + Nothing -> Task.succeed NoOp + _ -> + Task.succeed NoOp + ) |> Effects.task ) diff --git a/src/client/elm/Update/LoggedIn/AddPayment.elm b/src/client/elm/Update/LoggedIn/AddPayment.elm index 3eb2ea4..4c9c484 100644 --- a/src/client/elm/Update/LoggedIn/AddPayment.elm +++ b/src/client/elm/Update/LoggedIn/AddPayment.elm @@ -1,26 +1,54 @@ module Update.LoggedIn.AddPayment ( updateAddPayment + , addPaymentError ) where +import Maybe +import Json.Decode as Json exposing ((:=)) + import Model.Action.AddPaymentAction exposing (..) import Model.View.LoggedIn.AddPayment exposing (..) +import Model.Translations exposing (Translations, getMessage) import Model.Payment exposing (PaymentFrequency(..)) updateAddPayment : AddPaymentAction -> AddPayment -> AddPayment updateAddPayment action addPayment = case action of + + NoOp -> + addPayment + UpdateName name -> { addPayment | name = name } + UpdateCost cost -> { addPayment | cost = cost } + AddError nameError costError -> { addPayment | nameError = nameError , costError = costError + , waitingServer = False } + ToggleFrequency -> { addPayment | frequency = if addPayment.frequency == Punctual then Monthly else Punctual } + WaitingServer -> { addPayment | waitingServer = True } + +addPaymentError : Translations -> String -> Maybe AddPaymentAction +addPaymentError translations jsonErr = + let decoder = + Json.object2 (,) + (Json.maybe <| "name" := Json.string) + (Json.maybe <| "cost" := Json.string) + in case Json.decodeString decoder jsonErr of + Err _ -> + Nothing + Ok (mbNameKey, mbCostKey) -> + Just <| AddError + (Maybe.map (flip getMessage translations) mbNameKey) + (Maybe.map (flip getMessage translations) mbCostKey) diff --git a/src/client/elm/Utils/Validation.elm b/src/client/elm/Utils/Validation.elm deleted file mode 100644 index b9bccb3..0000000 --- a/src/client/elm/Utils/Validation.elm +++ /dev/null @@ -1,23 +0,0 @@ -module Utils.Validation - ( validateNonEmpty - , validateNumber - ) where - -import String -import Reads exposing (readInt) - -validateNonEmpty : String -> String -> Result String String -validateNonEmpty message str = - if String.isEmpty str - then Err message - else Ok str - -validateNumber : String -> (Int -> Bool) -> String -> Result String Int -validateNumber message numberForm str = - case readInt str of - Just number -> - if numberForm number - then Ok number - else Err message - Nothing -> - Err message diff --git a/src/client/elm/View/LoggedIn/AddPayment.elm b/src/client/elm/View/LoggedIn/AddPayment.elm index 0b39591..0149432 100644 --- a/src/client/elm/View/LoggedIn/AddPayment.elm +++ b/src/client/elm/View/LoggedIn/AddPayment.elm @@ -2,7 +2,6 @@ module View.LoggedIn.AddPayment ( addPayment ) where -import Reads exposing (readInt) import Result exposing (..) import Signal exposing (Address) @@ -31,13 +30,10 @@ addPayment address model loggedInView = H.form [ let update = if loggedInView.add.waitingServer - then Action.NoOp + then + Action.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) + UpdateLoggedIn <| LoggedInAction.AddPayment loggedInView.add.name loggedInView.add.cost loggedInView.add.frequency in onSubmitPrevDefault address update , class "addPayment" ] diff --git a/src/client/elm/View/LoggedIn/Paging.elm b/src/client/elm/View/LoggedIn/Paging.elm index 154686a..b722ee7 100644 --- a/src/client/elm/View/LoggedIn/Paging.elm +++ b/src/client/elm/View/LoggedIn/Paging.elm @@ -8,7 +8,7 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Model.Action exposing (..) +import Model.Action as Action exposing (..) import Model.Action.LoggedInAction exposing (..) import Model.View.LoggedInView exposing (..) import Model.Payment exposing (perPage) @@ -94,6 +94,6 @@ paymentsPage address loggedInView page = , ("current", onCurrentPage) ] , onClick address <| - if onCurrentPage then NoOp else UpdateLoggedIn (UpdatePage page) + if onCurrentPage then Action.NoOp else UpdateLoggedIn (UpdatePage page) ] [ text (toString page) ] diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs index d2a9258..e94b300 100644 --- a/src/server/Controller/Payment.hs +++ b/src/server/Controller/Payment.hs @@ -10,23 +10,24 @@ module Controller.Payment import Web.Scotty -import Network.HTTP.Types.Status (ok200) +import Network.HTTP.Types.Status (ok200, badRequest400) import Database.Persist import Control.Monad.IO.Class (liftIO) import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Aeson.Types as Json import qualified Secure -import Json (jsonError) +import Json (jsonObject, jsonError) import Model.Database import qualified Model.Payment as P import Model.Frequency import Model.Json.Number -import qualified Model.Json.PaymentId as JP import Model.Message import Model.Message.Key (Key(PaymentNotDeleted)) @@ -42,11 +43,16 @@ getMonthlyPayments = (liftIO $ runDb (P.getUserMonthlyPayments (entityKey user))) >>= json ) -createPayment :: Text -> Int -> Frequency -> ActionM () +createPayment :: Text -> Text -> Frequency -> ActionM () createPayment name cost frequency = Secure.loggedAction (\user -> do - paymentId <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency - json (JP.PaymentId paymentId) + creationResult <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency + case creationResult of + Left errors -> do + status badRequest400 + jsonObject . map (\(a, b) -> (a, Json.String . T.pack . show $ b)) $ errors + Right paymentId -> + jsonObject [("id", Json.Number . fromIntegral . keyToInt64 $ paymentId)] ) deletePayment :: Text -> ActionM () diff --git a/src/server/Design/LoggedIn/Table.hs b/src/server/Design/LoggedIn/Table.hs index d9fc318..e5ed4bf 100644 --- a/src/server/Design/LoggedIn/Table.hs +++ b/src/server/Design/LoggedIn/Table.hs @@ -91,6 +91,7 @@ tableDesign = textAlign (alignSide sideCenter) button ? do defaultButton C.red C.white (px rowHeightPx) focusLighten + borderRadius (px 0) (px 0) (px 0) (px 0) position absolute top (px 0) right (px 0) diff --git a/src/server/Main.hs b/src/server/Main.hs index 9f21873..e5d8cca 100644 --- a/src/server/Main.hs +++ b/src/server/Main.hs @@ -61,7 +61,7 @@ main = do post "/payment/add" $ do name <- param "name" :: ActionM Text - cost <- param "cost" :: ActionM Int + cost <- param "cost" :: ActionM Text frequency <- param "frequency" :: ActionM Frequency createPayment name cost frequency diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs index 67cc8b3..a98e69a 100644 --- a/src/server/Model/Database.hs +++ b/src/server/Model/Database.hs @@ -69,3 +69,6 @@ runMigrations = runDb $ runMigration migrateAll textToKey :: (ToBackendKey SqlBackend a) => Text -> Key a textToKey text = toSqlKey (read (unpack text) :: Int64) + +keyToInt64 :: (ToBackendKey SqlBackend a) => Key a -> Int64 +keyToInt64 = fromSqlKey diff --git a/src/server/Model/Json/PaymentId.hs b/src/server/Model/Json/PaymentId.hs deleted file mode 100644 index 3cbeb3c..0000000 --- a/src/server/Model/Json/PaymentId.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.Json.PaymentId - ( PaymentId(..) - ) where - -import Data.Aeson -import GHC.Generics - -import qualified Model.Database as D - -data PaymentId = PaymentId - { id :: D.PaymentId - } deriving (Show, Generic) - -instance FromJSON PaymentId -instance ToJSON PaymentId diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index de4a759..404b143 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Model.Payment ( getPunctualPayments , getUserMonthlyPayments @@ -8,16 +10,21 @@ module Model.Payment ) where import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Clock (getCurrentTime) +import Data.Either (lefts) import Control.Monad.IO.Class (liftIO) import Database.Persist import qualified Database.Persist as P +import qualified Validation + import Model.Database import Model.Frequency import qualified Model.Json.Payment as P +import qualified Model.Message.Key as K getPunctualPayments :: Persist [P.Payment] getPunctualPayments = @@ -50,10 +57,26 @@ getJsonPayment paymentEntity = , P.userId = paymentUserId payment } -createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId -createPayment userId name cost frequency = do - now <- liftIO getCurrentTime - insert $ Payment userId now name cost Nothing frequency +createPayment :: UserId -> Text -> Text -> Frequency -> Persist (Either [(Text, K.Key)] PaymentId) +createPayment userId name cost frequency = + case validatePayment name cost of + Left err -> + return . Left $ err + Right (validatedName, validatedCost) -> do + now <- liftIO getCurrentTime + Right <$> insert (Payment userId now validatedName validatedCost Nothing frequency) + +validatePayment :: Text -> Text -> Either [(Text, K.Key)] (Text, Int) +validatePayment name cost = + let eitherName = Validation.nonEmpty K.CategoryRequired name + eitherCost = Validation.nonEmpty K.CostRequired cost >>= Validation.number K.CostRequired (/= 0) + in case (eitherName, eitherCost) of + (Right validatedName, Right validatedCost) -> + Right (validatedName, validatedCost) + _ -> + let nameErrors = map (\x -> ("name", x)) $ lefts [eitherName] + costErrors = map (\x -> ("cost", x)) $ lefts [eitherCost] + in Left (nameErrors ++ costErrors) deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool deleteOwnPayment user paymentId = do diff --git a/src/server/Validation.hs b/src/server/Validation.hs new file mode 100644 index 0000000..9035be7 --- /dev/null +++ b/src/server/Validation.hs @@ -0,0 +1,23 @@ +module Validation + ( nonEmpty + , number + ) where + +import Data.Text (Text) +import qualified Data.Text as T + +nonEmpty :: a -> Text -> Either a Text +nonEmpty x str = + if T.null str + then Left x + else Right str + +number :: x -> (Int -> Bool) -> Text -> Either x Int +number x numberForm str = + case reads (T.unpack str) :: [(Int, String)] of + (number, _) : _ -> + if numberForm number + then Right number + else Left x + _ -> + Left x -- cgit v1.2.3