Bootstrap with GHCJS and reflex:

- setup login and logout,
- first draft of payment view.

60 files changed, 568 insertions, 1885 deletions

diff --git a/src/server/Common b/src/server/Common
new file mode 120000
index 0000000..60d3b0a
--- /dev/null
+++ b/src/server/Common
@@ -0,0 +1 @@
+../common
\ No newline at end of file
diff --git a/src/server/Conf.hs b/src/server/Conf.hs
index a05349d..92df4e9 100644
--- a/src/server/Conf.hs
+++ b/src/server/Conf.hs
@@ -10,11 +10,13 @@ import qualified Data.Text as T
 import qualified Data.ConfigManager as Conf
 import Data.Time.Clock (NominalDiffTime)
 
+import Common.Model.Currency (Currency(..))
+
 data Conf = Conf
   { hostname :: Text
   , port :: Int
   , signInExpiration :: NominalDiffTime
-  , currency :: Text
+  , currency :: Currency
   , noReplyMail :: Text
   , https :: Bool
   } deriving Show
@@ -28,7 +30,7 @@ get path = do
         Conf.lookup "hostname" conf <*>
         Conf.lookup "port" conf <*>
         Conf.lookup "signInExpiration" conf <*>
-        Conf.lookup "currency" conf <*>
+        fmap Currency (Conf.lookup "currency" conf) <*>
         Conf.lookup "noReplyMail" conf <*>
         Conf.lookup "https" conf
     )
diff --git a/src/server/Controller/Category.hs b/src/server/Controller/Category.hs
index 3f800da..1a44083 100644
--- a/src/server/Controller/Category.hs
+++ b/src/server/Controller/Category.hs
@@ -11,12 +11,14 @@ import Network.HTTP.Types.Status (ok200, badRequest400)
 import qualified Data.Text.Lazy as TL
 import Web.Scotty hiding (delete)
 
+import Common.Model.Category (CategoryId)
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import qualified Common.Model.CreateCategory as Json
+import qualified Common.Model.EditCategory as Json
+
 import Json (jsonId)
-import Model.Category (CategoryId)
 import qualified Model.Category as Category
-import qualified Model.Json.CreateCategory as Json
-import qualified Model.Json.EditCategory as Json
-import qualified Model.Message.Key as Key
 import qualified Model.PaymentCategory as PaymentCategory
 import qualified Model.Query as Query
 import qualified Secure
@@ -49,5 +51,5 @@ delete categoryId =
         status ok200
       else do
         status badRequest400
-        text . TL.pack . show $ Key.CategoryNotDeleted
+        text . TL.fromStrict $ Message.get Key.Category_NotDeleted
   )
diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs
index 18394d0..148b713 100644
--- a/src/server/Controller/Income.hs
+++ b/src/server/Controller/Income.hs
@@ -11,26 +11,25 @@ import Network.HTTP.Types.Status (ok200, badRequest400)
 import qualified Data.Text.Lazy as TL
 import Web.Scotty
 
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import Common.Model (CreateIncome(..), EditIncome(..), IncomeId, User(..))
+
 import Json (jsonId)
-import Model.Income (IncomeId)
 import qualified Model.Income as Income
-import qualified Model.Json.CreateIncome as Json
-import qualified Model.Json.EditIncome as Json
-import qualified Model.Message.Key as Key
 import qualified Model.Query as Query
-import qualified Model.User as User
 import qualified Secure
 
-create :: Json.CreateIncome -> ActionM ()
-create (Json.CreateIncome date amount) =
+create :: CreateIncome -> ActionM ()
+create (CreateIncome date amount) =
   Secure.loggedAction (\user ->
-    (liftIO . Query.run $ Income.create (User.id user) date amount) >>= jsonId
+    (liftIO . Query.run $ Income.create (_user_id user) date amount) >>= jsonId
   )
 
-editOwn :: Json.EditIncome -> ActionM ()
-editOwn (Json.EditIncome incomeId date amount) =
+editOwn :: EditIncome -> ActionM ()
+editOwn (EditIncome incomeId date amount) =
   Secure.loggedAction (\user -> do
-    updated <- liftIO . Query.run $ Income.editOwn (User.id user) incomeId date amount
+    updated <- liftIO . Query.run $ Income.editOwn (_user_id user) incomeId date amount
     if updated
       then status ok200
       else status badRequest400
@@ -45,5 +44,5 @@ deleteOwn incomeId =
         status ok200
       else do
         status badRequest400
-        text . TL.pack . show $ Key.IncomeNotDeleted
+        text . TL.fromStrict $ Message.get Key.Income_NotDeleted
   )
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
index 9fb2aa0..8473c5c 100644
--- a/src/server/Controller/Index.hs
+++ b/src/server/Controller/Index.hs
@@ -7,15 +7,17 @@ import Control.Monad.IO.Class (liftIO)
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime, diffUTCTime)
 import Network.HTTP.Types.Status (ok200)
+import Prelude hiding (error)
 import Web.Scotty hiding (get)
 
+import qualified Common.Message as Message
+import Common.Message.Key (Key)
+import qualified Common.Message.Key as Key
+import Common.Model (InitResult(..), User(..))
+
 import Conf (Conf(..))
 import Model.Init (getInit)
-import Model.Json.Init (InitResult(..))
-import Model.Message.Key
-import Model.User (User)
 import qualified LoginSession
-import qualified Model.Json.Conf as M
 import qualified Model.Query as Query
 import qualified Model.SignIn as SignIn
 import qualified Model.User as User
@@ -29,17 +31,17 @@ get conf mbToken = do
       userOrError <- validateSignIn conf token
       case userOrError of
         Left errorKey ->
-          return . InitError $ errorKey
+          return . InitEmpty . Left . Message.get $ errorKey
         Right user ->
-          liftIO . Query.run . fmap InitSuccess . getInit $ user
+          liftIO . Query.run . fmap InitSuccess $ getInit user conf
     Nothing -> do
       mbLoggedUser <- getLoggedUser
       case mbLoggedUser of
         Nothing ->
-          return InitEmpty
+          return . InitEmpty . Right $ Nothing
         Just user ->
-          liftIO . Query.run . fmap InitSuccess . getInit $ user
-  html $ page (M.Conf { M.currency = currency conf }) initResult
+          liftIO . Query.run . fmap InitSuccess $ getInit user conf
+  html $ page initResult
 
 validateSignIn :: Conf -> Text -> ActionM (Either Key User)
 validateSignIn conf textToken = do
@@ -52,23 +54,23 @@ validateSignIn conf textToken = do
       now <- liftIO getCurrentTime
       case mbSignIn of
         Nothing ->
-          return . Left $ SignInInvalid
+          return . Left $ Key.SignIn_LinkInvalid
         Just signIn ->
           if SignIn.isUsed signIn
             then
-              return . Left $ SignInUsed
+              return . Left $ Key.SignIn_LinkUsed
             else
               let diffTime = now `diffUTCTime` (SignIn.creation signIn)
               in  if diffTime > signInExpiration conf
                     then
-                      return . Left $ SignInExpired
+                      return . Left $ Key.SignIn_LinkExpired
                     else do
                       LoginSession.put conf (SignIn.token signIn)
                       mbUser <- liftIO . Query.run $ do
                         SignIn.signInTokenToUsed . SignIn.id $ signIn
-                        User.getUser . SignIn.email $ signIn
+                        User.get . SignIn.email $ signIn
                       return $ case mbUser of
-                        Nothing -> Left UnauthorizedSignIn
+                        Nothing -> Left Key.Secure_Unauthorized
                         Just user -> Right user
 
 getLoggedUser :: ActionM (Maybe User)
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index d71b451..6a9ede7 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -11,37 +11,36 @@ import Control.Monad.IO.Class (liftIO)
 import Network.HTTP.Types.Status (ok200, badRequest400)
 import Web.Scotty
 
+import qualified Common.Model.CreatePayment as M
+import qualified Common.Model.EditPayment as M
+import Common.Model (PaymentId, User(..))
+
 import Json (jsonId)
-import Model.Payment (PaymentId)
-import qualified Model.Json.CreatePayment as Json
-import qualified Model.Json.EditPayment as Json
-import qualified Model.Json.Payment as Json
 import qualified Model.Payment as Payment
 import qualified Model.PaymentCategory as PaymentCategory
 import qualified Model.Query as Query
-import qualified Model.User as User
 import qualified Secure
 
 list :: ActionM ()
 list =
   Secure.loggedAction (\_ ->
-    (liftIO . Query.run $ map Json.fromPayment <$> Payment.list) >>= json
+    (liftIO . Query.run $ Payment.list) >>= json
   )
 
-create :: Json.CreatePayment -> ActionM ()
-create (Json.CreatePayment name cost date category frequency) =
+create :: M.CreatePayment -> ActionM ()
+create (M.CreatePayment name cost date category frequency) =
   Secure.loggedAction (\user ->
     (liftIO . Query.run $ do
       PaymentCategory.save name category
-      Payment.create (User.id user) name cost date frequency
+      Payment.create (_user_id user) name cost date frequency
     ) >>= jsonId
   )
 
-editOwn :: Json.EditPayment -> ActionM ()
-editOwn (Json.EditPayment paymentId name cost date category frequency) =
+editOwn :: M.EditPayment -> ActionM ()
+editOwn (M.EditPayment paymentId name cost date category frequency) =
   Secure.loggedAction (\user -> do
     updated <- liftIO . Query.run $ do
-      edited <- Payment.editOwn (User.id user) paymentId name cost date frequency
+      edited <- Payment.editOwn (_user_id user) paymentId name cost date frequency
       _ <- if edited
         then PaymentCategory.save name category >> return ()
         else return ()
@@ -54,7 +53,7 @@ editOwn (Json.EditPayment paymentId name cost date category frequency) =
 deleteOwn :: PaymentId -> ActionM ()
 deleteOwn paymentId =
   Secure.loggedAction (\user -> do
-    deleted <- liftIO . Query.run $ Payment.deleteOwn (User.id user) paymentId
+    deleted <- liftIO . Query.run $ Payment.deleteOwn (_user_id user) paymentId
     if deleted
       then status ok200
       else status badRequest400
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 152168c..932ce53 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -5,15 +5,17 @@ module Controller.SignIn
   ) where
 
 import Control.Monad.IO.Class (liftIO)
-import Data.Text (Text)
 import Network.HTTP.Types.Status (ok200, badRequest400)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import qualified Data.Text.Lazy as TL
 import Web.Scotty
 
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import qualified Common.Model.SignIn as M
+
 import Conf (Conf)
-import Model.Message.Key
 import qualified Conf
 import qualified Model.Query as Query
 import qualified Model.SignIn as SignIn
@@ -22,30 +24,24 @@ import qualified SendMail
 import qualified Text.Email.Validate as Email
 import qualified View.Mail.SignIn as SignIn
 
-signIn :: Conf -> Text -> ActionM ()
-signIn conf login =
-  if Email.isValid (TE.encodeUtf8 login)
+signIn :: Conf -> M.SignIn -> ActionM ()
+signIn conf (M.SignIn email) =
+  if Email.isValid (TE.encodeUtf8 email)
     then do
-      maybeUser <- liftIO . Query.run $ User.getUser login
+      maybeUser <- liftIO . Query.run $ User.get email
       case maybeUser of
         Just user -> do
-          token <- liftIO . Query.run $ SignIn.createSignInToken login
+          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 [login]
+          maybeSentMail <- liftIO . SendMail.sendMail $ SignIn.mail conf user url [email]
           case maybeSentMail of
-            Right _ ->
-              status ok200
-            Left _ -> do
-              status badRequest400
-              text . TL.pack . show $ SendEmailFail
-        Nothing -> do
-            status badRequest400
-            text . TL.pack . show $ UnauthorizedSignIn
-    else do
-      status badRequest400
-      text . TL.pack . show $ EnterValidEmail
+            Right _ -> textKey ok200 Key.SignIn_EmailSent
+            Left _ -> textKey badRequest400 Key.SignIn_EmailSendFail
+        Nothing -> textKey badRequest400 Key.Secure_Unauthorized
+    else textKey badRequest400 Key.SignIn_EmailInvalid
+  where textKey st key = status st >> (text . TL.fromStrict $ Message.get key)
diff --git a/src/server/Controller/User.hs b/src/server/Controller/User.hs
deleted file mode 100644
index d8604ac..0000000
--- a/src/server/Controller/User.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Controller.User
-  ( getUsers
-  ) where
-
-import Web.Scotty
-
-import Control.Monad.IO.Class (liftIO)
-
-import qualified Secure
-
-import Model.Database
-import qualified Model.User as User
-
-getUsers :: ActionM ()
-getUsers =
-  Secure.loggedAction (\_ ->
-    (liftIO $ map User.getJsonUser <$> runDb User.list) >>= json
-  )
diff --git a/src/server/Design/Color.hs b/src/server/Design/Color.hs
index afc601f..06c468e 100644
--- a/src/server/Design/Color.hs
+++ b/src/server/Design/Color.hs
@@ -7,6 +7,9 @@ import qualified Clay.Color as C
 white :: C.Color
 white = C.white
 
+black :: C.Color
+black = C.black
+
 chestnutRose :: C.Color
 chestnutRose = C.rgb 207 92 86
 
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index e742978..47ea4a9 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -8,9 +8,7 @@ import Clay
 
 import Data.Text.Lazy (Text)
 
-import qualified Design.Header as Header
-import qualified Design.SignIn as SignIn
-import qualified Design.LoggedIn as LoggedIn
+import qualified Design.Views as Views
 import qualified Design.Form as Form
 import qualified Design.Errors as Errors
 import qualified Design.Dialog as Dialog
@@ -26,13 +24,10 @@ globalDesign = renderWith compact [] global
 
 global :: Css
 global = do
-
-  header ? Header.design
-  ".signIn" ? SignIn.design
-  ".loggedIn" ? LoggedIn.design
   ".errors" ? Errors.design
   ".dialog" ? Dialog.design
   ".tooltip" ? Tooltip.design
+  Views.design
   Form.design
 
   body ? do
@@ -49,6 +44,8 @@ global = do
 
   a ? cursor pointer
 
+  input ? fontSize inherit
+
   h1 ? do
     color Color.chestnutRose
     marginBottom (em 1)
diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs
index 869616d..41528ed 100644
--- a/src/server/Design/Helper.hs
+++ b/src/server/Design/Helper.hs
@@ -3,8 +3,8 @@
 module Design.Helper
   ( clearFix
   , button
+  , waitable
   , input
-  , iconButton
   , centeredWithMargin
   , verticalCentering
   ) where
@@ -13,8 +13,6 @@ import Prelude hiding (span)
 
 import Clay hiding (button, input)
 
-import Data.Monoid ((<>))
-
 import Design.Constants
 import Design.Color as Color
 
@@ -27,6 +25,9 @@ clearFix =
 
 button :: Color -> Color -> Size a -> (Color -> Color) -> Css
 button backgroundCol textCol h focusOp = do
+  display flex
+  alignItems center
+  justifyContent center
   backgroundColor backgroundCol
   padding (px 0) (px 10) (px 0) (px 10)
   color textCol
@@ -38,19 +39,20 @@ button backgroundCol textCol h focusOp = do
   textAlign (alignSide sideCenter)
   hover & backgroundColor (focusOp backgroundCol)
   focus & backgroundColor (focusOp backgroundCol)
+  waitable
 
-iconButton :: Color -> Color -> Size LengthUnit -> (Color -> Color) -> Css
-iconButton backgroundCol textCol h focusOp = do
-  button backgroundCol textCol h focusOp
-  i <> span ? do
-    height h
-    lineHeight h
-  span ? do
-    display inlineBlock
-    marginLeft (px 20)
-  i ? do
-    marginLeft (px 15)
-    marginRight (px 20)
+waitable :: Css
+waitable = do
+  svg # ".loader" ? display none
+  ".waiting" & do
+    ".content" ? do
+      display flex
+      fontSize (px 0)
+      opacity 0
+    svg # ".loader" ? do
+      display block
+      rotateKeyframes
+      rotateAnimation
 
 input :: Double -> Css
 input h = do
@@ -72,3 +74,17 @@ verticalCentering = do
   position absolute
   top (pct 50)
   "transform" -: "translateY(-50%)"
+
+rotateAnimation :: Css
+rotateAnimation = do
+  animationName "rotate"
+  animationDuration (sec 1)
+  animationTimingFunction easeOut
+  animationIterationCount infinite
+
+rotateKeyframes :: Css
+rotateKeyframes = keyframes
+  "rotate"
+  [ (0, "transform" -: "rotate(0deg)")
+  , (100, "transform" -: "rotate(360deg)")
+  ]
diff --git a/src/server/Design/LoggedIn/Home.hs b/src/server/Design/LoggedIn/Home.hs
deleted file mode 100644
index 7845434..0000000
--- a/src/server/Design/LoggedIn/Home.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Design.LoggedIn.Home
-  ( design
-  ) where
-
-import Clay
-
-import qualified Design.LoggedIn.Home.Header as Header
-import qualified Design.LoggedIn.Home.Table as Table
-import qualified Design.LoggedIn.Home.Pages as Pages
-
-design :: Css
-design = do
-  ".header" ? Header.design
-  ".table" ? Table.design
-  ".pages" ? Pages.design
diff --git a/src/server/Design/SignIn.hs b/src/server/Design/SignIn.hs
deleted file mode 100644
index 75f2f98..0000000
--- a/src/server/Design/SignIn.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Design.SignIn
-  ( design
-  ) where
-
-import Clay
-
-import qualified Design.Color as Color
-import qualified Design.Helper as Helper
-import qualified Design.Constants as Constants
-
-design :: Css
-design = do
-
-  form ? do
-    let inputHeight = 50
-    width (px 500)
-    marginTop (px 100)
-    marginLeft auto
-    marginRight auto
-
-    input ? do
-      Helper.input inputHeight
-      display block
-      width (pct 100)
-      marginBottom (px 10)
-
-    button ? do
-      Helper.iconButton Color.gothic Color.white (px inputHeight) Constants.focusLighten
-      display block
-      width (pct 100)
-      fontSize (em 1.2)
-      ".waitingServer" & ("cursor" -: "not-allowed")
-
-  ".result" ? do
-    marginTop (px 40)
-    textAlign (alignSide sideCenter)
-    ".success" ? color Color.mossGreen
-    ".error" ? color Color.chestnutRose
diff --git a/src/server/Design/Header.hs b/src/server/Design/View/Header.hs
index 8feac64..20627e6 100644
--- a/src/server/Design/Header.hs
+++ b/src/server/Design/View/Header.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Design.Header
+module Design.View.Header
   ( design
   ) where
 
@@ -9,6 +9,7 @@ import Data.Monoid ((<>))
 import Clay
 
 import Design.Color as Color
+import qualified Design.Helper as Helper
 import qualified Design.Media as Media
 
 design :: Css
@@ -57,9 +58,12 @@ design = do
       Media.tabletDesktop $ headerPadding
 
     ".signOut" ? do
+      Helper.waitable
       heightMedia
       svg ? do
+        Media.tabletDesktop $ width (px 30)
         Media.mobile $ width (px 20)
+        "path" ? ("fill" -: "white")
 
 lineHeightMedia :: Css
 lineHeightMedia = do
diff --git a/src/server/Design/View/Payment.hs b/src/server/Design/View/Payment.hs
new file mode 100644
index 0000000..d3c7650
--- /dev/null
+++ b/src/server/Design/View/Payment.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Design.View.Payment
+  ( design
+  ) where
+
+import Clay
+
+import qualified Design.View.Payment.Header as Header
+import qualified Design.View.Payment.Table as Table
+import qualified Design.View.Payment.Pages as Pages
+
+design :: Css
+design = do
+  ".header" ? Header.design
+  ".table" ? Table.design
+  ".pages" ? Pages.design
diff --git a/src/server/Design/LoggedIn/Home/Header.hs b/src/server/Design/View/Payment/Header.hs
index 5fd2d79..f02da8a 100644
--- a/src/server/Design/LoggedIn/Home/Header.hs
+++ b/src/server/Design/View/Payment/Header.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Design.LoggedIn.Home.Header
+module Design.View.Payment.Header
   ( design
   ) where
 
diff --git a/src/server/Design/LoggedIn/Home/Pages.hs b/src/server/Design/View/Payment/Pages.hs
index 71f3254..ade81a8 100644
--- a/src/server/Design/LoggedIn/Home/Pages.hs
+++ b/src/server/Design/View/Payment/Pages.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Design.LoggedIn.Home.Pages
+module Design.View.Payment.Pages
   ( design
   ) where
 
diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/View/Payment/Table.hs
index cb46ac9..a866b40 100644
--- a/src/server/Design/LoggedIn/Home/Table.hs
+++ b/src/server/Design/View/Payment/Table.hs
@@ -1,11 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Design.LoggedIn.Home.Table
+module Design.View.Payment.Table
   ( design
   ) where
 
 import Clay
 
+import qualified Design.Color as Color
 import qualified Design.Media as Media
 
 design :: Css
@@ -35,3 +36,7 @@ design = do
         ".shortDate" ? display none
         ".longDate" ? display inline
         marginBottom (em 0.5)
+
+    ".button" & svg ? do
+      "path" ? ("fill" -: (plain . unValue . value $ Color.chestnutRose))
+      width (px 18)
diff --git a/src/server/Design/View/SignIn.hs b/src/server/Design/View/SignIn.hs
new file mode 100644
index 0000000..214e663
--- /dev/null
+++ b/src/server/Design/View/SignIn.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Design.View.SignIn
+  ( design
+  ) where
+
+import Clay
+import Data.Monoid ((<>))
+
+import qualified Design.Color as Color
+import qualified Design.Helper as Helper
+import qualified Design.Constants as Constants
+
+design :: Css
+design = do
+  let inputHeight = 50
+  width (px 500)
+  marginTop (px 100)
+  marginLeft auto
+  marginRight auto
+
+  input ? do
+    Helper.input inputHeight
+    display block
+    width (pct 100)
+    marginBottom (px 10)
+
+  button ? do
+    Helper.button Color.gothic Color.white (px inputHeight) Constants.focusLighten
+    display flex
+    alignItems center
+    justifyContent center
+    width (pct 100)
+    fontSize (em 1.2)
+    svg ? "path" ? ("fill" -: "white")
+
+  ".success" <> ".error" ? do
+    marginTop (px 40)
+    textAlign (alignSide sideCenter)
+
+  ".success" ? color Color.mossGreen
+  ".error" ? color Color.chestnutRose
diff --git a/src/server/Design/LoggedIn/Stat.hs b/src/server/Design/View/Stat.hs
index 62028cb..0a5b258 100644
--- a/src/server/Design/LoggedIn/Stat.hs
+++ b/src/server/Design/View/Stat.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Design.LoggedIn.Stat
+module Design.View.Stat
   ( design
   ) where
 
diff --git a/src/server/Design/LoggedIn/Table.hs b/src/server/Design/View/Table.hs
index 44b001a..95abf90 100644
--- a/src/server/Design/LoggedIn/Table.hs
+++ b/src/server/Design/View/Table.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Design.LoggedIn.Table
+module Design.View.Table
   ( design
   ) where
 
diff --git a/src/server/Design/LoggedIn.hs b/src/server/Design/Views.hs
index 4a21832..bc6ac83 100644
--- a/src/server/Design/LoggedIn.hs
+++ b/src/server/Design/Views.hs
@@ -1,14 +1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Design.LoggedIn
+module Design.Views
   ( design
   ) where
 
 import Clay
 
-import qualified Design.LoggedIn.Home as Home
-import qualified Design.LoggedIn.Stat as Stat
-import qualified Design.LoggedIn.Table as Table
+import qualified Design.View.Header as Header
+import qualified Design.View.Payment as Payment
+import qualified Design.View.SignIn as SignIn
+import qualified Design.View.Stat as Stat
+import qualified Design.View.Table as Table
 
 import qualified Design.Helper as Helper
 import qualified Design.Constants as Constants
@@ -17,7 +19,9 @@ import qualified Design.Media as Media
 
 design :: Css
 design = do
-  ".home" ? Home.design
+  header ? Header.design
+  ".payment" ? Payment.design
+  ".signIn" ? SignIn.design
   ".stat" ? Stat.design
   Table.design
 
diff --git a/src/server/Job/MonthlyPayment.hs b/src/server/Job/MonthlyPayment.hs
index 8c11ccf..ba24cca 100644
--- a/src/server/Job/MonthlyPayment.hs
+++ b/src/server/Job/MonthlyPayment.hs
@@ -4,7 +4,8 @@ module Job.MonthlyPayment
 
 import Data.Time.Clock (UTCTime, getCurrentTime)
 
-import Model.Frequency
+import Common.Model (Frequency(..), Payment(..))
+
 import qualified Model.Payment as Payment
 import Utils.Time (timeToDay)
 import qualified Model.Query as Query
@@ -14,6 +15,12 @@ monthlyPayment _ = do
   monthlyPayments <- Query.run Payment.listMonthly
   now <- getCurrentTime
   actualDay <- timeToDay now
-  let punctualPayments = map (\p -> p { Payment.frequency = Punctual, Payment.date = actualDay, Payment.createdAt = now }) monthlyPayments
+  let punctualPayments = map
+        (\p -> p
+          { _payment_frequency = Punctual
+          , _payment_date = actualDay
+          , _payment_createdAt = now
+          })
+        monthlyPayments
   _ <- Query.run (Payment.createMany punctualPayments)
   return now
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 17c2594..db73474 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -1,16 +1,25 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+import Control.Applicative (liftA3)
+import Control.Monad.IO.Class (liftIO)
+
 import Network.Wai.Middleware.Static
 import qualified Data.Text.Lazy as LT
 import Web.Scotty
 
-import Job.Daemon (runDaemons)
 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 Job.Daemon (runDaemons)
+import Model.Payer (getOrderedExceedingPayers)
+import qualified Data.Time as Time
+import qualified Model.User as UserM
+import qualified Model.Income as IncomeM
+import qualified Model.Payment as PaymentM
+import qualified Model.Query as Query
 
 main :: IO ()
 main = do
@@ -19,13 +28,19 @@ main = do
   scotty (Conf.port conf) $ do
     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 exceedingPayers = getOrderedExceedingPayers time users incomes payments
+      text . LT.pack . show $ exceedingPayers
+
     get "/" $ do
       signInToken <- mbParam "signInToken"
       Index.get conf signInToken
 
     post "/signIn" $ do
-      email <- param "email"
-      SignIn.signIn conf email
+      jsonData >>= SignIn.signIn conf
 
     post "/signOut" $
       Index.signOut conf
diff --git a/src/server/Model/Category.hs b/src/server/Model/Category.hs
index 9597bd9..6b7a488 100644
--- a/src/server/Model/Category.hs
+++ b/src/server/Model/Category.hs
@@ -1,34 +1,23 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.Category
-  ( CategoryId
-  , Category(..)
-  , list
+  ( list
   , create
   , edit
   , delete
   ) where
 
-import Data.Int (Int64)
 import Data.Maybe (isJust, listToMaybe)
 import Data.Text (Text)
-import Data.Time (UTCTime)
 import Data.Time.Clock (getCurrentTime)
 import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
 import qualified Database.SQLite.Simple as SQLite
+import Prelude hiding (id)
 
-import Model.Query (Query(Query))
-
-type CategoryId = Int64
+import Common.Model (Category(..), CategoryId)
 
-data Category = Category
-  { id :: CategoryId
-  , name :: Text
-  , color :: Text
-  , createdAt :: UTCTime
-  , editedAt :: Maybe UTCTime
-  , deletedAt :: Maybe UTCTime
-  } deriving Show
+import Model.Query (Query(Query))
 
 instance FromRow Category where
   fromRow = Category <$>
diff --git a/src/server/Model/Frequency.hs b/src/server/Model/Frequency.hs
index f9958e1..4f7b83d 100644
--- a/src/server/Model/Frequency.hs
+++ b/src/server/Model/Frequency.hs
@@ -1,28 +1,17 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module Model.Frequency
-  ( Frequency(..)
-  ) where
+module Model.Frequency () where
 
-import Data.Aeson
 import Database.SQLite.Simple (SQLData(SQLText))
 import Database.SQLite.Simple.FromField (fieldData, FromField(fromField))
 import Database.SQLite.Simple.Ok (Ok(Ok, Errors))
 import Database.SQLite.Simple.ToField (ToField(toField))
-import GHC.Generics
 import qualified Data.Text as T
-import Web.Scotty (parseParam, Parsable, readEither)
 
-data Frequency =
-  Punctual
-  | Monthly
-  deriving (Eq, Show, Read, Generic)
-
-instance Parsable Frequency where parseParam = readEither
-instance FromJSON Frequency
-instance ToJSON Frequency
+import Common.Model.Frequency (Frequency)
 
 instance FromField Frequency where
   fromField field = case fieldData field of
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index c6cdb55..bbe7657 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,16 +1,14 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.Income
-  ( IncomeId
-  , Income(..)
-  , list
+  ( list
   , create
   , editOwn
   , deleteOwn
   , modifiedDuring
   ) where
 
-import Data.Int (Int64)
 import Data.Maybe (listToMaybe)
 import Data.Time.Calendar (Day)
 import Data.Time.Clock (UTCTime, getCurrentTime)
@@ -18,27 +16,15 @@ import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
 import Prelude hiding (id)
 import qualified Database.SQLite.Simple as SQLite
 
+import Common.Model (Income(..), IncomeId, User(..), UserId)
+
 import Model.Query (Query(Query))
-import Model.User (User, UserId)
-import qualified Model.User as User
 import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
 
-type IncomeId = Int64
-
-data Income = Income
-  { id :: IncomeId
-  , userId :: UserId
-  , date :: Day
-  , amount :: Int
-  , createdAt :: UTCTime
-  , editedAt :: Maybe UTCTime
-  , deletedAt :: Maybe UTCTime
-  } deriving Show
-
 instance Resource Income where
-  resourceCreatedAt = createdAt
-  resourceEditedAt = editedAt
-  resourceDeletedAt = deletedAt
+  resourceCreatedAt = _income_createdAt
+  resourceEditedAt = _income_editedAt
+  resourceDeletedAt = _income_deletedAt
 
 instance FromRow Income where
   fromRow = Income <$>
@@ -70,7 +56,7 @@ editOwn incomeUserId incomeId incomeDate incomeAmount =
     mbIncome <- listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
     case mbIncome of
       Just income ->
-        if userId income == incomeUserId
+        if _income_userId income == incomeUserId
           then do
             now <- getCurrentTime
             SQLite.execute
@@ -90,7 +76,7 @@ deleteOwn user incomeId =
     mbIncome <- listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
     case mbIncome of
       Just income ->
-        if userId income == User.id user
+        if _income_userId income == _user_id user
           then do
             now <- getCurrentTime
             SQLite.execute conn "UPDATE income SET deleted_at = ? WHERE id = ?" (now, incomeId)
diff --git a/src/server/Model/Init.hs b/src/server/Model/Init.hs
index 7a9ccea..8c6a961 100644
--- a/src/server/Model/Init.hs
+++ b/src/server/Model/Init.hs
@@ -4,27 +4,24 @@ module Model.Init
   ( getInit
   ) where
 
-import Model.Json.Init (Init)
+import Common.Model (Init(Init), User(..))
+
+import Conf (Conf)
+import qualified Conf
 import Model.Query (Query)
-import Model.User (User)
 import qualified Model.Category as Category
 import qualified Model.Income as Income
-import qualified Model.Json.Category as Json
-import qualified Model.Json.Income as Json
-import qualified Model.Json.Init as Init
-import qualified Model.Json.Payment as Json
-import qualified Model.Json.PaymentCategory as Json
-import qualified Model.Json.User as Json
 import qualified Model.Payment as Payment
 import qualified Model.PaymentCategory as PaymentCategory
 import qualified Model.User as User
 
-getInit :: User -> Query Init
-getInit user =
-  Init.Init <$>
-    (map Json.fromUser <$> User.list) <*>
-    (return . User.id $ user) <*>
-    (map Json.fromPayment <$> Payment.list) <*>
-    (map Json.fromIncome <$> Income.list) <*>
-    (map Json.fromCategory <$> Category.list) <*>
-    (map Json.fromPaymentCategory <$> PaymentCategory.list)
+getInit :: User -> Conf -> Query Init
+getInit user conf =
+  Init <$>
+    User.list <*>
+    (return . _user_id $ user) <*>
+    Payment.list <*>
+    Income.list <*>
+    Category.list <*>
+    PaymentCategory.list <*>
+    (return . Conf.currency $ conf)
diff --git a/src/server/Model/Json/Category.hs b/src/server/Model/Json/Category.hs
deleted file mode 100644
index 8b5e527..0000000
--- a/src/server/Model/Json/Category.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Category
-  ( Category(..)
-  , fromCategory
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import GHC.Generics
-
-import Model.Category (CategoryId)
-import qualified Model.Category as M
-
-data Category = Category
-  { id :: CategoryId
-  , name :: Text
-  , color :: Text
-  } deriving (Show, Generic)
-
-instance ToJSON Category
-
-fromCategory :: M.Category -> Category
-fromCategory category = Category (M.id category) (M.name category) (M.color category)
diff --git a/src/server/Model/Json/Conf.hs b/src/server/Model/Json/Conf.hs
deleted file mode 100644
index a66fb55..0000000
--- a/src/server/Model/Json/Conf.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Conf
-  ( Conf(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Text
-
-data Conf = Conf
-  { currency :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON Conf
-instance ToJSON Conf
diff --git a/src/server/Model/Json/CreateCategory.hs b/src/server/Model/Json/CreateCategory.hs
deleted file mode 100644
index fffc882..0000000
--- a/src/server/Model/Json/CreateCategory.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.CreateCategory
-  ( CreateCategory(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Text (Text)
-
-data CreateCategory = CreateCategory
-  { name :: Text
-  , color :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON CreateCategory
diff --git a/src/server/Model/Json/CreateIncome.hs b/src/server/Model/Json/CreateIncome.hs
deleted file mode 100644
index cf9b1c3..0000000
--- a/src/server/Model/Json/CreateIncome.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.CreateIncome
-  ( CreateIncome(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Time.Calendar (Day)
-
-data CreateIncome = CreateIncome
-  { date :: Day
-  , amount :: Int
-  } deriving (Show, Generic)
-
-instance FromJSON CreateIncome
diff --git a/src/server/Model/Json/CreatePayment.hs b/src/server/Model/Json/CreatePayment.hs
deleted file mode 100644
index 6ab3a5b..0000000
--- a/src/server/Model/Json/CreatePayment.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.CreatePayment
-  ( CreatePayment(..)
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import Data.Time.Calendar (Day)
-import GHC.Generics
-
-import Model.Category (CategoryId)
-import Model.Frequency (Frequency)
-
-data CreatePayment = CreatePayment
-  { name :: Text
-  , cost :: Int
-  , date :: Day
-  , category :: CategoryId
-  , frequency :: Frequency
-  } deriving (Show, Generic)
-
-instance FromJSON CreatePayment
diff --git a/src/server/Model/Json/EditCategory.hs b/src/server/Model/Json/EditCategory.hs
deleted file mode 100644
index a10ce39..0000000
--- a/src/server/Model/Json/EditCategory.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.EditCategory
-  ( EditCategory(..)
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import GHC.Generics
-
-import Model.Category (CategoryId)
-
-data EditCategory = EditCategory
-  { id :: CategoryId
-  , name :: Text
-  , color :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON EditCategory
diff --git a/src/server/Model/Json/EditIncome.hs b/src/server/Model/Json/EditIncome.hs
deleted file mode 100644
index 9b29379..0000000
--- a/src/server/Model/Json/EditIncome.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.EditIncome
-  ( EditIncome(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Time.Calendar (Day)
-
-import Model.Income (IncomeId)
-
-data EditIncome = EditIncome
-  { id :: IncomeId
-  , date :: Day
-  , amount :: Int
-  } deriving (Show, Generic)
-
-instance FromJSON EditIncome
diff --git a/src/server/Model/Json/EditPayment.hs b/src/server/Model/Json/EditPayment.hs
deleted file mode 100644
index b7d4d7d..0000000
--- a/src/server/Model/Json/EditPayment.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.EditPayment
-  ( EditPayment(..)
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import Data.Time.Calendar (Day)
-import GHC.Generics
-
-import Model.Category (CategoryId)
-import Model.Frequency (Frequency)
-import Model.Payment (PaymentId)
-
-data EditPayment = EditPayment
-  { id :: PaymentId
-  , name :: Text
-  , cost :: Int
-  , date :: Day
-  , category :: CategoryId
-  , frequency :: Frequency
-  } deriving (Show, Generic)
-
-instance FromJSON EditPayment
diff --git a/src/server/Model/Json/Income.hs b/src/server/Model/Json/Income.hs
deleted file mode 100644
index 7e23a84..0000000
--- a/src/server/Model/Json/Income.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Income
-  ( Income(..)
-  , fromIncome
-  ) where
-
-import Data.Aeson
-import Data.Time.Calendar (Day)
-import GHC.Generics
-
-import Model.Income (IncomeId)
-import Model.User (UserId)
-import qualified Model.Income as M
-
-data Income = Income
-  { id :: IncomeId
-  , userId :: UserId
-  , date :: Day
-  , amount :: Int
-  } deriving (Show, Generic)
-
-instance ToJSON Income
-
-fromIncome :: M.Income -> Income
-fromIncome income = Income (M.id income) (M.userId income) (M.date income) (M.amount income)
diff --git a/src/server/Model/Json/Init.hs b/src/server/Model/Json/Init.hs
deleted file mode 100644
index 530c3b7..0000000
--- a/src/server/Model/Json/Init.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Init
-  ( Init(..)
-  , InitResult(..)
-  ) where
-
-import Data.Aeson
-import GHC.Generics
-
-import Model.Json.Category (Category)
-import Model.Json.Income (Income)
-import Model.Json.Payment (Payment)
-import Model.Json.PaymentCategory (PaymentCategory)
-import Model.Json.User (User)
-import Model.Message.Key (Key)
-import Model.User (UserId)
-
-data Init = Init
-  { users :: [User]
-  , me :: UserId
-  , payments :: [Payment]
-  , incomes :: [Income]
-  , categories :: [Category]
-  , paymentCategories :: [PaymentCategory]
-  } deriving (Show, Generic)
-
-instance ToJSON Init
-
-data InitResult =
-  InitEmpty
-  | InitSuccess Init
-  | InitError Key
-  deriving (Show, Generic)
-
-instance ToJSON InitResult
diff --git a/src/server/Model/Json/MessagePart.hs b/src/server/Model/Json/MessagePart.hs
deleted file mode 100644
index 0753d7c..0000000
--- a/src/server/Model/Json/MessagePart.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.MessagePart
-  ( MessagePart(..)
-  ) where
-
-import Data.Text (Text)
-
-import Data.Aeson
-import GHC.Generics
-
-data MessagePart =
-  Order Int
-  | Str Text
-  deriving (Eq, Show, Generic)
-
-instance FromJSON MessagePart
-instance ToJSON MessagePart
diff --git a/src/server/Model/Json/Number.hs b/src/server/Model/Json/Number.hs
deleted file mode 100644
index 52c9da8..0000000
--- a/src/server/Model/Json/Number.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Number
-  ( Number(..)
-  ) where
-
-import Data.Aeson
-import GHC.Generics
-
-data Number = Number
-  { number :: Int
-  } deriving (Show, Generic)
-
-instance FromJSON Number
-instance ToJSON Number
diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs
deleted file mode 100644
index e406c0f..0000000
--- a/src/server/Model/Json/Payment.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Payment
-  ( Payment(..)
-  , fromPayment
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import Data.Time.Calendar (Day)
-import GHC.Generics
-import Prelude hiding (id)
-
-import Model.Frequency
-import Model.Payment (PaymentId)
-import Model.User (UserId)
-import qualified Model.Payment as M
-
-data Payment = Payment
-  { id :: PaymentId
-  , date :: Day
-  , name :: Text
-  , cost :: Int
-  , userId :: UserId
-  , frequency :: Frequency
-  } deriving (Show, Generic)
-
-instance FromJSON Payment
-instance ToJSON Payment
-
-fromPayment :: M.Payment -> Payment
-fromPayment payment =
-  Payment
-    { id = M.id payment
-    , date = M.date payment
-    , name = M.name payment
-    , cost = M.cost payment
-    , userId = M.userId payment
-    , frequency = M.frequency payment
-    }
diff --git a/src/server/Model/Json/PaymentCategory.hs b/src/server/Model/Json/PaymentCategory.hs
deleted file mode 100644
index fd97674..0000000
--- a/src/server/Model/Json/PaymentCategory.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.PaymentCategory
-  ( PaymentCategory(..)
-  , fromPaymentCategory
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import GHC.Generics
-
-import Model.Category (CategoryId)
-import qualified Model.PaymentCategory as M
-
-data PaymentCategory = PaymentCategory
-  { name :: Text
-  , category :: CategoryId
-  } deriving (Show, Generic)
-
-instance ToJSON PaymentCategory
-
-fromPaymentCategory :: M.PaymentCategory -> PaymentCategory
-fromPaymentCategory pc = PaymentCategory (M.name pc) (M.category pc)
diff --git a/src/server/Model/Json/Translation.hs b/src/server/Model/Json/Translation.hs
deleted file mode 100644
index 9dcfe80..0000000
--- a/src/server/Model/Json/Translation.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.Translation
-  ( Translation(..)
-  ) where
-
-import GHC.Generics
-
-import Data.Aeson
-import Data.Text
-
-import Model.Json.MessagePart
-
-data Translation = Translation
-  { key :: Text
-  , message :: [MessagePart]
-  } deriving (Show, Generic)
-
-instance FromJSON Translation
-instance ToJSON Translation
diff --git a/src/server/Model/Json/User.hs b/src/server/Model/Json/User.hs
deleted file mode 100644
index c289fe0..0000000
--- a/src/server/Model/Json/User.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.User
-  ( User(..)
-  , fromUser
-  ) where
-
-import Data.Aeson
-import Data.Text (Text)
-import GHC.Generics
-
-import Model.User (UserId)
-import qualified Model.User as M
-
-data User = User
-  { id :: UserId
-  , name :: Text
-  , email :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON User
-instance ToJSON User
-
-fromUser :: M.User -> User
-fromUser user = User (M.id user) (M.name user) (M.email user)
diff --git a/src/server/Model/Message.hs b/src/server/Model/Message.hs
deleted file mode 100644
index 026967f..0000000
--- a/src/server/Model/Message.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Model.Message
-  ( getMessage
-  , getParamMessage
-  , getTranslations
-  , plural
-  ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Model.Message.Key (Key)
-import Model.Message.Lang
-import Model.Message.Translations (getNonFormattedMessage)
-import Model.Message.Parts
-
-import Model.Json.Translation
-
-getMessage :: Key -> Text
-getMessage = getParamMessage []
-
-getParamMessage :: [Text] -> Key -> Text
-getParamMessage values paramKey = replaceParts values (getNonFormattedMessage lang paramKey)
-
-getTranslations :: [Translation]
-getTranslations = (map getTranslation [minBound..])
-
-getTranslation :: Key -> Translation
-getTranslation translationKey =
-  Translation
-    (T.pack . show $ translationKey)
-    (getParts $ getNonFormattedMessage lang translationKey)
-
-plural :: Int -> Key -> Key -> Text
-plural count singularKey pluralKey =
-  getParamMessage [T.pack . show $ count] (if count <= 1 then singularKey else pluralKey)
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
deleted file mode 100644
index 18f16f0..0000000
--- a/src/server/Model/Message/Key.hs
+++ /dev/null
@@ -1,193 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Message.Key
-  ( Key(..)
-  ) where
-
-import qualified Data.Aeson as Json
-import qualified Data.Text as T
-
-data Key =
-
-  -- Title
-
-  SharedCost
-
-  -- Sign
-
-  | Email
-  | SignIn
-  | SendEmailFail
-  | InvalidEmail
-  | UnauthorizedSignIn
-  | Forbidden
-  | EnterValidEmail
-  | SignInUsed
-  | SignInExpired
-  | SignInInvalid
-  | SignInMailTitle
-  | SignInMail
-  | SignInEmailSent
-
-  -- Dates
-
-  | January
-  | February
-  | March
-  | April
-  | May
-  | June
-  | July
-  | August
-  | September
-  | October
-  | November
-  | December
-
-  | ShortDate
-  | ShortMonthAndYear
-  | LongDate
-
-  -- Search
-
-  | SearchName
-  | SearchPunctual
-  | SearchMonthly
-
-  -- Payments
-
-  | PaymentsAreBalanced
-  | Name
-  | Cost
-  | Payer
-  | Date
-  | Frequency
-  | InvalidFrequency
-  | AddPayment
-  | ClonePayment
-  | EditPayment
-  | PaymentNotDeleted
-  | Punctual
-  | Monthly
-
-  | PaymentsTitle
-  | Payment
-  | Payments
-  | Worth
-  | NoPayment
-
-  | PaymentName
-  | PaymentCost
-  | PaymentDate
-  | PaymentCategory
-  | PaymentPunctual
-  | PaymentMonthly
-
-  | Clone
-  | Edit
-  | Delete
-  | ConfirmPaymentDelete
-
-  -- Categories
-
-  | Categories
-  | NoCategories
-  | CategoryNotDeleted
-  | AddCategory
-  | CloneCategory
-  | EditCategory
-  | ConfirmCategoryDelete
-  | CategoryName
-  | CategoryColor
-  | Color
-  | UsedCategory
-
-  -- Statistics
-
-  | Statistics
-  | ByMonthsAndMean
-  | By
-  | Total
-
-  -- Income
-
-  | CumulativeIncomesSince
-  | NoIncome
-  | Income
-  | MonthlyNetIncomes
-  | AddIncome
-  | CloneIncome
-  | EditIncome
-  | IncomeNotDeleted
-  | IncomeAmount
-  | IncomeDate
-  | ConfirmIncomeDelete
-  | Add
-
-  -- Form
-
-  | Empty
-  | InvalidString
-  | InvalidDate
-  | CostMustNotBeNull
-  | InvalidInt
-  | InvalidCategory
-  | InvalidColor
-  | AlreadyExists
-  | SmallerIntThan
-  | GreaterIntThan
-
-  -- Errors
-
-  | CreatePaymentError
-  | EditPaymentError
-  | DeletePaymentError
-  | CreateIncomeError
-  | EditIncomeError
-  | DeleteIncomeError
-  | CreateCategoryError
-  | EditCategoryError
-  | DeleteCategoryError
-  | SignOutError
-
-  -- Dialog
-
-  | Confirm
-  | Undo
-
-  -- Page not found
-
-  | PageNotFound
-
-  -- Weekly report
-
-  | WeeklyReport
-  | WeeklyReportEmpty
-  | PaymentCreated
-  | PaymentsCreated
-  | PaymentEdited
-  | PaymentsEdited
-  | PaymentDeleted
-  | PaymentsDeleted
-  | IncomeCreated
-  | IncomesCreated
-  | IncomeEdited
-  | IncomesEdited
-  | IncomeDeleted
-  | IncomesDeleted
-  | PayedFor
-  | DidNotPayFor
-  | IsPayedFrom
-  | IsNotPayedFrom
-
-  -- Http error
-
-  | BadUrl
-  | Timeout
-  | NetworkError
-  | BadPayload
-
-  deriving (Enum, Bounded, Show)
-
-instance Json.ToJSON Key where
-  toJSON = Json.String . T.pack . show
diff --git a/src/server/Model/Message/Lang.hs b/src/server/Model/Message/Lang.hs
deleted file mode 100644
index f515c96..0000000
--- a/src/server/Model/Message/Lang.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Model.Message.Lang
-  ( Lang(..)
-  , lang
-  ) where
-
-data Lang =
-  English
-  | French
-
-lang :: Lang
-lang = French
diff --git a/src/server/Model/Message/Parts.hs b/src/server/Model/Message/Parts.hs
deleted file mode 100644
index d065cf2..0000000
--- a/src/server/Model/Message/Parts.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Model.Message.Parts
-  ( replaceParts
-  , getParts
-  ) where
-
-import Data.Maybe (listToMaybe, fromMaybe)
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Text.ParserCombinators.Parsec
-
-import Model.Json.MessagePart
-
-replaceParts :: [Text] -> Text -> Text
-replaceParts values message =
-  T.concat . map (replacePart values) $ getParts message
-
-replacePart :: [Text] -> MessagePart -> Text
-replacePart _ (Str str) = str
-replacePart values (Order n) =
-  fromMaybe (T.concat ["{", T.pack (show n), "}"]) . listToMaybe . drop (n - 1) $ values
-
-getParts :: Text -> [MessagePart]
-getParts str =
-  case parse partsParser "" (T.unpack str) of
-    Right parts -> parts
-    Left _ -> []
-
-partsParser :: Parser [MessagePart]
-partsParser = many partParser
-
-partParser :: Parser MessagePart
-partParser =
-  (do _ <- string "{"; n <- read <$> many1 digit; _ <- string "}"; return (Order n))
-  <|> (do str <- T.pack <$> many1 (noneOf "{"); return (Str str))
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
deleted file mode 100644
index 7d26c3f..0000000
--- a/src/server/Model/Message/Translations.hs
+++ /dev/null
@@ -1,729 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Model.Message.Translations
-  ( getNonFormattedMessage
-  ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Model.Message.Key
-import Model.Message.Lang
-
-getNonFormattedMessage :: Lang -> Key -> Text
-getNonFormattedMessage = m
-
-m :: Lang -> Key -> Text
-
--- Title
-
-m l SharedCost =
-  case l of
-    English -> "Shared Cost"
-    French  -> "Partage des frais"
-
--- Sign in
-
-m l Email =
-  case l of
-    English -> "Email"
-    French -> "Courriel"
-
-m l SignIn =
-  case l of
-    English -> "Sign in"
-    French  -> "Connexion"
-
-m l InvalidEmail =
-  case l of
-    English -> "Your email is not valid."
-    French  -> "Votre courriel n'est pas valide."
-
-m l UnauthorizedSignIn =
-  case l of
-    English -> "You are not authorized to sign in."
-    French  -> "Tu n'es pas autorisé à te connecter."
-
-m l Forbidden =
-  case l of
-    English -> "You need to be logged in to perform this action"
-    French  -> "Tu dois te connecter pour effectuer cette action"
-
-m l SendEmailFail =
-  case l of
-    English -> "You are authorized to sign in, but we failed to send you the sign up email."
-    French  -> "Tu es autorisé à te connecter, mais nous n'avons pas pu t'envoyer le courriel de connexion."
-
-m l EnterValidEmail =
-  case l of
-    English -> "Please enter a valid email address."
-    French  -> "Ton courriel n'est pas valide."
-
-m l SignInUsed =
-  case l of
-    English -> "You already used this link, please sign in again."
-    French  -> "Tu as déjà utilisé ce lien, connecte-toi à nouveau."
-
-m l SignInExpired =
-  case l of
-    English -> "The link expired, please sign in again."
-    French  -> "Le lien sur lequel tu as cliqué a expiré, connecte-toi à nouveau."
-
-m l SignInInvalid =
-  case l of
-    English -> "The link is invalid, please sign in again."
-    French  -> "Le lien sur lequel tu as cliqué est invalide, connecte-toi à nouveau."
-
-m l SignInMailTitle =
-  case l of
-    English -> T.concat ["Sign in to ", m l SharedCost]
-    French  -> T.concat ["Connexion à ", m l SharedCost]
-
-m l SignInMail =
-  T.intercalate
-    "\n"
-    ( case l of
-        English ->
-          [ "Hi {1},"
-          , ""
-          , T.concat
-              [ "Click to the following link in order to sign in to Shared Cost:"
-              , m l SharedCost
-              , ":"
-              ]
-          , "{2}"
-          , ""
-          , "See you soon!"
-          ]
-        French  ->
-          [ "Salut {1},"
-          , ""
-          , T.concat
-              [ "Clique sur le lien suivant pour te connecter à "
-              , m l SharedCost
-              , ":"
-              ]
-          , "{2}"
-          , ""
-          , "À très vite !"
-          ]
-    )
-
-m l SignInEmailSent =
-  case l of
-    English -> "We sent you an email with a connexion link."
-    French  -> "Nous t'avons envoyé un courriel avec un lien pour te connecter."
-
--- Date
-
-m l January =
-  case l of
-    English -> "january"
-    French  -> "janvier"
-
-m l February =
-  case l of
-    English -> "february"
-    French  -> "février"
-
-m l March =
-  case l of
-    English -> "march"
-    French  -> "mars"
-
-m l April =
-  case l of
-    English -> "april"
-    French  -> "avril"
-
-m l May =
-  case l of
-    English -> "may"
-    French  -> "mai"
-
-m l June =
-  case l of
-    English -> "june"
-    French  -> "juin"
-
-m l July =
-  case l of
-    English -> "july"
-    French  -> "juillet"
-
-m l August =
-  case l of
-    English -> "august"
-    French  -> "août"
-
-m l September =
-  case l of
-    English -> "september"
-    French  -> "septembre"
-
-m l October =
-  case l of
-    English -> "october"
-    French  -> "octobre"
-
-m l November =
-  case l of
-    English -> "november"
-    French  -> "novembre"
-
-m l December =
-  case l of
-    English -> "december"
-    French  -> "décembre"
-
-m l ShortDate =
-  case l of
-    English -> "{3}-{2}-{1}"
-    French  -> "{1}/{2}/{3}"
-
-m l ShortMonthAndYear =
-  case l of
-    English -> "{2}-{1}"
-    French  -> "{1}/{2}"
-
-m l LongDate =
-  case l of
-    English -> "{2} {1}, {3}"
-    French  -> "{1} {2} {3}"
-
--- Search
-
-m l SearchName =
-  case l of
-    English -> "Search"
-    French  -> "Recherche"
-
-m l SearchPunctual =
-  case l of
-    English -> "Punctual"
-    French  -> "Ponctuel"
-
-m l SearchMonthly =
-  case l of
-    English -> "Monthly"
-    French  -> "Mensuel"
-
--- Payments
-
-m l PaymentsAreBalanced =
-  case l of
-    English -> "Payments are balanced."
-    French  -> "Les paiements sont équilibrés."
-
-m l Name =
-  case l of
-    English -> "Name"
-    French  -> "Nom"
-
-m l Cost =
-  case l of
-    English -> "Cost"
-    French  -> "Coût"
-
-m l Payer =
-  case l of
-    English -> "Payer"
-    French  -> "Payeur"
-
-m l Date =
-  case l of
-    English -> "Date"
-    French  -> "Date"
-
-m l Frequency =
-  case l of
-    English -> "Frequency"
-    French  -> "Fréquence"
-
-m l InvalidFrequency =
-  case l of
-    English -> "Invalid frequency"
-    French  -> "Fréquence invalide"
-
-m l AddPayment =
-  case l of
-    English -> "Add a payment"
-    French  -> "Ajouter un paiement"
-
-m l ClonePayment =
-  case l of
-    English -> "Clone a payment"
-    French  -> "Cloner un paiement"
-
-m l EditPayment =
-  case l of
-    English -> "Edit a payment"
-    French  -> "Modifier un paiement"
-
-m l PaymentNotDeleted =
-  case l of
-    English -> "The payment could not have been deleted."
-    French  -> "Le paiement n'a pas pu être supprimé."
-
-m l Punctual =
-  case l of
-    English -> "Punctual"
-    French  -> "Ponctuelle"
-
-m l Monthly =
-  case l of
-    English -> "Monthly"
-    French  -> "Mensuelle"
-
-m l PaymentsTitle =
-  case l of
-    English -> "Payments"
-    French -> "Paiements"
-
-m l Payment =
-  case l of
-    English -> "payment"
-    French  -> "paiement"
-
-m l Payments =
-  case l of
-    English -> "payments"
-    French  -> "paiements"
-
-m l Worth =
-  case l of
-    English -> "{1} worth {2}"
-    French  -> "{1} comptabilisant {2}"
-
-m l NoPayment =
-  case l of
-    English -> "No payment found from your search criteria."
-    French  -> "Aucun paiement ne correspond à vos critères de recherches."
-
-m l PaymentName =
-  case l of
-    English -> "Name"
-    French  -> "Nom"
-
-m l PaymentCost =
-  case l of
-    English -> "Cost"
-    French  -> "Coût"
-
-m l PaymentDate =
-  case l of
-    English -> "Date"
-    French  -> "Date"
-
-m l PaymentCategory =
-  case l of
-    English -> "Category"
-    French  -> "Catégorie"
-
-m l PaymentPunctual =
-  case l of
-    English -> "Punctual"
-    French  -> "Ponctuel"
-
-m l PaymentMonthly =
-  case l of
-    English -> "Monthly"
-    French  -> "Mensuel"
-
-m l ConfirmPaymentDelete =
-  case l of
-    English -> "Are you sure to delete this payment ?"
-    French  -> "Voulez-vous vraiment supprimer ce paiement ?"
-
-m l Edit =
-  case l of
-    English -> "Edit"
-    French  -> "Modifier"
-
-m l Clone =
-  case l of
-    English -> "Clone"
-    French  -> "Cloner"
-
-m l Delete =
-  case l of
-    English -> "Delete"
-    French  -> "Supprimer"
-
--- Categories
-
-m l Categories =
-  case l of
-    English -> "Categories"
-    French  -> "Catégories"
-
-m l NoCategories =
-  case l of
-    English -> "No category."
-    French  -> "Aucune catégorie."
-
-m l CategoryNotDeleted =
-  case l of
-    English -> "The category could not have been deleted."
-    French  -> "La catégorie n'a pas pu être supprimé."
-
-m l AddCategory =
-  case l of
-    English -> "Add an category"
-    French  -> "Ajouter une catégorie"
-
-m l CloneCategory =
-  case l of
-    English -> "Clone an category"
-    French  -> "Cloner une catégorie"
-
-m l EditCategory =
-  case l of
-    English -> "Edit an category"
-    French  -> "Modifier une catégorie"
-
-m l ConfirmCategoryDelete =
-  case l of
-    English -> "Are you sure to delete this category ?"
-    French  -> "Voulez-vous vraiment supprimer cette catégorie ?"
-
-m l CategoryName =
-  case l of
-    English -> "Name"
-    French  -> "Nom"
-
-m l CategoryColor =
-  case l of
-    English -> "Color"
-    French  -> "Couleur"
-
-m l Color =
-  case l of
-    English -> "Color"
-    French  -> "Couleur"
-
-m l UsedCategory =
-  case l of
-    English -> "This category is currently being used"
-    French  -> "Cette catégorie est actuellement utilisée"
-
--- Statistics
-
-m l Statistics =
-  case l of
-    English -> "Statistics"
-    French  -> "Statistiques"
-
-m l ByMonthsAndMean =
-  case l of
-    English -> "Payments by category by month months ({1} on average)"
-    French  -> "Paiements par catégorie par mois (en moyenne {1})"
-
-m l By =
-  case l of
-    English -> "{1}: {2}"
-    French  -> "{1} : {2}"
-
-m l Total =
-  case l of
-    English -> "Total"
-    French  -> "Total"
-
--- Income
-
-m l CumulativeIncomesSince =
-  case l of
-    English -> "Cumulative incomes since {1}"
-    French  -> "Revenus nets cumulés depuis le {1}"
-
-m l NoIncome =
-  case l of
-    English -> "No income."
-    French  -> "Aucun revenu."
-
-m l Income =
-  case l of
-    English -> "Income"
-    French  -> "Revenu"
-
-m l MonthlyNetIncomes =
-  case l of
-    English -> "Net monthly incomes"
-    French  -> "Revenus mensuels nets"
-
-m l AddIncome =
-  case l of
-    English -> "Add an income"
-    French  -> "Ajouter un revenu"
-
-m l CloneIncome =
-  case l of
-    English -> "Clone an income"
-    French  -> "Cloner un revenu"
-
-m l EditIncome =
-  case l of
-    English -> "Edit an income"
-    French  -> "Modifier un revenu"
-
-m l IncomeNotDeleted =
-  case l of
-    English -> "The income could not have been deleted."
-    French  -> "Le revenu n'a pas pu être supprimé."
-
-m l IncomeAmount =
-  case l of
-    English -> "Amount"
-    French  -> "Montant"
-
-m l IncomeDate =
-  case l of
-    English -> "Date"
-    French  -> "Date"
-
-m l ConfirmIncomeDelete =
-  case l of
-    English -> "Are you sure to delete this income ?"
-    French  -> "Voulez-vous vraiment supprimer ce revenu ?"
-
-m l Add =
-  case l of
-    English -> "Add"
-    French  -> "Ajouter"
-
--- Form error
-
-m l Empty =
-  case l of
-    English -> "Required field"
-    French  -> "Champ requis"
-
-m l InvalidString =
-  case l of
-    English -> "String required"
-    French  -> "Chaîne de caractères requise"
-
-m l InvalidDate =
-  case l of
-    English -> "day/month/year required"
-    French  -> "jour/mois/année requis"
-
-m l CostMustNotBeNull =
-  case l of
-    English -> "Cost must not be zero"
-    French -> "Le coût ne doît pas être nul"
-
-m l InvalidInt =
-  case l of
-    English -> "Integer required"
-    French  -> "Entier requis"
-
-m l InvalidCategory =
-  case l of
-    English -> "Invalid category"
-    French  -> "Catégorie invalide"
-
-m l InvalidColor =
-  case l of
-    English -> "Invalid color"
-    French  -> "Couleur invalide"
-
-m l AlreadyExists =
-  case l of
-    English -> "Dupplicate field"
-    French  -> "Doublon"
-
-m l SmallerIntThan =
-  case l of
-    English -> "Integer bigger than {1} or equal required"
-    French  -> "Entier supérieur ou égal à {1} requis"
-
-m l GreaterIntThan =
-  case l of
-    English -> "Integer smaller than {1} or equal required"
-    French  -> "Entier inférieur ou égal à {1} requis"
-
--- Errors
-
-m l CreatePaymentError =
-  case l of
-    English -> "Error at payment creation"
-    French  -> "Erreur lors de la création du paiement"
-
-m l EditPaymentError =
-  case l of
-    English -> "Error at payment edition"
-    French  -> "Erreur lors de la modification du paiement"
-
-m l DeletePaymentError =
-  case l of
-    English -> "Error at payment deletion"
-    French  -> "Erreur lors de la suppression du paiement"
-
-m l CreateIncomeError =
-  case l of
-    English -> "Error at income creation"
-    French  -> "Erreur lors de la création du revenu"
-
-m l EditIncomeError =
-  case l of
-    English -> "Error at income edition"
-    French  -> "Erreur lors de la modification du revenu"
-
-m l DeleteIncomeError =
-  case l of
-    English -> "Error at income deletion"
-    French  -> "Erreur lors de la suppression du revenu"
-
-m l CreateCategoryError =
-  case l of
-    English -> "Error at category creation"
-    French  -> "Erreur lors de la création de la catégorie"
-
-m l EditCategoryError =
-  case l of
-    English -> "Error at category edition"
-    French  -> "Erreur lors de la modification de la catégorie"
-
-m l DeleteCategoryError =
-  case l of
-    English -> "Error at category deletion"
-    French  -> "Erreur lors de la suppression de la catégorie"
-
-m l SignOutError =
-  case l of
-    English -> "Error at sign out"
-    French  -> "Erreur lors de la déconnexion"
-
--- Dialog
-
-m l Confirm =
-  case l of
-    English -> "Confirm"
-    French  -> "Confirmer"
-
-m l Undo =
-  case l of
-    English -> "Undo"
-    French  -> "Annuler"
-
--- Page not found
-
-m l PageNotFound =
-  case l of
-    English -> "Page not found"
-    French  -> "Page introuvable"
-
--- Weekly report
-
-m l WeeklyReport =
-  case l of
-    English -> "Weekly report"
-    French  -> "Rapport hebdomadaire"
-
-m l WeeklyReportEmpty =
-  case l of
-    English -> "No activity the previous week."
-    French  -> "Pas d'activité la semaine passée."
-
-m l PaymentCreated =
-  case l of
-    English -> "{1} payment created:"
-    French  -> "{1} paiement créé :"
-
-m l PaymentsCreated =
-  case l of
-    English -> "{1} payments created:"
-    French  -> "{1} paiements créés :"
-
-m l PaymentEdited =
-  case l of
-    English -> "{1} payment edited:"
-    French  -> "{1} paiement modifié :"
-
-m l PaymentsEdited =
-  case l of
-    English -> "{1} payments edited:"
-    French  -> "{1} paiements modifiés :"
-
-m l PaymentDeleted =
-  case l of
-    English -> "{1} payment deleted:"
-    French  -> "{1} paiement supprimé :"
-
-m l PaymentsDeleted =
-  case l of
-    English -> "{1} payments deleted:"
-    French  -> "{1} paiements supprimés :"
-
-m l IncomeCreated =
-  case l of
-    English -> "{1} income created:"
-    French  -> "{1} revenu créé :"
-
-m l IncomesCreated =
-  case l of
-    English -> "{1} incomes created:"
-    French  -> "{1} revenus créés :"
-
-m l IncomeEdited =
-  case l of
-    English -> "{1} income edited:"
-    French  -> "{1} revenu modifié :"
-
-m l IncomesEdited =
-  case l of
-    English -> "{1} incomes edited:"
-    French  -> "{1} revenus modifiés :"
-
-m l IncomeDeleted =
-  case l of
-    English -> "{1} income deleted:"
-    French  -> "{1} revenu supprimé :"
-
-m l IncomesDeleted =
-  case l of
-    English -> "{1} incomes deleted:"
-    French  -> "{1} revenus supprimés :"
-
-m l PayedFor =
-  case l of
-    English -> "{1} payed {2} for “{3}” at {4}"
-    French  -> "{1} a payé {2} concernant « {3} » le {4}"
-
-m l DidNotPayFor =
-  case l of
-    English -> "{1} didn't pay {2} for “{3}” at {4}"
-    French  -> "{1} n'a pas payé {2} concernant « {3} » le {4}"
-
-m l IsPayedFrom =
-  case l of
-    English -> "{1} is payed {2} of net monthly income from {3}"
-    French  -> "{1} est payé {2} net par mois à partir du {3}"
-
-m l IsNotPayedFrom =
-  case l of
-    English -> "{1} isn't payed {2} of net monthly income from {3}"
-    French  -> "{1} n'est pas payé {2} net par mois à partir du {3}"
-
--- Http error
-
-m l BadUrl =
-  case l of
-    English -> "URL not valid"
-    French  -> "l'URL n'est pas valide"
-
-m l Timeout =
-  case l of
-    English -> "Timeout server error"
-    French  -> "Le serveur met trop de temps à répondre"
-
-m l NetworkError =
-  case l of
-    English -> "Network can not be reached"
-    French  -> "Le serveur n'est pas accessible"
-
-m l BadPayload =
-  case l of
-    English -> "Bad payload server error"
-    French  -> "Contenu inattendu en provenance du serveur"
diff --git a/src/server/Model/Payer.hs b/src/server/Model/Payer.hs
new file mode 100644
index 0000000..de4abd1
--- /dev/null
+++ b/src/server/Model/Payer.hs
@@ -0,0 +1,216 @@
+module Model.Payer
+  ( getOrderedExceedingPayers
+  ) where
+
+import Data.Map (Map)
+import Data.Time (UTCTime(..), NominalDiffTime)
+import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Data.Maybe as Maybe
+import qualified Data.Time as Time
+
+import Common.Model (User(..), UserId, Income(..), IncomeId, Payment(..))
+
+type Users = Map UserId User
+
+type Payers = Map UserId Payer
+
+type Incomes = Map IncomeId Income
+
+type Payments = [Payment]
+
+data Payer = Payer
+  { preIncomePaymentSum :: Int
+  , postIncomePaymentSum :: Int
+  , _incomes :: [Income]
+  }
+
+data PostPaymentPayer = PostPaymentPayer
+  { _preIncomePaymentSum :: Int
+  , _cumulativeIncome :: Int
+  , ratio :: Float
+  }
+
+data ExceedingPayer = ExceedingPayer
+  { _userId :: UserId
+  , amount :: Int
+  } deriving (Show)
+
+getOrderedExceedingPayers :: UTCTime -> [User] -> [Income] -> Payments -> [ExceedingPayer]
+getOrderedExceedingPayers currentTime users incomes payments =
+  let usersMap = Map.fromList . map (\user -> (_user_id user, user)) $ users
+      incomesMap = Map.fromList . map (\income -> (_income_id income, income)) $ incomes
+      payers = getPayers currentTime usersMap incomesMap payments
+      exceedingPayersOnPreIncome =
+        exceedingPayersFromAmounts
+          . Map.toList
+          . Map.map preIncomePaymentSum
+          $ payers
+      mbSince = useIncomesFrom usersMap incomesMap payments
+  in  case mbSince of
+        Just since ->
+          let postPaymentPayers = Map.map (getPostPaymentPayer currentTime since) payers
+              mbMaxRatio =
+                safeMaximum
+                  . map (ratio . snd)
+                  . Map.toList
+                  $ postPaymentPayers
+          in  case mbMaxRatio of
+                Just maxRatio ->
+                  exceedingPayersFromAmounts
+                    . Map.toList
+                    . Map.map (getFinalDiff maxRatio)
+                    $ postPaymentPayers
+                Nothing ->
+                  exceedingPayersOnPreIncome
+        _ ->
+          exceedingPayersOnPreIncome
+
+useIncomesFrom :: Users -> Incomes -> Payments -> Maybe UTCTime
+useIncomesFrom users incomes payments =
+  let firstPaymentTime = safeHead . List.sort . map paymentTime $ payments
+      mbIncomeTime = incomeDefinedForAll (Map.keys users) incomes
+  in  case (firstPaymentTime, mbIncomeTime) of
+        (Just t1, Just t2) -> Just (max t1 t2)
+        _ -> Nothing
+
+paymentTime :: Payment -> UTCTime
+paymentTime = flip UTCTime (Time.secondsToDiffTime 0) . _payment_date
+
+getPayers :: UTCTime -> Users -> Incomes -> Payments -> Payers
+getPayers currentTime users incomes payments =
+  let userIds = Map.keys users
+      incomesDefined = incomeDefinedForAll userIds incomes
+  in  Map.fromList
+        . map (\userId ->
+            ( userId
+            , Payer
+                { preIncomePaymentSum =
+                    totalPayments
+                      (\p -> paymentTime p < (Maybe.fromMaybe currentTime incomesDefined))
+                      userId
+                      payments
+                , postIncomePaymentSum =
+                    totalPayments
+                      (\p ->
+                        case incomesDefined of
+                          Nothing -> False
+                          Just t -> paymentTime p >= t
+                      )
+                      userId
+                      payments
+                , _incomes = filter ((==) userId . _income_userId) (Map.elems incomes)
+                }
+            )
+        )
+        $ userIds
+
+exceedingPayersFromAmounts :: [(UserId, Int)] -> [ExceedingPayer]
+exceedingPayersFromAmounts userAmounts =
+  case mbMinAmount of
+    Nothing ->
+      []
+    Just minAmount ->
+      filter (\payer -> amount payer > 0)
+        . map (\userAmount ->
+           ExceedingPayer
+             { _userId = fst userAmount
+             , amount = snd userAmount - minAmount
+             }
+        )
+        $ userAmounts
+  where mbMinAmount = safeMinimum . map snd $ userAmounts
+
+getPostPaymentPayer :: UTCTime -> UTCTime -> Payer -> PostPaymentPayer
+getPostPaymentPayer currentTime since payer =
+  PostPaymentPayer
+    { _preIncomePaymentSum = preIncomePaymentSum payer
+    , _cumulativeIncome = cumulativeIncome
+    , ratio = (fromIntegral . postIncomePaymentSum $ payer) / (fromIntegral cumulativeIncome)
+    }
+  where cumulativeIncome = cumulativeIncomesSince currentTime since (_incomes payer)
+
+getFinalDiff :: Float -> PostPaymentPayer -> Int
+getFinalDiff maxRatio payer =
+  let postIncomeDiff =
+        truncate $ -1.0 * (maxRatio - ratio payer) * (fromIntegral . _cumulativeIncome $ payer)
+  in  postIncomeDiff + _preIncomePaymentSum payer
+
+incomeDefinedForAll :: [UserId] -> Incomes -> Maybe UTCTime
+incomeDefinedForAll userIds incomes =
+  let userIncomes = map (\userId -> filter ((==) userId . _income_userId) . Map.elems $ incomes) userIds
+      firstIncomes = map (safeHead . List.sortOn incomeTime) userIncomes
+  in  if all Maybe.isJust firstIncomes
+        then safeHead . reverse . List.sort . map incomeTime . Maybe.catMaybes $ firstIncomes
+        else Nothing
+
+cumulativeIncomesSince :: UTCTime -> UTCTime -> [Income] -> Int
+cumulativeIncomesSince currentTime since incomes =
+  getCumulativeIncome currentTime (getOrderedIncomesSince since incomes)
+
+getOrderedIncomesSince :: UTCTime -> [Income] -> [Income]
+getOrderedIncomesSince time incomes =
+  let mbStarterIncome = getIncomeAt time incomes
+      orderedIncomesSince = filter (\income -> incomeTime income >= time) incomes
+  in  (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince
+
+getIncomeAt :: UTCTime -> [Income] -> Maybe Income
+getIncomeAt time incomes =
+  case incomes of
+    [x] ->
+      if incomeTime x < time
+        then Just $ x { _income_date = utctDay time }
+        else Nothing
+    x1 : x2 : xs ->
+      if incomeTime x1 < time && incomeTime x2 >= time
+        then Just $ x1 { _income_date = utctDay time }
+        else getIncomeAt time (x2 : xs)
+    [] ->
+      Nothing
+
+getCumulativeIncome :: UTCTime -> [Income] -> Int
+getCumulativeIncome currentTime incomes =
+  sum
+    . map durationIncome
+    . getIncomesWithDuration currentTime
+    . List.sortOn incomeTime
+    $ incomes
+
+getIncomesWithDuration :: UTCTime -> [Income] -> [(NominalDiffTime, Int)]
+getIncomesWithDuration currentTime incomes =
+  case incomes of
+    [] ->
+      []
+    [income] ->
+      [(Time.diffUTCTime currentTime (incomeTime income), _income_amount income)]
+    (income1 : income2 : xs) ->
+      (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs))
+
+incomeTime :: Income -> UTCTime
+incomeTime = flip UTCTime (Time.secondsToDiffTime 0) . _income_date
+
+durationIncome :: (NominalDiffTime, Int) -> Int
+durationIncome (duration, income) =
+  truncate $ duration * fromIntegral income / (nominalDay * 365 / 12)
+
+nominalDay :: NominalDiffTime
+nominalDay = 86400
+
+safeHead :: [a] -> Maybe a
+safeHead [] = Nothing
+safeHead (x : _) = Just x
+
+safeMinimum :: (Ord a) => [a] -> Maybe a
+safeMinimum [] = Nothing
+safeMinimum xs = Just . minimum $ xs
+
+safeMaximum :: (Ord a) => [a] -> Maybe a
+safeMaximum [] = Nothing
+safeMaximum xs = Just . maximum $ xs
+
+totalPayments :: (Payment -> Bool) -> UserId -> Payments -> Int
+totalPayments paymentFilter userId payments =
+  sum
+    . map _payment_cost
+    . filter (\payment -> paymentFilter payment && _payment_user payment == userId)
+    $ payments
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 5414d18..5b576c5 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.Payment
-  ( PaymentId
-  , Payment(..)
+  ( Payment(..)
   , find
   , list
   , listMonthly
@@ -13,7 +13,6 @@ module Model.Payment
   , modifiedDuring
   ) where
 
-import Data.Int (Int64)
 import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import Data.Time (UTCTime)
@@ -24,29 +23,19 @@ import Database.SQLite.Simple.ToField (ToField(toField))
 import Prelude hiding (id)
 import qualified Database.SQLite.Simple as SQLite
 
-import Model.Frequency
+import Common.Model.Frequency
+import Common.Model.Payment (Payment(..))
+import Common.Model.User (UserId)
+import Common.Model.Payment (PaymentId)
+
+import Model.Frequency ()
 import Model.Query (Query(Query))
-import Model.User (UserId)
 import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
 
-type PaymentId = Int64
-
-data Payment = Payment
-  { id :: PaymentId
-  , userId :: UserId
-  , name :: Text
-  , cost :: Int
-  , date :: Day
-  , frequency :: Frequency
-  , createdAt :: UTCTime
-  , editedAt :: Maybe UTCTime
-  , deletedAt :: Maybe UTCTime
-  } deriving Show
-
 instance Resource Payment where
-  resourceCreatedAt = createdAt
-  resourceEditedAt = editedAt
-  resourceDeletedAt = deletedAt
+  resourceCreatedAt = _payment_createdAt
+  resourceEditedAt = _payment_editedAt
+  resourceDeletedAt = _payment_deletedAt
 
 instance FromRow Payment where
   fromRow = Payment <$>
@@ -62,12 +51,12 @@ instance FromRow Payment where
 
 instance ToRow Payment where
   toRow p =
-    [ toField (userId p)
-    , toField (name p)
-    , toField (cost p)
-    , toField (date p)
-    , toField (frequency p)
-    , toField (createdAt p)
+    [ toField (_payment_user p)
+    , toField (_payment_name p)
+    , toField (_payment_cost p)
+    , toField (_payment_date p)
+    , toField (_payment_frequency p)
+    , toField (_payment_createdAt p)
     ]
 
 find :: PaymentId -> Query (Maybe Payment)
@@ -92,13 +81,13 @@ listMonthly =
   )
 
 create :: UserId -> Text -> Int -> Day -> Frequency -> Query PaymentId
-create paymentUserId paymentName paymentCost paymentDate paymentFrequency =
+create userId paymentName paymentCost paymentDate paymentFrequency =
   Query (\conn -> do
     now <- getCurrentTime
     SQLite.execute
       conn
       "INSERT INTO payment (user_id, name, cost, date, frequency, created_at) VALUES (?, ?, ?, ?, ?, ?)"
-      (paymentUserId, paymentName, paymentCost, paymentDate, paymentFrequency, now)
+      (userId, paymentName, paymentCost, paymentDate, paymentFrequency, now)
     SQLite.lastInsertRowId conn
   )
 
@@ -112,13 +101,13 @@ createMany payments =
   )
 
 editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
-editOwn paymentUserId paymentId paymentName paymentCost paymentDate paymentFrequency =
+editOwn userId paymentId paymentName paymentCost paymentDate paymentFrequency =
   Query (\conn -> do
     mbPayment <- listToMaybe <$>
       SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
     case mbPayment of
       Just payment ->
-        if userId payment == paymentUserId
+        if _payment_user payment == userId
           then do
             now <- getCurrentTime
             SQLite.execute
@@ -133,13 +122,13 @@ editOwn paymentUserId paymentId paymentName paymentCost paymentDate paymentFrequ
   )
 
 deleteOwn :: UserId -> PaymentId -> Query Bool
-deleteOwn paymentUserId paymentId =
+deleteOwn userId paymentId =
   Query (\conn -> do
     mbPayment <- listToMaybe <$>
       SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
     case mbPayment of
       Just payment ->
-        if userId payment == paymentUserId
+        if _payment_user payment == userId
           then do
             now <- getCurrentTime
             SQLite.execute
diff --git a/src/server/Model/PaymentCategory.hs b/src/server/Model/PaymentCategory.hs
index 7c504dc..6e1d304 100644
--- a/src/server/Model/PaymentCategory.hs
+++ b/src/server/Model/PaymentCategory.hs
@@ -1,35 +1,23 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.PaymentCategory
-  ( PaymentCategoryId
-  , PaymentCategory(..)
-  , list
+  ( list
   , listByCategory
   , save
   ) where
 
-import Data.Int (Int64)
 import Data.Maybe (isJust, listToMaybe)
 import Data.Text (Text)
-import Data.Time (UTCTime)
 import Data.Time.Clock (getCurrentTime)
 import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
 import qualified Data.Text as T
 import qualified Database.SQLite.Simple as SQLite
 
-import Model.Category (CategoryId)
-import Model.Query (Query(Query))
-import qualified Utils.Text as T
-
-type PaymentCategoryId = Int64
+import Common.Model (CategoryId, PaymentCategory(..))
+import qualified Common.Util.Text as T
 
-data PaymentCategory = PaymentCategory
-  { id :: PaymentCategoryId
-  , name :: Text
-  , category :: CategoryId
-  , createdAt :: UTCTime
-  , editedAt :: Maybe UTCTime
-  } deriving Show
+import Model.Query (Query(Query))
 
 instance FromRow PaymentCategory where
   fromRow = PaymentCategory <$>
diff --git a/src/server/Model/User.hs b/src/server/Model/User.hs
index c8a0d53..eb78a69 100644
--- a/src/server/Model/User.hs
+++ b/src/server/Model/User.hs
@@ -1,35 +1,23 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.User
-  ( UserId
-  , User(..)
-  , list
-  , getUser
-  , findUser
+  ( list
+  , get
   , createUser
   , deleteUser
   ) where
 
-import Data.Int (Int64)
-import Data.List (find)
 import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
-import Data.Time.Clock (UTCTime)
 import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
 import Prelude hiding (id)
 import qualified Database.SQLite.Simple as SQLite
 
-import Model.Query (Query(Query))
-
-type UserId = Int64
+import Common.Model (UserId, User(..))
 
-data User = User
-  { id :: UserId
-  , creation :: UTCTime
-  , email :: Text
-  , name :: Text
-  } deriving Show
+import Model.Query (Query(Query))
 
 instance FromRow User where
   fromRow = User <$> SQLite.field <*> SQLite.field <*> SQLite.field <*> SQLite.field
@@ -37,15 +25,12 @@ instance FromRow User where
 list :: Query [User]
 list = Query (\conn -> SQLite.query_ conn "SELECT * from user ORDER BY creation DESC")
 
-getUser :: Text -> Query (Maybe User)
-getUser userEmail =
+get :: Text -> Query (Maybe User)
+get userEmail =
   Query (\conn -> listToMaybe <$>
     SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
   )
 
-findUser :: UserId -> [User] -> Maybe User
-findUser userId = find ((==) userId . id)
-
 createUser :: Text -> Text -> Query UserId
 createUser userEmail userName =
   Query (\conn -> do
diff --git a/src/server/Secure.hs b/src/server/Secure.hs
index da48878..f427304 100644
--- a/src/server/Secure.hs
+++ b/src/server/Secure.hs
@@ -11,11 +11,12 @@ import Data.Text.Lazy (fromStrict)
 import Network.HTTP.Types.Status (forbidden403)
 import Web.Scotty
 
-import Model.Message (getMessage)
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import Common.Model (User)
+
 import Model.Query (Query)
-import Model.User (User)
 import qualified LoginSession
-import qualified Model.Message.Key as Key
 import qualified Model.Query as Query
 import qualified Model.SignIn as SignIn
 import qualified Model.User as User
@@ -31,16 +32,16 @@ loggedAction action = do
           action user
         Nothing -> do
           status forbidden403
-          html . fromStrict . getMessage $ Key.UnauthorizedSignIn
+          html . fromStrict . Message.get $ Key.Secure_Unauthorized
     Nothing -> do
       status forbidden403
-      html . fromStrict . getMessage $ Key.Forbidden
+      html . fromStrict . Message.get $ Key.Secure_Forbidden
 
 getUserFromToken :: Text -> Query (Maybe User)
 getUserFromToken token = do
   mbSignIn <- SignIn.getSignIn token
   case mbSignIn of
     Just signIn ->
-      User.getUser (SignIn.email signIn)
+      User.get (SignIn.email signIn)
     Nothing ->
       return Nothing
diff --git a/src/server/Utils/Text.hs b/src/server/Utils/Text.hs
deleted file mode 100644
index 5ed77e4..0000000
--- a/src/server/Utils/Text.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-module Utils.Text
-  ( unaccent
-  ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-unaccent :: Text -> Text
-unaccent = T.map unaccentChar
-
-unaccentChar :: Char -> Char
-unaccentChar c = case c of
-  'à' -> 'a'
-  'á' -> 'a'
-  'â' -> 'a'
-  'ã' -> 'a'
-  'ä' -> 'a'
-  'ç' -> 'c'
-  'è' -> 'e'
-  'é' -> 'e'
-  'ê' -> 'e'
-  'ë' -> 'e'
-  'ì' -> 'i'
-  'í' -> 'i'
-  'î' -> 'i'
-  'ï' -> 'i'
-  'ñ' -> 'n'
-  'ò' -> 'o'
-  'ó' -> 'o'
-  'ô' -> 'o'
-  'õ' -> 'o'
-  'ö' -> 'o'
-  'š' -> 's'
-  'ù' -> 'u'
-  'ú' -> 'u'
-  'û' -> 'u'
-  'ü' -> 'u'
-  'ý' -> 'y'
-  'ÿ' -> 'y'
-  'ž' -> 'z'
-  _ -> c
diff --git a/src/server/Utils/Time.hs b/src/server/Utils/Time.hs
index 4a247e9..97457c7 100644
--- a/src/server/Utils/Time.hs
+++ b/src/server/Utils/Time.hs
@@ -2,7 +2,6 @@ module Utils.Time
   ( belongToCurrentMonth
   , belongToCurrentWeek
   , timeToDay
-  , monthToKey
   ) where
 
 import Data.Time.Clock (UTCTime, getCurrentTime)
@@ -10,9 +9,6 @@ import Data.Time.LocalTime
 import Data.Time.Calendar
 import Data.Time.Calendar.WeekDate (toWeekDate)
 
-import Model.Message.Key (Key)
-import qualified Model.Message.Key as K
-
 belongToCurrentMonth :: UTCTime -> IO Bool
 belongToCurrentMonth time = do
   (timeYear, timeMonth, _) <- toGregorian <$> timeToDay time
@@ -27,18 +23,3 @@ belongToCurrentWeek time = do
 
 timeToDay :: UTCTime -> IO Day
 timeToDay time = localDay . (flip utcToLocalTime time) <$> getTimeZone time
-
-monthToKey :: Int -> Maybe Key
-monthToKey 1  = Just K.January
-monthToKey 2  = Just K.February
-monthToKey 3  = Just K.March
-monthToKey 4  = Just K.April
-monthToKey 5  = Just K.May
-monthToKey 6  = Just K.June
-monthToKey 7  = Just K.July
-monthToKey 8  = Just K.August
-monthToKey 9  = Just K.September
-monthToKey 10 = Just K.October
-monthToKey 11 = Just K.November
-monthToKey 12 = Just K.December
-monthToKey _ = Nothing
diff --git a/src/server/View/Format.hs b/src/server/View/Format.hs
deleted file mode 100644
index 354d46a..0000000
--- a/src/server/View/Format.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module View.Format
-  ( price
-  ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.List (intersperse)
-
-import Conf (Conf)
-import qualified Conf
-
-price :: Conf -> Int -> Text
-price conf amount = T.concat [number amount, " ", Conf.currency conf]
-
-number :: Int -> Text
-number n =
-  T.pack
-  . (++) (if n < 0 then "-" else "")
-  . reverse
-  . concat
-  . intersperse " "
-  . group 3
-  . reverse
-  . show
-  . abs $ n
-
-group :: Int -> [a] -> [[a]]
-group n xs =
-  if length xs <= n
-    then [xs]
-    else (take n xs) : (group n (drop n xs))
diff --git a/src/server/View/Mail/SignIn.hs b/src/server/View/Mail/SignIn.hs
index c7d40d8..12c4f34 100644
--- a/src/server/View/Mail/SignIn.hs
+++ b/src/server/View/Mail/SignIn.hs
@@ -6,10 +6,11 @@ module View.Mail.SignIn
 
 import Data.Text (Text)
 
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import Common.Model.User (User(..))
+
 import Conf (Conf)
-import Model.Message
-import Model.Message.Key
-import Model.User (User(..))
 import qualified Conf as Conf
 import qualified Model.Mail as M
 
@@ -18,6 +19,6 @@ mail conf user url to =
   M.Mail
     { M.from = Conf.noReplyMail conf
     , M.to = to
-    , M.subject = (getMessage SignInMailTitle)
-    , M.plainBody = getParamMessage [name user, url] SignInMail
+    , M.subject = Message.get Key.SignIn_MailTitle
+    , M.plainBody = Message.get (Key.SignIn_MailBody (_user_name user) url)
     }
diff --git a/src/server/View/Mail/WeeklyReport.hs b/src/server/View/Mail/WeeklyReport.hs
index 1a80b95..0bafb70 100644
--- a/src/server/View/Mail/WeeklyReport.hs
+++ b/src/server/View/Mail/WeeklyReport.hs
@@ -9,38 +9,34 @@ import Data.Map (Map)
 import Data.Maybe (catMaybes, fromMaybe)
 import Data.Monoid ((<>))
 import Data.Text (Text)
-import Data.Time.Calendar (Day, toGregorian)
 import Data.Time.Clock (UTCTime)
 import qualified Data.Map as M
 import qualified Data.Text as T
 
-import Resource (Status(..), groupByStatus, statuses)
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import Common.Model (Payment(..), User(..), UserId, Income(..))
+import qualified Common.Model.User as User
+import qualified Common.View.Format as Format
 
-import Model.Income (Income)
 import Model.Mail (Mail(Mail))
-import Model.Message (getMessage, getParamMessage, plural)
-import Model.Payment (Payment)
-import Model.User (findUser)
-import Model.User (User, UserId)
-import qualified Model.Income as Income
+import Model.Payment ()
+import qualified Model.Income ()
 import qualified Model.Mail as M
-import qualified Model.Message.Key as K
-import qualified Model.Payment as Payment
-import qualified Model.User as User
-
+import Resource (Status(..), groupByStatus, statuses)
 import Conf (Conf)
 import qualified Conf as Conf
 
-import qualified View.Format as Format
-
-import Utils.Time (monthToKey)
-
 mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
 mail conf users payments incomes start end =
   Mail
     { M.from = Conf.noReplyMail conf
-    , M.to = map User.email users
-    , M.subject = T.concat [getMessage K.SharedCost, " − ", getMessage K.WeeklyReport]
+    , M.to = map _user_email users
+    , M.subject = T.concat
+        [ Message.get Key.App_Title
+        , " − "
+        , Message.get Key.WeeklyReport_Title
+        ]
     , M.plainBody = body conf users (groupByStatus start end payments) (groupByStatus start end incomes)
     }
 
@@ -48,7 +44,7 @@ body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
 body conf users paymentsByStatus incomesByStatus =
   if M.null paymentsByStatus && M.null incomesByStatus
     then
-      getMessage K.WeeklyReportEmpty
+      Message.get Key.WeeklyReport_Empty
     else
       T.intercalate "\n" . catMaybes . concat $
         [ map (\s -> paymentSection s conf users <$> M.lookup s paymentsByStatus) statuses
@@ -57,65 +53,45 @@ body conf users paymentsByStatus incomesByStatus =
 
 paymentSection :: Status -> Conf -> [User] -> [Payment] -> Text
 paymentSection status conf users payments =
-  section
-    (plural (length payments) singleKey pluralKey)
-    (map (payedFor status conf users) . sortOn Payment.date $ payments)
-  where (singleKey, pluralKey) =
-          case status of
-            Created -> (K.PaymentCreated, K.PaymentsCreated)
-            Edited -> (K.PaymentEdited, K.PaymentsEdited)
-            Deleted -> (K.PaymentDeleted, K.PaymentsDeleted)
+  section sectionTitle sectionItems
+  where count = length payments
+        sectionTitle = Message.get $ case status of
+          Created -> if count > 1 then Key.WeeklyReport_PaymentsCreated count else Key.WeeklyReport_PaymentCreated count
+          Edited -> if count > 1 then Key.WeeklyReport_PaymentsEdited count else Key.WeeklyReport_PaymentEdited count
+          Deleted -> if count > 1 then Key.WeeklyReport_PaymentsDeleted count else Key.WeeklyReport_PaymentDeleted count
+        sectionItems = map (payedFor status conf users) . sortOn _payment_date $ payments
 
 payedFor :: Status -> Conf -> [User] -> Payment -> Text
 payedFor status conf users payment =
-  getParamMessage
-    [ formatUserName (Payment.userId payment) users
-    , Format.price conf . Payment.cost $ payment
-    , Payment.name payment
-    , formatDay $ Payment.date payment
-    ]
-    ( case status of
-        Created -> K.PayedFor
-        Edited -> K.PayedFor
-        Deleted -> K.DidNotPayFor
-    )
+  case status of
+    Deleted -> Message.get (Key.WeeklyReport_PayedForNot name amount for at)
+    _ -> Message.get (Key.WeeklyReport_PayedFor name amount for at)
+  where name = formatUserName (_payment_user payment) users
+        amount = Format.price (Conf.currency conf) . _payment_cost $ payment
+        for = _payment_name payment
+        at = Format.longDay $ _payment_date payment
 
 incomeSection :: Status -> Conf -> [User] -> [Income] -> Text
 incomeSection status conf users incomes =
-  section
-    (plural (length incomes) singleKey pluralKey)
-    (map (isPayedFrom status conf users) . sortOn Income.date $ incomes)
-  where (singleKey, pluralKey) =
-          case status of
-            Created -> (K.IncomeCreated, K.IncomesCreated)
-            Edited -> (K.IncomeEdited, K.IncomesEdited)
-            Deleted -> (K.IncomeDeleted, K.IncomesDeleted)
+  section sectionTitle sectionItems
+  where count = length incomes
+        sectionTitle = Message.get $ case status of
+          Created -> if count > 1 then Key.WeeklyReport_IncomesCreated count else Key.WeeklyReport_IncomeCreated count
+          Edited -> if count > 1 then Key.WeeklyReport_IncomesEdited count else Key.WeeklyReport_IncomeEdited count
+          Deleted -> if count > 1 then Key.WeeklyReport_IncomesDeleted count else Key.WeeklyReport_IncomeDeleted count
+        sectionItems = map (isPayedFrom status conf users) . sortOn _income_date $ incomes
 
 isPayedFrom :: Status -> Conf -> [User] -> Income -> Text
 isPayedFrom status conf users income =
-  getParamMessage
-    [ formatUserName (Income.userId income) users
-    , Format.price conf . Income.amount $ income
-    , formatDay $ Income.date income
-    ]
-    ( case status of
-        Created -> K.IsPayedFrom
-        Edited -> K.IsPayedFrom
-        Deleted -> K.IsNotPayedFrom
-    )
+  case status of
+    Deleted -> Message.get (Key.WeeklyReport_PayedFromNot name amount for)
+    _ -> Message.get (Key.WeeklyReport_PayedFrom name amount for)
+  where name = formatUserName (_income_userId income) users
+        amount = Format.price (Conf.currency conf) . _income_amount $ income
+        for = Format.longDay $ _income_date income
 
 formatUserName :: UserId -> [User] -> Text
-formatUserName userId = fromMaybe "−" . fmap User.name . findUser userId
-
-formatDay :: Day -> Text
-formatDay d =
-  let (year, month, day) = toGregorian d
-  in  getParamMessage
-      [ T.pack . show $ day
-      , fromMaybe "−" . fmap getMessage . monthToKey $ month
-      , T.pack . show $ year
-      ]
-      K.LongDate
+formatUserName userId = fromMaybe "−" . fmap _user_name . User.find userId
 
 section :: Text -> [Text] -> Text
 section title items =
diff --git a/src/server/View/Page.hs b/src/server/View/Page.hs
index 5a2e4f8..1c072a4 100644
--- a/src/server/View/Page.hs
+++ b/src/server/View/Page.hs
@@ -16,29 +16,24 @@ import Text.Blaze.Html5.Attributes
 import qualified Text.Blaze.Html5.Attributes as A
 import Text.Blaze.Html.Renderer.Text (renderHtml)
 
-import Design.Global (globalDesign)
+import qualified Common.Message as Message
+import Common.Model.InitResult (InitResult)
+import qualified Common.Message.Key as Key
 
-import Model.Message
-import Model.Json.Conf
-import Model.Json.Init (InitResult)
-import Model.Message.Key (Key(SharedCost))
+import Design.Global (globalDesign)
 
-page :: Conf -> InitResult -> Text
-page conf initResult =
+page :: InitResult -> Text
+page initResult =
   renderHtml . docTypeHtml $ do
     H.head $ do
       meta ! charset "UTF-8"
       meta ! name "viewport" ! content "width=device-width, initial-scale=1, maximum-scale=1, user-scalable=0"
-      H.title (toHtml $ getMessage SharedCost)
-      script ! src "javascripts/client.js" $ ""
-      jsonScript "translations" getTranslations
-      jsonScript "conf" conf
-      jsonScript "result" initResult
+      H.title (toHtml $ Message.get Key.App_Title)
+      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"
       H.style $ toHtml globalDesign
-    body $ do
-      script ! src "javascripts/main.js" $ ""
 
 jsonScript :: Json.ToJSON a => Text -> a -> Html
 jsonScript scriptId json =