From a4acc2e84158fa822f88a1d0bdddb470708b5809 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 3 Jan 2018 17:31:20 +0100
Subject: 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
---
 server/src/Conf.hs                   |  4 +-
 server/src/Controller/Index.hs       | 77 ++++++++++++++++++++++++----------
 server/src/Controller/Payment.hs     |  2 +-
 server/src/Controller/SignIn.hs      | 44 --------------------
 server/src/Design/View/SignIn.hs     |  2 +-
 server/src/Job/MonthlyPayment.hs     |  2 +-
 server/src/Job/WeeklyReport.hs       |  7 +---
 server/src/Main.hs                   | 81 +++++++++++++-----------------------
 server/src/Model/Income.hs           | 12 +-----
 server/src/Model/Init.hs             |  2 +-
 server/src/Model/Mail.hs             |  8 ++--
 server/src/Model/Payment.hs          | 41 +++++++-----------
 server/src/SendMail.hs               | 39 +++++++++++++----
 server/src/View/Mail/SignIn.hs       |  2 +-
 server/src/View/Mail/WeeklyReport.hs | 32 +++++++++++---
 server/src/View/Page.hs              |  6 +--
 16 files changed, 176 insertions(+), 185 deletions(-)
 delete mode 100644 server/src/Controller/SignIn.hs

(limited to 'server/src')

diff --git a/server/src/Conf.hs b/server/src/Conf.hs
index 2422a93..ca19c8d 100644
--- a/server/src/Conf.hs
+++ b/server/src/Conf.hs
@@ -17,6 +17,7 @@ data Conf = Conf
   , currency         :: Currency
   , noReplyMail      :: Text
   , https            :: Bool
+  , devMode          :: Bool
   } deriving Show
 
 get :: FilePath -> IO Conf
@@ -30,7 +31,8 @@ get path = do
         Conf.lookup "signInExpiration" conf <*>
         fmap Currency (Conf.lookup "currency" conf) <*>
         Conf.lookup "noReplyMail" conf <*>
-        Conf.lookup "https" conf
+        Conf.lookup "https" conf <*>
+        Conf.lookup "devMode" conf
     )
   case conf of
     Left msg -> error (T.unpack msg)
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)
diff --git a/server/src/Design/View/SignIn.hs b/server/src/Design/View/SignIn.hs
index 4d4be7b..7f5f503 100644
--- a/server/src/Design/View/SignIn.hs
+++ b/server/src/Design/View/SignIn.hs
@@ -23,7 +23,7 @@ design = do
     width (pct 100)
     marginBottom (px 10)
 
-  button ? do
+  button # ".validate" ? do
     Helper.button Color.gothic Color.white (px inputHeight) Constants.focusLighten
     display flex
     alignItems center
diff --git a/server/src/Job/MonthlyPayment.hs b/server/src/Job/MonthlyPayment.hs
index ca7e007..907be2b 100644
--- a/server/src/Job/MonthlyPayment.hs
+++ b/server/src/Job/MonthlyPayment.hs
@@ -12,7 +12,7 @@ import           Util.Time       (timeToDay)
 
 monthlyPayment :: Maybe UTCTime -> IO UTCTime
 monthlyPayment _ = do
-  monthlyPayments <- Query.run Payment.listMonthly
+  monthlyPayments <- Query.run Payment.listActiveMonthlyOrderedByName
   now <- getCurrentTime
   actualDay <- timeToDay now
   let punctualPayments = map
diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
index 74180df..38d88b5 100644
--- a/server/src/Job/WeeklyReport.hs
+++ b/server/src/Job/WeeklyReport.hs
@@ -19,10 +19,7 @@ weeklyReport conf mbLastExecution = do
     Nothing -> return ()
     Just lastExecution -> do
       (payments, incomes, users) <- Query.run $
-        (,,) <$>
-          Payment.modifiedDuring lastExecution now <*>
-          Income.modifiedDuring lastExecution now <*>
-          User.list
-      _ <- SendMail.sendMail (WeeklyReport.mail conf users payments incomes lastExecution now)
+        (,,) <$> Payment.listPunctual <*> Income.list <*> User.list
+      _ <- SendMail.sendMail conf (WeeklyReport.mail conf users payments incomes lastExecution now)
       return ()
   return now
diff --git a/server/src/Main.hs b/server/src/Main.hs
index c8080dc..e298a06 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -1,83 +1,62 @@
-import           Control.Applicative           (liftA3)
-import           Control.Monad.IO.Class        (liftIO)
-
-import qualified Data.Text.Lazy                as LT
 import           Network.Wai.Middleware.Gzip   (GzipFiles (GzipCompress))
 import qualified Network.Wai.Middleware.Gzip   as W
 import           Network.Wai.Middleware.Static
-import           Web.Scotty
-
-import           Common.Model                  (Frequency (..), Payment (..))
-import qualified Common.Model                  as CM
+import qualified Web.Scotty                    as S
 
 import qualified Conf
 import qualified Controller.Category           as Category
 import qualified Controller.Income             as Income
 import qualified Controller.Index              as Index
 import qualified Controller.Payment            as Payment
-import qualified Controller.SignIn             as SignIn
-import qualified Data.Time                     as Time
 import           Job.Daemon                    (runDaemons)
-import qualified Model.Income                  as IncomeM
-import qualified Model.Payment                 as PaymentM
-import qualified Model.Query                   as Query
-import qualified Model.User                    as UserM
 
 main :: IO ()
 main = do
   conf <- Conf.get "application.conf"
   _ <- runDaemons conf
-  scotty (Conf.port conf) $ do
-    middleware $ W.gzip $ W.def { W.gzipFiles = GzipCompress }
-    middleware . staticPolicy $ noDots >-> addBase "public"
+  S.scotty (Conf.port conf) $ do
+    S.middleware $ W.gzip $ W.def { W.gzipFiles = GzipCompress }
+    S.middleware . staticPolicy $ noDots >-> addBase "public"
 
-    get "/exceedingPayer" $ do
-      time <- liftIO Time.getCurrentTime
-      (users, incomes, payments) <- liftIO . Query.run $
-        liftA3 (,,) UserM.list IncomeM.list PaymentM.list
-      let punctualPayments = filter ((==) Punctual . _payment_frequency) payments
-          exceedingPayers = CM.getExceedingPayers time users incomes punctualPayments
-      text . LT.pack . show $ exceedingPayers
+    S.get "/" $ do
+      Index.get conf
 
-    get "/" $ do
-      signInToken <- mbParam "signInToken"
-      Index.get conf signInToken
+    S.post "/askSignIn" $ do
+      S.jsonData >>= Index.askSignIn conf
 
-    post "/signIn" $ do
-      jsonData >>= SignIn.signIn conf
+    S.get "/signIn/:signInToken" $ do
+      signInToken <- S.param "signInToken"
+      Index.trySignIn conf signInToken
 
-    post "/signOut" $
+    S.post "/signOut" $
       Index.signOut conf
 
-    post "/payment" $
-      jsonData >>= Payment.create
+    S.post "/payment" $
+      S.jsonData >>= Payment.create
 
-    put "/payment" $
-      jsonData >>= Payment.editOwn
+    S.put "/payment" $
+      S.jsonData >>= Payment.editOwn
 
-    delete "/payment" $ do
-      paymentId <- param "id"
+    S.delete "/payment" $ do
+      paymentId <- S.param "id"
       Payment.deleteOwn paymentId
 
-    post "/income" $
-      jsonData >>= Income.create
+    S.post "/income" $
+      S.jsonData >>= Income.create
 
-    put "/income" $
-      jsonData >>= Income.editOwn
+    S.put "/income" $
+      S.jsonData >>= Income.editOwn
 
-    delete "/income" $ do
-      incomeId <- param "id"
+    S.delete "/income" $ do
+      incomeId <- S.param "id"
       Income.deleteOwn incomeId
 
-    post "/category" $
-      jsonData >>= Category.create
+    S.post "/category" $
+      S.jsonData >>= Category.create
 
-    put "/category" $
-      jsonData >>= Category.edit
+    S.put "/category" $
+      S.jsonData >>= Category.edit
 
-    delete "/category" $ do
-      categoryId <- param "id"
+    S.delete "/category" $ do
+      categoryId <- S.param "id"
       Category.delete categoryId
-
-mbParam :: Parsable a => LT.Text -> ActionM (Maybe a)
-mbParam key = (Just <$> param key) `rescue` (const . return $ Nothing)
diff --git a/server/src/Model/Income.hs b/server/src/Model/Income.hs
index a6174bc..4938e50 100644
--- a/server/src/Model/Income.hs
+++ b/server/src/Model/Income.hs
@@ -5,12 +5,11 @@ module Model.Income
   , create
   , editOwn
   , deleteOwn
-  , modifiedDuring
   ) where
 
 import           Data.Maybe             (listToMaybe)
 import           Data.Time.Calendar     (Day)
-import           Data.Time.Clock        (UTCTime, getCurrentTime)
+import           Data.Time.Clock        (getCurrentTime)
 import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
 import qualified Database.SQLite.Simple as SQLite
 import           Prelude                hiding (id)
@@ -87,12 +86,3 @@ deleteOwn user incomeId =
       Nothing ->
         return False
   )
-
-modifiedDuring :: UTCTime -> UTCTime -> Query [Income]
-modifiedDuring start end =
-  Query (\conn ->
-    SQLite.query
-      conn
-      "SELECT * FROM income WHERE (created_at >= ? AND created_at <= ?) OR (edited_at >= ? AND edited_at <= ?) OR (deleted_at >= ? AND deleted_at <= ?)"
-      (start, end, start, end, start, end)
-  )
diff --git a/server/src/Model/Init.hs b/server/src/Model/Init.hs
index be44c72..0a0ffc7 100644
--- a/server/src/Model/Init.hs
+++ b/server/src/Model/Init.hs
@@ -18,7 +18,7 @@ getInit user conf =
   Init <$>
     User.list <*>
     (return . _user_id $ user) <*>
-    Payment.list <*>
+    Payment.listActive <*>
     Income.list <*>
     Category.list <*>
     PaymentCategory.list <*>
diff --git a/server/src/Model/Mail.hs b/server/src/Model/Mail.hs
index a19f9ae..780efcc 100644
--- a/server/src/Model/Mail.hs
+++ b/server/src/Model/Mail.hs
@@ -5,8 +5,8 @@ module Model.Mail
 import           Data.Text (Text)
 
 data Mail = Mail
-  { from      :: Text
-  , to        :: [Text]
-  , subject   :: Text
-  , plainBody :: Text
+  { from    :: Text
+  , to      :: [Text]
+  , subject :: Text
+  , body    :: Text
   } deriving (Eq, Show)
diff --git a/server/src/Model/Payment.hs b/server/src/Model/Payment.hs
index 33551e5..5b29409 100644
--- a/server/src/Model/Payment.hs
+++ b/server/src/Model/Payment.hs
@@ -3,19 +3,18 @@
 module Model.Payment
   ( Payment(..)
   , find
-  , list
-  , listMonthly
+  , listActive
+  , listPunctual
+  , listActiveMonthlyOrderedByName
   , create
   , createMany
   , editOwn
   , deleteOwn
-  , modifiedDuring
   ) where
 
 import           Data.Maybe                     (listToMaybe)
 import           Data.Text                      (Text)
 import qualified Data.Text                      as T
-import           Data.Time                      (UTCTime)
 import           Data.Time.Calendar             (Day)
 import           Data.Time.Clock                (getCurrentTime)
 import           Database.SQLite.Simple         (FromRow (fromRow), Only (Only),
@@ -66,14 +65,22 @@ find paymentId =
     SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
   )
 
-list :: Query [Payment]
-list =
+listActive :: Query [Payment]
+listActive =
   Query (\conn ->
     SQLite.query_ conn "SELECT * FROM payment WHERE deleted_at IS NULL"
   )
 
-listMonthly :: Query [Payment]
-listMonthly =
+listPunctual :: Query [Payment]
+listPunctual =
+  Query (\conn ->
+    SQLite.query
+      conn
+      (SQLite.Query "SELECT * FROM payment WHERE frequency = ?")
+      (Only Punctual))
+
+listActiveMonthlyOrderedByName :: Query [Payment]
+listActiveMonthlyOrderedByName =
   Query (\conn ->
     SQLite.query
       conn
@@ -83,8 +90,7 @@ listMonthly =
         , "WHERE deleted_at IS NULL AND frequency = ?"
         , "ORDER BY name DESC"
         ])
-      (Only Monthly)
-  )
+      (Only Monthly))
 
 create :: UserId -> Text -> Int -> Day -> Frequency -> Query PaymentId
 create userId paymentName paymentCost paymentDate paymentFrequency =
@@ -161,18 +167,3 @@ deleteOwn userId paymentId =
       Nothing ->
         return False
   )
-
-modifiedDuring :: UTCTime -> UTCTime -> Query [Payment]
-modifiedDuring start end =
-  Query (\conn ->
-    SQLite.query
-      conn
-      (SQLite.Query $ T.intercalate " "
-        [ "SELECT *"
-        , "FROM payment"
-        , "WHERE (created_at >= ? AND created_at <= ?)"
-        , "   OR (edited_at >= ?  AND edited_at <= ?)"
-        , "   OR (deleted_at >= ? AND deleted_at <= ?)"
-        ])
-      (start, end, start, end, start, end)
-  )
diff --git a/server/src/SendMail.hs b/server/src/SendMail.hs
index c15ed62..3b17a0a 100644
--- a/server/src/SendMail.hs
+++ b/server/src/SendMail.hs
@@ -9,18 +9,41 @@ import qualified Network.Mail.Mime      as M
 
 import           Data.Text              (Text)
 import qualified Data.Text              as T
+import qualified Data.Text.IO           as T
 import qualified Data.Text.Lazy         as LT
 import           Data.Text.Lazy.Builder (fromText, toLazyText)
 
-import           Model.Mail             (Mail (Mail))
+import           Conf                   (Conf)
+import qualified Conf
+import           Model.Mail             (Mail (..))
 
-sendMail :: Mail -> IO (Either Text ())
-sendMail mail = do
-  result <- left (T.pack . show) <$> (try (M.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ()))
-  if isLeft result
-    then putStrLn ("Error sending the following email:" ++ (show mail) ++ "\n" ++ (show result))
-    else putStrLn "OK"
-  return result
+sendMail :: Conf -> Mail -> IO (Either Text ())
+sendMail conf mail =
+  if Conf.devMode conf
+    then
+      do
+        T.putStrLn . mockMailMessage $ mail
+        return (Right ())
+    else
+      do
+        result <- left (T.pack . show) <$> (try (M.renderSendMail . getMimeMail $ mail) :: IO (Either SomeException ()))
+        if isLeft result
+          then putStrLn ("Error sending the following email:" ++ (show mail) ++ "\n" ++ (show result))
+          else return ()
+        return result
+
+mockMailMessage :: Mail -> Text
+mockMailMessage mail = T.concat $
+  [ "[MOCK MAIL] "
+  , subject mail
+  , " (from: "
+  , from mail
+  , ") (to: "
+  , T.intercalate ", " $ to mail
+  , ")"
+  , "\n"
+  , body mail
+  ]
 
 getMimeMail :: Mail -> M.Mail
 getMimeMail (Mail mailFrom mailTo mailSubject mailPlainBody) =
diff --git a/server/src/View/Mail/SignIn.hs b/server/src/View/Mail/SignIn.hs
index 22c3cb0..3c5469f 100644
--- a/server/src/View/Mail/SignIn.hs
+++ b/server/src/View/Mail/SignIn.hs
@@ -17,5 +17,5 @@ mail conf user url to =
     { M.from = Conf.noReplyMail conf
     , M.to = to
     , M.subject = Msg.get Msg.SignIn_MailTitle
-    , M.plainBody = Msg.get (Msg.SignIn_MailBody (_user_name user) url)
+    , M.body = Msg.get (Msg.SignIn_MailBody (_user_name user) url)
     }
diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index 4ad8b77..5418880 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -11,8 +11,8 @@ import           Data.Text          (Text)
 import qualified Data.Text          as T
 import           Data.Time.Clock    (UTCTime)
 
-import           Common.Model       (Income (..), Payment (..), User (..),
-                                     UserId)
+import           Common.Model       (ExceedingPayer (..), Income (..),
+                                     Payment (..), User (..), UserId)
 import qualified Common.Model       as CM
 import qualified Common.Msg         as Msg
 import qualified Common.View.Format as Format
@@ -35,11 +35,31 @@ mail conf users payments incomes start end =
         , " − "
         , Msg.get Msg.WeeklyReport_Title
         ]
-    , M.plainBody = body conf users (groupByStatus start end payments) (groupByStatus start end incomes)
+    , M.body = body conf users payments incomes start end
     }
 
-body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
-body conf users paymentsByStatus incomesByStatus =
+body :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Text
+body conf users payments incomes start end =
+  T.intercalate "\n" $
+    [ exceedingPayers conf end users incomes (filter (null . _payment_deletedAt) payments)
+    , operations conf users (groupByStatus start end payments) (groupByStatus start end incomes)
+    ]
+
+exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> [Payment] -> Text
+exceedingPayers conf time users incomes payments =
+  T.intercalate "\n" . map formatPayer $ payers
+  where
+    payers = CM.getExceedingPayers time users incomes payments
+    formatPayer p = T.concat
+      [ "  * "
+      , fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users
+      , " + "
+      , Format.price (Conf.currency conf) $ _exceedingPayer_amount p
+      , "\n"
+      ]
+
+operations :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
+operations conf users paymentsByStatus incomesByStatus =
   if M.null paymentsByStatus && M.null incomesByStatus
     then
       Msg.get Msg.WeeklyReport_Empty
@@ -96,5 +116,5 @@ section title items =
   T.concat
     [ title
     , "\n\n"
-    , T.unlines . map ("  - " <>) $ items
+    , T.unlines . map ("  * " <>) $ items
     ]
diff --git a/server/src/View/Page.hs b/server/src/View/Page.hs
index 27b4f26..97b84fa 100644
--- a/server/src/View/Page.hs
+++ b/server/src/View/Page.hs
@@ -26,10 +26,10 @@ page initResult =
       meta ! charset "UTF-8"
       meta ! name "viewport" ! content "width=device-width, initial-scale=1, maximum-scale=1, user-scalable=0"
       H.title (toHtml $ Msg.get Msg.App_Title)
-      script ! src "javascript/main.js" $ ""
+      script ! src "/javascript/main.js" $ ""
       jsonScript "init" initResult
-      link ! rel "stylesheet" ! type_ "text/css" ! href "css/reset.css"
-      link ! rel "icon" ! type_ "image/png" ! href "images/icon.png"
+      link ! rel "stylesheet" ! type_ "text/css" ! href "/css/reset.css"
+      link ! rel "icon" ! type_ "image/png" ! href "/images/icon.png"
       H.style $ toHtml globalDesign
 
 jsonScript :: Json.ToJSON a => Text -> a -> Html
-- 
cgit v1.2.3