From 2741f47ef7b87255203bc2f7f7b2b9140c70b8f0 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 1 Nov 2018 13:14:25 +0100 Subject: Implementing client side validation --- common/common.cabal | 12 ++++++-- common/src/Common/Message/Key.hs | 1 + common/src/Common/Message/Translation.hs | 9 ++++-- common/src/Common/Model.hs | 3 +- common/src/Common/Model/Email.hs | 12 ++++++++ common/src/Common/Model/SignIn.hs | 14 ---------- common/src/Common/Model/SignInForm.hs | 14 ++++++++++ common/src/Common/Util/Validation.hs | 13 +++++++++ common/src/Common/Validation/Atomic.hs | 47 ++++++++++++++++++++++++++++++++ common/src/Common/Validation/Payment.hs | 21 ++++++++++++++ common/src/Common/Validation/SignIn.hs | 19 +++++++++++++ 11 files changed, 145 insertions(+), 20 deletions(-) create mode 100644 common/src/Common/Model/Email.hs delete mode 100644 common/src/Common/Model/SignIn.hs create mode 100644 common/src/Common/Model/SignInForm.hs create mode 100644 common/src/Common/Util/Validation.hs create mode 100644 common/src/Common/Validation/Atomic.hs create mode 100644 common/src/Common/Validation/Payment.hs create mode 100644 common/src/Common/Validation/SignIn.hs (limited to 'common') diff --git a/common/common.cabal b/common/common.cabal index 78f2927..9881c64 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -20,19 +20,26 @@ Library OverloadedStrings Build-depends: - aeson - , base >=4.9 && <5 + aeson + , base >= 4.11 && < 5 , text , time + , validation Exposed-modules: Common.Model Common.Model.CreatePayment + Common.Model.Email Common.Model.Payment + Common.Model.SignInForm Common.Model.User Common.Msg Common.Util.Text Common.Util.Time + Common.Util.Validation + Common.Validation.Atomic + Common.Validation.Payment + Common.Validation.SignIn Common.View.Format other-modules: @@ -52,4 +59,3 @@ Library Common.Model.InitResult Common.Model.Payer Common.Model.PaymentCategory - Common.Model.SignIn diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index 6e5f246..4acba93 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -39,6 +39,7 @@ data Key = | Form_AlreadyExists | Form_NonEmpty + | Form_MinChars Int | Form_NonNullNumber | Form_GreaterIntThan Int | Form_InvalidCategory diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 70eb978..e95fa74 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -162,6 +162,11 @@ m l Form_NonEmpty = English -> "Required field" French -> "Champ requis" +m l (Form_MinChars number) = + case l of + English -> T.concat [ "This field must contains at least ", T.pack . show $ number, " characters" ] + French -> T.concat [ "Ce champ doit contenir au moins ", T.pack . show $ number, " caractères" ] + m l Form_NonNullNumber = case l of English -> "Number must not be null" @@ -184,8 +189,8 @@ m l Form_InvalidColor = m l Form_InvalidDate = case l of - English -> "day/month/year required" - French -> "jour/mois/année requis" + English -> "DD/MM/YYYY required" + French -> "JJ/MM/AAAA requis" m l Form_InvalidInt = case l of diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index cb38b2f..b0e0491 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -8,6 +8,7 @@ import Common.Model.Currency as X import Common.Model.EditCategory as X import Common.Model.EditIncome as X import Common.Model.EditPayment as X +import Common.Model.Email as X import Common.Model.Frequency as X import Common.Model.Income as X import Common.Model.Init as X @@ -15,5 +16,5 @@ import Common.Model.InitResult as X import Common.Model.Payer as X import Common.Model.Payment as X import Common.Model.PaymentCategory as X -import Common.Model.SignIn as X +import Common.Model.SignInForm as X import Common.Model.User as X diff --git a/common/src/Common/Model/Email.hs b/common/src/Common/Model/Email.hs new file mode 100644 index 0000000..e938f83 --- /dev/null +++ b/common/src/Common/Model/Email.hs @@ -0,0 +1,12 @@ +module Common.Model.Email + ( Email(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +newtype Email = Email Text deriving (Show, Generic) + +instance FromJSON Email +instance ToJSON Email diff --git a/common/src/Common/Model/SignIn.hs b/common/src/Common/Model/SignIn.hs deleted file mode 100644 index bfd7fbc..0000000 --- a/common/src/Common/Model/SignIn.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Common.Model.SignIn - ( SignIn(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -data SignIn = SignIn - { _signIn_email :: Text - } deriving (Show, Generic) - -instance FromJSON SignIn -instance ToJSON SignIn diff --git a/common/src/Common/Model/SignInForm.hs b/common/src/Common/Model/SignInForm.hs new file mode 100644 index 0000000..2b8c955 --- /dev/null +++ b/common/src/Common/Model/SignInForm.hs @@ -0,0 +1,14 @@ +module Common.Model.SignInForm + ( SignInForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data SignInForm = SignInForm + { _signIn_email :: Text + } deriving (Show, Generic) + +instance FromJSON SignInForm +instance ToJSON SignInForm diff --git a/common/src/Common/Util/Validation.hs b/common/src/Common/Util/Validation.hs new file mode 100644 index 0000000..f195d95 --- /dev/null +++ b/common/src/Common/Util/Validation.hs @@ -0,0 +1,13 @@ +module Common.Util.Validation + ( isSuccess + , isFailure + ) where + +import Data.Validation (Validation (Failure, Success)) + +isSuccess :: forall a b. Validation a b -> Bool +isSuccess (Failure _) = False +isSuccess (Success _) = True + +isFailure :: forall a b. Validation a b -> Bool +isFailure = not . isSuccess diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs new file mode 100644 index 0000000..3516668 --- /dev/null +++ b/common/src/Common/Validation/Atomic.hs @@ -0,0 +1,47 @@ +module Common.Validation.Atomic + ( nonEmpty + , minLength + , number + , nonNullNumber + , day + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Calendar (Day) +import Data.Validation (Validation) +import qualified Data.Validation as V +import qualified Text.Read as T + +import qualified Common.Msg as Msg +import qualified Common.Util.Time as Time + +minLength :: Int -> Text -> Validation Text Text +minLength l = + V.validate + (Msg.get (Msg.Form_MinChars l)) + (\t -> if T.length t >= l then Just t else Nothing) + +nonEmpty :: Text -> Validation Text Text +nonEmpty = + V.validate + (Msg.get Msg.Form_NonEmpty) + (\t -> if (not . T.null $ t) then Just t else Nothing) + +number :: Text -> Validation Text Int +number input = + case (T.readMaybe . T.unpack $ input) of + Just n -> V.Success n + _ -> V.Failure (Msg.get Msg.Form_InvalidInt) + +nonNullNumber :: Int -> Validation Text Int +nonNullNumber = + V.validate + (Msg.get Msg.Form_NonNullNumber) + (\n -> if n /= 0 then Just n else Nothing) + +day :: Text -> Validation Text Day +day str = + case Time.parseDay str of + Just d -> V.Success d + Nothing -> V.Failure $ Msg.get Msg.Form_InvalidDate diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs new file mode 100644 index 0000000..b6c1d30 --- /dev/null +++ b/common/src/Common/Validation/Payment.hs @@ -0,0 +1,21 @@ +module Common.Validation.Payment + ( name + , cost + , date + ) where + +import Data.Text (Text) +import Data.Time.Calendar (Day) +import Data.Validation (Validation) +import qualified Data.Validation as Validation + +import qualified Common.Validation.Atomic as Atomic + +name :: Text -> Validation Text Text +name = Atomic.nonEmpty + +cost :: Text -> Validation Text Int +cost input = Validation.bindValidation (Atomic.number input) Atomic.nonNullNumber + +date :: Text -> Validation Text Day +date = Atomic.day diff --git a/common/src/Common/Validation/SignIn.hs b/common/src/Common/Validation/SignIn.hs new file mode 100644 index 0000000..18ceb44 --- /dev/null +++ b/common/src/Common/Validation/SignIn.hs @@ -0,0 +1,19 @@ +module Common.Validation.SignIn + ( signIn + , email + ) where + +import Data.Text (Text) +import Data.Validation (Validation) + +import Common.Model.Email (Email (..)) +import Common.Model.SignInForm (SignInForm (..)) +import qualified Common.Validation.Atomic as Atomic +import qualified Data.Validation as Validation + +signIn :: SignInForm -> Maybe Email +signIn (SignInForm str) = + Validation.validation (const Nothing) Just . email $ str + +email :: Text -> Validation Text Email +email = fmap Email . Atomic.minLength 5 -- cgit v1.2.3