Implementing client side validation

9 files changed, 85 insertions, 29 deletions

diff --git a/server/src/Controller/Index.hs b/server/src/Controller/Index.hs
index 0b276d3..fbda527 100644
--- a/server/src/Controller/Index.hs
+++ b/server/src/Controller/Index.hs
@@ -9,18 +9,18 @@ import           Control.Monad.IO.Class    (liftIO)
 import qualified Data.Aeson                as Json
 import           Data.Text                 (Text)
 import qualified Data.Text                 as T
-import qualified Data.Text.Encoding        as TE
 import qualified Data.Text.Lazy            as TL
 import           Data.Time.Clock           (diffUTCTime, getCurrentTime)
-import           Network.HTTP.Types.Status (badRequest400, ok200)
+import qualified Network.HTTP.Types.Status as Status
 import           Prelude                   hiding (error)
 import           Web.Scotty                (ActionM)
 import qualified Web.Scotty                as S
 
-import           Common.Model              (InitResult (..), SignIn (..),
-                                            User (..))
+import           Common.Model              (Email (..), InitResult (..),
+                                            SignInForm (..), User (..))
 import           Common.Msg                (Key)
 import qualified Common.Msg                as Msg
+import qualified Common.Validation.SignIn  as SignInValidation
 
 import           Conf                      (Conf (..))
 import qualified LoginSession
@@ -30,7 +30,6 @@ import qualified Persistence.Init          as InitPersistence
 import qualified Persistence.User          as UserPersistence
 import qualified Secure
 import qualified SendMail
-import qualified Text.Email.Validate       as Email
 import qualified View.Mail.SignIn          as SignIn
 import           View.Page                 (page)
 
@@ -45,10 +44,12 @@ get conf = do
         liftIO . Query.run . fmap InitSuccess $ InitPersistence.getInit user conf
   S.html $ page initResult
 
-askSignIn :: Conf -> SignIn -> ActionM ()
-askSignIn conf (SignIn email) =
-  if Email.isValid (TE.encodeUtf8 email)
-    then do
+askSignIn :: Conf -> SignInForm -> ActionM ()
+askSignIn conf form =
+  case SignInValidation.signIn form of
+    Nothing ->
+      textKey Status.badRequest400 Msg.SignIn_EmailInvalid
+    Just (Email email) -> do
       maybeUser <- liftIO . Query.run $ UserPersistence.get email
       case maybeUser of
         Just user -> do
@@ -62,9 +63,8 @@ askSignIn conf (SignIn email) =
           maybeSentMail <- liftIO . SendMail.sendMail conf $ SignIn.mail conf user url [email]
           case maybeSentMail of
             Right _ -> S.json (Json.String . Msg.get $ Msg.SignIn_EmailSent)
-            Left _  -> textKey badRequest400 Msg.SignIn_EmailSendFail
-        Nothing -> textKey badRequest400 Msg.Secure_Unauthorized
-    else textKey badRequest400 Msg.SignIn_EmailInvalid
+            Left _  -> textKey Status.badRequest400 Msg.SignIn_EmailSendFail
+        Nothing -> textKey Status.badRequest400 Msg.Secure_Unauthorized
   where textKey st key = S.status st >> (S.text . TL.fromStrict $ Msg.get key)
 
 trySignIn :: Conf -> Text -> ActionM ()
@@ -116,4 +116,4 @@ getLoggedUser = do
       liftIO . Query.run . Secure.getUserFromToken $ token
 
 signOut :: Conf -> ActionM ()
-signOut conf = LoginSession.delete conf >> S.status ok200
+signOut conf = LoginSession.delete conf >> S.status Status.ok200
diff --git a/server/src/Design/Form.hs b/server/src/Design/Form.hs
index 0385cb4..31a2127 100644
--- a/server/src/Design/Form.hs
+++ b/server/src/Design/Form.hs
@@ -22,7 +22,7 @@ design = do
 
   ".textInput" ? do
     position relative
-    marginBottom (em 1.5)
+    marginBottom (em 2)
     paddingTop (px inputTop)
     marginTop (px (-10))
 
@@ -46,7 +46,7 @@ design = do
       position absolute
       top (px inputTop)
       left (px 0)
-      transition "all" (sec 0.2) easeIn (sec 0)
+      transition "all" (sec 0.2) easeInOut (sec 0)
 
     button ? do
       position absolute
@@ -110,11 +110,13 @@ design = do
         fontWeight bold
 
   ".selectInput" ? do
-    marginBottom (em 1)
+    marginBottom (em 2)
+
     label ? do
       display block
       marginBottom (px 10)
       fontSize (pct 80)
+
     select ? do
       width (pct 100)
       backgroundColor Color.white
@@ -122,6 +124,8 @@ design = do
       sym borderRadius (px 3)
       sym2 padding (px 5) (px 8)
       option ? sym2 padding (px 5) (px 8)
+      focus & backgroundColor Color.wildSand
+
     ".error" & do
       select ? borderColor Color.chestnutRose
       ".errorMessage" ? do
diff --git a/server/src/Design/Global.hs b/server/src/Design/Global.hs
index ba4ccb7..66e9f47 100644
--- a/server/src/Design/Global.hs
+++ b/server/src/Design/Global.hs
@@ -3,6 +3,7 @@ module Design.Global
   ) where
 
 import           Clay
+import           Clay.Color       as C
 import           Data.Text.Lazy   (Text)
 
 import qualified Design.Color     as Color
@@ -26,8 +27,16 @@ global = do
   Views.design
   Form.design
 
+  spinKeyframes
+  appearKeyframe
+
+  html ? do
+    height (pct 100)
+
   body ? do
+    position relative
     minWidth (px 320)
+    height (pct 100)
     fontFamily ["Cantarell"] [sansSerif]
     ".modal" &
       overflowY hidden
@@ -40,6 +49,28 @@ global = do
       button ? fontSize (px 14)
       input ? fontSize (px 14)
 
+  ".app" ? do
+    appearAnimation
+
+  ".spinner" ? do
+    display flex
+    alignItems center
+    justifyContent center
+    width (pct 100)
+    height (pct 100)
+    paddingBottom (pct 10)
+
+    before & do
+      display block
+      content (stringContent "")
+      width (px 50)
+      height (px 50)
+      border solid (px 3) (C.setA 0.3 Color.chestnutRose)
+      sym borderRadius (pct 50)
+      borderTopColor Color.chestnutRose
+      spinKeyframes
+      spinAnimation
+
   a ? cursor pointer
 
   input ? fontSize inherit
@@ -87,21 +118,31 @@ global = do
         opacity 0
       svg # ".loader" ? do
         opacity 1
-        rotateKeyframes
-        rotateAnimation
+        spinAnimation
 
   select ? cursor pointer
 
-rotateAnimation :: Css
-rotateAnimation = do
+spinAnimation :: Css
+spinAnimation = do
   animationName "rotate"
   animationDuration (sec 1)
-  animationTimingFunction easeOut
+  animationTimingFunction easeInOut
   animationIterationCount infinite
 
-rotateKeyframes :: Css
-rotateKeyframes = keyframes
+spinKeyframes :: Css
+spinKeyframes = keyframes
   "rotate"
-  [ (0, "transform" -: "rotate(0deg)")
-  , (100, "transform" -: "rotate(360deg)")
+  [ (100, "transform" -: "rotate(360deg)")
+  ]
+
+appearAnimation :: Css
+appearAnimation = do
+  animationName "appear"
+  animationDuration (sec 0.2)
+  animationTimingFunction easeIn
+
+appearKeyframe :: Css
+appearKeyframe = keyframes
+  "appear"
+  [ (0, "opacity" -: "0")
   ]
diff --git a/server/src/Design/Modal.hs b/server/src/Design/Modal.hs
index 914c011..9c016b9 100644
--- a/server/src/Design/Modal.hs
+++ b/server/src/Design/Modal.hs
@@ -23,7 +23,7 @@ design = do
     transition "all" (sec 0.2) ease (sec 0)
 
   ".modalContent" ? do
-    minWidth (px 270)
+    minWidth (px 300)
     position fixed
     top (pct 25)
     left (pct 50)
diff --git a/server/src/Design/View/Header.hs b/server/src/Design/View/Header.hs
index 97f1802..2422686 100644
--- a/server/src/Design/View/Header.hs
+++ b/server/src/Design/View/Header.hs
@@ -56,6 +56,8 @@ design = do
 
     ".signOut" ? do
       display flex
+      justifyContent center
+      alignItems center
       svg ? do
         Media.tabletDesktop $ width (px 30)
         Media.mobile $ width (px 20)
diff --git a/server/src/Design/View/Payment/Add.hs b/server/src/Design/View/Payment/Add.hs
index 199ad36..5ecae7a 100644
--- a/server/src/Design/View/Payment/Add.hs
+++ b/server/src/Design/View/Payment/Add.hs
@@ -14,12 +14,12 @@ design = do
     backgroundColor Color.chestnutRose
     fontSize (px 18)
     color Color.white
-    sym padding (px 20)
+    sym2 padding (px 20) (px 30)
     textAlign (alignSide sideCenter)
     borderRadius (px 5) (px 5) (px 0) (px 0)
 
   ".addContent" ? do
-    sym padding (px 20)
+    sym2 padding (px 20) (px 30)
 
     ".buttons" ? do
       display flex
@@ -30,3 +30,6 @@ design = do
         Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
       ".undo" ?
         Helper.button Color.silver Color.white (px Constants.inputHeight) Constants.focusLighten
+
+      (".confirm" <> ".undo") ?
+        width (px 90)
diff --git a/server/src/Design/View/Payment/Delete.hs b/server/src/Design/View/Payment/Delete.hs
index 5597f5b..f3d7e3f 100644
--- a/server/src/Design/View/Payment/Delete.hs
+++ b/server/src/Design/View/Payment/Delete.hs
@@ -30,3 +30,6 @@ design = do
         Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
       ".undo" ?
         Helper.button Color.silver Color.white (px Constants.inputHeight) Constants.focusLighten
+
+      (".confirm" <> ".undo") ?
+        width (px 90)
diff --git a/server/src/Validation/Atomic.hs b/server/src/Validation/Atomic.hs
index d15ad49..7a7351a 100644
--- a/server/src/Validation/Atomic.hs
+++ b/server/src/Validation/Atomic.hs
@@ -19,7 +19,7 @@ nonNullNumber :: Int -> Maybe Text
 nonNullNumber n =
   if n == 0
      then Just $ Msg.get Msg.Form_NonNullNumber
-    else Nothing
+     else Nothing
 
 -- number :: (Int -> Bool) -> Text -> Maybe Int
 -- number numberForm str =
diff --git a/server/src/View/Page.hs b/server/src/View/Page.hs
index 97b84fa..f47c544 100644
--- a/server/src/View/Page.hs
+++ b/server/src/View/Page.hs
@@ -31,6 +31,9 @@ page initResult =
       link ! rel "stylesheet" ! type_ "text/css" ! href "/css/reset.css"
       link ! rel "icon" ! type_ "image/png" ! href "/images/icon.png"
       H.style $ toHtml globalDesign
+    H.body $ do
+      H.div ! A.class_ "spinner" $ ""
+
 
 jsonScript :: Json.ToJSON a => Text -> a -> Html
 jsonScript scriptId json =