Modify weelky report and payment search interface

- Add payment balance in weekly report
- Show a message and hide pages when the search results in no results
- Go to page 1 when the search is updated / erased

3 files changed, 56 insertions, 67 deletions

diff --git a/server/src/Controller/Index.hs b/server/src/Controller/Index.hs
index f05ce6f..9a3e2b7 100644
--- a/server/src/Controller/Index.hs
+++ b/server/src/Controller/Index.hs
@@ -1,16 +1,23 @@
 module Controller.Index
   ( get
+  , askSignIn
+  , trySignIn
   , signOut
   ) where
 
 import           Control.Monad.IO.Class    (liftIO)
 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 (ok200)
+import           Network.HTTP.Types.Status (badRequest400, ok200)
 import           Prelude                   hiding (error)
-import           Web.Scotty                hiding (get)
+import           Web.Scotty                (ActionM)
+import qualified Web.Scotty                as S
 
-import           Common.Model              (InitResult (..), User (..))
+import           Common.Model              (InitResult (..), SignIn (..),
+                                            User (..))
 import           Common.Msg                (Key)
 import qualified Common.Msg                as Msg
 
@@ -21,26 +28,52 @@ import qualified Model.Query               as Query
 import qualified Model.SignIn              as SignIn
 import qualified Model.User                as User
 import           Secure                    (getUserFromToken)
+import qualified SendMail
+import qualified Text.Email.Validate       as Email
+import qualified View.Mail.SignIn          as SignIn
 import           View.Page                 (page)
 
-get :: Conf -> Maybe Text -> ActionM ()
-get conf mbToken = do
-  initResult <- case mbToken of
-    Just token -> do
-      userOrError <- validateSignIn conf token
-      case userOrError of
-        Left errorKey ->
-          return . InitEmpty . Left . Msg.get $ errorKey
-        Right user ->
-          liftIO . Query.run . fmap InitSuccess $ getInit user conf
-    Nothing -> do
-      mbLoggedUser <- getLoggedUser
-      case mbLoggedUser of
-        Nothing ->
-          return . InitEmpty . Right $ Nothing
-        Just user ->
-          liftIO . Query.run . fmap InitSuccess $ getInit user conf
-  html $ page initResult
+get :: Conf -> ActionM ()
+get conf = do
+  initResult <- do
+    mbLoggedUser <- getLoggedUser
+    case mbLoggedUser of
+      Nothing ->
+        return . InitEmpty . Right $ Nothing
+      Just user ->
+        liftIO . Query.run . fmap InitSuccess $ getInit user conf
+  S.html $ page initResult
+
+askSignIn :: Conf -> SignIn -> ActionM ()
+askSignIn conf (SignIn email) =
+  if Email.isValid (TE.encodeUtf8 email)
+    then do
+      maybeUser <- liftIO . Query.run $ User.get email
+      case maybeUser of
+        Just user -> do
+          token <- liftIO . Query.run $ SignIn.createSignInToken email
+          let url = T.concat [
+                      if Conf.https conf then "https://" else "http://",
+                      Conf.hostname conf,
+                      "/signIn/",
+                      token
+                    ]
+          maybeSentMail <- liftIO . SendMail.sendMail conf $ SignIn.mail conf user url [email]
+          case maybeSentMail of
+            Right _ -> textKey ok200 Msg.SignIn_EmailSent
+            Left _  -> textKey badRequest400 Msg.SignIn_EmailSendFail
+        Nothing -> textKey badRequest400 Msg.Secure_Unauthorized
+    else textKey badRequest400 Msg.SignIn_EmailInvalid
+  where textKey st key = S.status st >> (S.text . TL.fromStrict $ Msg.get key)
+
+trySignIn :: Conf -> Text -> ActionM ()
+trySignIn conf token = do
+  userOrError <- validateSignIn conf token
+  case userOrError of
+    Left errorKey ->
+      S.html $ page (InitEmpty . Left . Msg.get $ errorKey)
+    Right _ ->
+      S.redirect "/"
 
 validateSignIn :: Conf -> Text -> ActionM (Either Key User)
 validateSignIn conf textToken = do
@@ -82,4 +115,4 @@ getLoggedUser = do
       liftIO . Query.run . getUserFromToken $ token
 
 signOut :: Conf -> ActionM ()
-signOut conf = LoginSession.delete conf >> status ok200
+signOut conf = LoginSession.delete conf >> S.status ok200
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index c6c874a..f2af6c9 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -22,7 +22,7 @@ import qualified Secure
 list :: ActionM ()
 list =
   Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ Payment.list) >>= json
+    (liftIO . Query.run $ Payment.listActive) >>= json
   )
 
 create :: CreatePayment -> ActionM ()
diff --git a/server/src/Controller/SignIn.hs b/server/src/Controller/SignIn.hs
deleted file mode 100644
index cf92c9f..0000000
--- a/server/src/Controller/SignIn.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-module Controller.SignIn
-  ( signIn
-  ) where
-
-import           Control.Monad.IO.Class    (liftIO)
-import qualified Data.Text                 as T
-import qualified Data.Text.Encoding        as TE
-import qualified Data.Text.Lazy            as TL
-import           Network.HTTP.Types.Status (badRequest400, ok200)
-import           Web.Scotty
-
-import           Common.Model              (SignIn (..))
-import qualified Common.Msg                as Msg
-
-import           Conf                      (Conf)
-import qualified Conf
-import qualified Model.Query               as Query
-import qualified Model.SignIn              as SignIn
-import qualified Model.User                as User
-import qualified SendMail
-import qualified Text.Email.Validate       as Email
-import qualified View.Mail.SignIn          as SignIn
-
-signIn :: Conf -> SignIn -> ActionM ()
-signIn conf (SignIn email) =
-  if Email.isValid (TE.encodeUtf8 email)
-    then do
-      maybeUser <- liftIO . Query.run $ User.get email
-      case maybeUser of
-        Just user -> do
-          token <- liftIO . Query.run $ SignIn.createSignInToken email
-          let url = T.concat [
-                      if Conf.https conf then "https://" else "http://",
-                      Conf.hostname conf,
-                      "?signInToken=",
-                      token
-                    ]
-          maybeSentMail <- liftIO . SendMail.sendMail $ SignIn.mail conf user url [email]
-          case maybeSentMail of
-            Right _ -> textKey ok200 Msg.SignIn_EmailSent
-            Left _  -> textKey badRequest400 Msg.SignIn_EmailSendFail
-        Nothing -> textKey badRequest400 Msg.Secure_Unauthorized
-    else textKey badRequest400 Msg.SignIn_EmailInvalid
-  where textKey st key = status st >> (text . TL.fromStrict $ Msg.get key)