aboutsummaryrefslogtreecommitdiff
path: root/server/src
diff options
context:
space:
mode:
Diffstat (limited to 'server/src')
-rw-r--r--server/src/Controller/Index.hs26
-rw-r--r--server/src/Design/Form.hs10
-rw-r--r--server/src/Design/Global.hs59
-rw-r--r--server/src/Design/Modal.hs2
-rw-r--r--server/src/Design/View/Header.hs2
-rw-r--r--server/src/Design/View/Payment/Add.hs7
-rw-r--r--server/src/Design/View/Payment/Delete.hs3
-rw-r--r--server/src/Validation/Atomic.hs2
-rw-r--r--server/src/View/Page.hs3
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 =
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 16:27:32 +0000