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/src/Common/Validation/Atomic.hs | 47 +++++++++++++++++++++++++++++++++ common/src/Common/Validation/Payment.hs | 21 +++++++++++++++ common/src/Common/Validation/SignIn.hs | 19 +++++++++++++ 3 files changed, 87 insertions(+) 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/src/Common/Validation') 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 From 7529a18ff0ac443e7f9764b5e2d0f57a5d3a850b Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 9 Oct 2019 23:16:00 +0200 Subject: Use common payment validation in the backend Remove deprecated backend validation --- common/src/Common/Validation/Payment.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'common/src/Common/Validation') diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs index b6c1d30..1bb00ce 100644 --- a/common/src/Common/Validation/Payment.hs +++ b/common/src/Common/Validation/Payment.hs @@ -2,20 +2,31 @@ module Common.Validation.Payment ( name , cost , date + , category ) where import Data.Text (Text) import Data.Time.Calendar (Day) import Data.Validation (Validation) -import qualified Data.Validation as Validation +import qualified Data.Validation as V +import Common.Model (CategoryId) +import qualified Common.Msg as Msg 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 +cost input = V.bindValidation (Atomic.number input) Atomic.nonNullNumber date :: Text -> Validation Text Day date = Atomic.day + +category :: [CategoryId] -> CategoryId -> Validation Text CategoryId +category cs c = + if elem c cs then + V.Success c + else + V.Failure $ Msg.get Msg.Form_InvalidCategory -- cgit v1.2.3 From 7aadcc97f9df0e2daccbe8a8726d8bc6c63d67f4 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 20 Oct 2019 12:02:21 +0200 Subject: Add income --- common/src/Common/Validation/Income.hs | 17 +++++++++++++++++ common/src/Common/Validation/Payment.hs | 1 - 2 files changed, 17 insertions(+), 1 deletion(-) create mode 100644 common/src/Common/Validation/Income.hs (limited to 'common/src/Common/Validation') diff --git a/common/src/Common/Validation/Income.hs b/common/src/Common/Validation/Income.hs new file mode 100644 index 0000000..7a58bab --- /dev/null +++ b/common/src/Common/Validation/Income.hs @@ -0,0 +1,17 @@ +module Common.Validation.Income + ( amount + , date + ) where + +import Data.Text (Text) +import Data.Time.Calendar (Day) +import Data.Validation (Validation) +import qualified Data.Validation as V + +import qualified Common.Validation.Atomic as Atomic + +amount :: Text -> Validation Text Int +amount input = V.bindValidation (Atomic.number input) Atomic.nonNullNumber + +date :: Text -> Validation Text Day +date = Atomic.day diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs index 1bb00ce..e3c447a 100644 --- a/common/src/Common/Validation/Payment.hs +++ b/common/src/Common/Validation/Payment.hs @@ -14,7 +14,6 @@ import Common.Model (CategoryId) import qualified Common.Msg as Msg import qualified Common.Validation.Atomic as Atomic - name :: Text -> Validation Text Text name = Atomic.nonEmpty -- cgit v1.2.3 From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 8 Dec 2019 11:39:37 +0100 Subject: Add category page --- common/src/Common/Validation/Atomic.hs | 5 +++++ common/src/Common/Validation/Category.hs | 15 +++++++++++++++ 2 files changed, 20 insertions(+) create mode 100644 common/src/Common/Validation/Category.hs (limited to 'common/src/Common/Validation') diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs index 3516668..2a356df 100644 --- a/common/src/Common/Validation/Atomic.hs +++ b/common/src/Common/Validation/Atomic.hs @@ -4,6 +4,7 @@ module Common.Validation.Atomic , number , nonNullNumber , day + , color ) where import Data.Text (Text) @@ -45,3 +46,7 @@ day str = case Time.parseDay str of Just d -> V.Success d Nothing -> V.Failure $ Msg.get Msg.Form_InvalidDate + +-- TODO: validate +color :: Text -> Validation Text Text +color str = V.Success str diff --git a/common/src/Common/Validation/Category.hs b/common/src/Common/Validation/Category.hs new file mode 100644 index 0000000..f9e6ab4 --- /dev/null +++ b/common/src/Common/Validation/Category.hs @@ -0,0 +1,15 @@ +module Common.Validation.Category + ( name + , color + ) where + +import Data.Text (Text) +import Data.Validation (Validation) + +import qualified Common.Validation.Atomic as Atomic + +name :: Text -> Validation Text Text +name = Atomic.nonEmpty + +color :: Text -> Validation Text Text +color = Atomic.color -- cgit v1.2.3 From da2a0c13aa89705c65fdb9df2f496fb4eea29654 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 4 Jan 2020 19:22:45 +0100 Subject: Allow to remove only unused categories --- common/src/Common/Validation/Atomic.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'common/src/Common/Validation') diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs index 2a356df..4bb7cad 100644 --- a/common/src/Common/Validation/Atomic.hs +++ b/common/src/Common/Validation/Atomic.hs @@ -7,6 +7,7 @@ module Common.Validation.Atomic , color ) where +import qualified Data.Char as Char import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (Day) @@ -47,6 +48,10 @@ day str = Just d -> V.Success d Nothing -> V.Failure $ Msg.get Msg.Form_InvalidDate --- TODO: validate color :: Text -> Validation Text Text -color str = V.Success str +color str = + if T.take 1 str == "#" && T.all Char.isHexDigit (T.drop 1 str) then + V.Success str + + else + V.Failure (Msg.get Msg.Form_InvalidColor) -- cgit v1.2.3 From af8353c6164aaaaa836bfed181f883ac86bb76a5 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Jan 2020 14:03:31 +0100 Subject: Sign in with email and password --- common/src/Common/Validation/Atomic.hs | 12 ++++++++---- common/src/Common/Validation/SignIn.hs | 14 ++++++-------- 2 files changed, 14 insertions(+), 12 deletions(-) (limited to 'common/src/Common/Validation') diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs index 4bb7cad..9c21e14 100644 --- a/common/src/Common/Validation/Atomic.hs +++ b/common/src/Common/Validation/Atomic.hs @@ -1,10 +1,11 @@ module Common.Validation.Atomic - ( nonEmpty + ( color + , day , minLength - , number + , nonEmpty , nonNullNumber - , day - , color + , number + , password ) where import qualified Data.Char as Char @@ -55,3 +56,6 @@ color str = else V.Failure (Msg.get Msg.Form_InvalidColor) + +password :: Text -> Validation Text Text +password = minLength 8 diff --git a/common/src/Common/Validation/SignIn.hs b/common/src/Common/Validation/SignIn.hs index 18ceb44..ac9cc37 100644 --- a/common/src/Common/Validation/SignIn.hs +++ b/common/src/Common/Validation/SignIn.hs @@ -1,19 +1,17 @@ module Common.Validation.SignIn - ( signIn - , email + ( email + , password ) where import Data.Text (Text) import Data.Validation (Validation) import Common.Model.Email (Email (..)) -import Common.Model.SignInForm (SignInForm (..)) +import Common.Model.Password (Password (..)) 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 + +password :: Text -> Validation Text Password +password = fmap Password . Atomic.minLength 8 -- cgit v1.2.3