Implementing client side validation

10 files changed, 136 insertions, 11 deletions

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/SignInForm.hs
index bfd7fbc..2b8c955 100644
--- a/common/src/Common/Model/SignIn.hs
+++ b/common/src/Common/Model/SignInForm.hs
@@ -1,14 +1,14 @@
-module Common.Model.SignIn
-  ( SignIn(..)
+module Common.Model.SignInForm
+  ( SignInForm(..)
   ) where
 
 import           Data.Aeson   (FromJSON, ToJSON)
 import           Data.Text    (Text)
 import           GHC.Generics (Generic)
 
-data SignIn = SignIn
+data SignInForm = SignInForm
   { _signIn_email :: Text
   } deriving (Show, Generic)
 
-instance FromJSON SignIn
-instance ToJSON SignIn
+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