Replace persistent by sqlite-simple

37 files changed, 868 insertions, 659 deletions

diff --git a/src/migrations/1.sql b/src/migrations/1.sql
new file mode 100644
index 0000000..d7c300e
--- /dev/null
+++ b/src/migrations/1.sql
@@ -0,0 +1,65 @@
+CREATE TABLE IF NOT EXISTS "user" (
+  "id" INTEGER PRIMARY KEY,
+  "creation" TIMESTAMP NOT NULL,
+  "email" VARCHAR NOT NULL,
+  "name" VARCHAR NOT NULL,
+  CONSTRAINT "uniq_user_email" UNIQUE ("email"),
+  CONSTRAINT "uniq_user_name" UNIQUE ("name")
+);
+
+CREATE TABLE IF NOT EXISTS "job" (
+  "id" INTEGER PRIMARY KEY,
+  "kind" VARCHAR NOT NULL,
+  "last_execution" TIMESTAMP NULL,
+  "last_check" TIMESTAMP NULL,
+  CONSTRAINT "uniq_job_kind" UNIQUE ("kind")
+);
+
+CREATE TABLE IF NOT EXISTS "sign_in"(
+  "id" INTEGER PRIMARY KEY,
+  "token" VARCHAR NOT NULL,
+  "creation" TIMESTAMP NOT NULL,
+  "email" VARCHAR NOT NULL,
+  "is_used" BOOLEAN NOT NULL,
+  CONSTRAINT "uniq_sign_in_token" UNIQUE ("token")
+);
+
+CREATE TABLE IF NOT EXISTS "payment"(
+  "id" INTEGER PRIMARY KEY,
+  "user_id" INTEGER NOT NULL REFERENCES "user",
+  "name" VARCHAR NOT NULL,
+  "cost" INTEGER NOT NULL,
+  "date" DATE NOT NULL,
+  "frequency" VARCHAR NOT NULL,
+  "created_at" TIMESTAMP NOT NULL,
+  "edited_at" TIMESTAMP NULL,
+  "deleted_at" TIMESTAMP NULL
+);
+
+CREATE TABLE IF NOT EXISTS "income"(
+  "id" INTEGER PRIMARY KEY,
+  "user_id" INTEGER NOT NULL REFERENCES "user",
+  "date" DATE NOT NULL,
+  "amount" INTEGERNOT NULL,
+  "created_at" TIMESTAMP NOT NULL,
+  "edited_at" TIMESTAMP NULL,
+  "deleted_at" TIMESTAMP NULL
+);
+
+CREATE TABLE IF NOT EXISTS "category"(
+  "id" INTEGER PRIMARY KEY,
+  "name" VARCHAR NOT NULL,
+  "color" VARCHAR NOT NULL,
+  "created_at" TIMESTAMP NOT NULL,
+  "edited_at" TIMESTAMP NULL,
+  "deleted_at" TIMESTAMP NULL
+);
+
+CREATE TABLE IF NOT EXISTS "payment_category"(
+  "id" INTEGER PRIMARY KEY,
+  "name" VARCHAR NOT NULL,
+  "category" INTEGER NOT NULL REFERENCES "category",
+  "created_at" TIMESTAMP NOT NULL,
+  "edited_at" TIMESTAMP NULL,
+  CONSTRAINT "uniq_payment_category_name" UNIQUE ("name")
+);
diff --git a/src/server/Controller/Category.hs b/src/server/Controller/Category.hs
index 19109a3..3f800da 100644
--- a/src/server/Controller/Category.hs
+++ b/src/server/Controller/Category.hs
@@ -7,43 +7,42 @@ module Controller.Category
   ) where
 
 import Control.Monad.IO.Class (liftIO)
-
-import Data.Text (Text)
 import Network.HTTP.Types.Status (ok200, badRequest400)
 import qualified Data.Text.Lazy as TL
 import Web.Scotty hiding (delete)
 
 import Json (jsonId)
-import Model.Database
+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
 
 create :: Json.CreateCategory -> ActionM ()
 create (Json.CreateCategory name color) =
   Secure.loggedAction (\_ ->
-    (liftIO . runDb $ Category.create name color) >>= jsonId
+    (liftIO . Query.run $ Category.create name color) >>= jsonId
   )
 
 edit :: Json.EditCategory -> ActionM ()
 edit (Json.EditCategory categoryId name color) =
   Secure.loggedAction (\_ -> do
-    updated <- liftIO . runDb $ Category.edit categoryId name color
+    updated <- liftIO . Query.run $ Category.edit categoryId name color
     if updated
       then status ok200
       else status badRequest400
   )
 
-delete :: Text -> ActionM ()
+delete :: CategoryId -> ActionM ()
 delete categoryId =
   Secure.loggedAction (\_ -> do
-    deleted <- liftIO . runDb $ do
-      paymentCategories <- PaymentCategory.listByCategory (textToKey categoryId)
+    deleted <- liftIO . Query.run $ do
+      paymentCategories <- PaymentCategory.listByCategory categoryId
       if null paymentCategories
-        then Category.delete (textToKey categoryId)
+        then Category.delete categoryId
         else return False
     if deleted
       then
diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs
index ff3e75d..18394d0 100644
--- a/src/server/Controller/Income.hs
+++ b/src/server/Controller/Income.hs
@@ -6,46 +6,40 @@ module Controller.Income
   , deleteOwn
   ) where
 
-import Web.Scotty
-
-import Network.HTTP.Types.Status (ok200, badRequest400)
-
 import Control.Monad.IO.Class (liftIO)
-
-import Database.Persist
-
-import Data.Text (Text)
+import Network.HTTP.Types.Status (ok200, badRequest400)
 import qualified Data.Text.Lazy as TL
-
-import qualified Secure
+import Web.Scotty
 
 import Json (jsonId)
-
-import Model.Database
+import Model.Income (IncomeId)
 import qualified Model.Income as Income
-import qualified Model.Message.Key as Key
 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) =
   Secure.loggedAction (\user ->
-    (liftIO . runDb $ Income.create (entityKey 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) =
   Secure.loggedAction (\user -> do
-    updated <- liftIO . runDb $ Income.editOwn (entityKey user) incomeId date amount
+    updated <- liftIO . Query.run $ Income.editOwn (User.id user) incomeId date amount
     if updated
       then status ok200
       else status badRequest400
   )
 
-deleteOwn :: Text -> ActionM ()
+deleteOwn :: IncomeId -> ActionM ()
 deleteOwn incomeId =
   Secure.loggedAction (\user -> do
-    deleted <- liftIO . runDb $ Income.deleteOwn user (textToKey incomeId)
+    deleted <- liftIO . Query.run $ Income.deleteOwn user incomeId
     if deleted
       then
         status ok200
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
index 96d0a49..9fb2aa0 100644
--- a/src/server/Controller/Index.hs
+++ b/src/server/Controller/Index.hs
@@ -4,28 +4,22 @@ module Controller.Index
   ) where
 
 import Control.Monad.IO.Class (liftIO)
-
-import Web.Scotty hiding (get)
-
-import Network.HTTP.Types.Status (ok200)
-
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime, diffUTCTime)
-
-import Database.Persist hiding (Key, get)
+import Network.HTTP.Types.Status (ok200)
+import Web.Scotty hiding (get)
 
 import Conf (Conf(..))
+import Model.Init (getInit)
+import Model.Json.Init (InitResult(..))
+import Model.Message.Key
+import Model.User (User)
 import qualified LoginSession
-import Secure (getUserFromToken)
-
-import Model.Database hiding (Key)
 import qualified Model.Json.Conf as M
-import Model.User (getUser)
-import Model.Message.Key
-import Model.SignIn (getSignIn, signInTokenToUsed)
-import Model.Json.Init (InitResult(..))
-import Model.Init (getInit)
-
+import qualified Model.Query as Query
+import qualified Model.SignIn as SignIn
+import qualified Model.User as User
+import Secure (getUserFromToken)
 import View.Page (page)
 
 get :: Conf -> Maybe Text -> ActionM ()
@@ -37,54 +31,54 @@ get conf mbToken = do
         Left errorKey ->
           return . InitError $ errorKey
         Right user ->
-          liftIO . runDb . fmap InitSuccess . getInit $ user
+          liftIO . Query.run . fmap InitSuccess . getInit $ user
     Nothing -> do
       mbLoggedUser <- getLoggedUser
       case mbLoggedUser of
         Nothing ->
           return InitEmpty
         Just user ->
-          liftIO . runDb . fmap InitSuccess . getInit $ user
+          liftIO . Query.run . fmap InitSuccess . getInit $ user
   html $ page (M.Conf { M.currency = currency conf }) initResult
 
-validateSignIn :: Conf -> Text -> ActionM (Either Key (Entity User))
+validateSignIn :: Conf -> Text -> ActionM (Either Key User)
 validateSignIn conf textToken = do
   mbLoggedUser <- getLoggedUser
   case mbLoggedUser of
     Just loggedUser ->
       return . Right $ loggedUser
     Nothing -> do
-      mbSignIn <- liftIO . runDb $ getSignIn textToken
+      mbSignIn <- liftIO . Query.run $ SignIn.getSignIn textToken
       now <- liftIO getCurrentTime
       case mbSignIn of
         Nothing ->
           return . Left $ SignInInvalid
-        Just signInValue ->
-          if signInIsUsed . entityVal $ signInValue
+        Just signIn ->
+          if SignIn.isUsed signIn
             then
               return . Left $ SignInUsed
             else
-              let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signInValue)
+              let diffTime = now `diffUTCTime` (SignIn.creation signIn)
               in  if diffTime > signInExpiration conf
                     then
                       return . Left $ SignInExpired
                     else do
-                      LoginSession.put conf (signInToken . entityVal $ signInValue)
-                      mbUser <- liftIO . runDb $ do
-                        signInTokenToUsed . entityKey $ signInValue
-                        getUser . signInEmail . entityVal $ signInValue
+                      LoginSession.put conf (SignIn.token signIn)
+                      mbUser <- liftIO . Query.run $ do
+                        SignIn.signInTokenToUsed . SignIn.id $ signIn
+                        User.getUser . SignIn.email $ signIn
                       return $ case mbUser of
                         Nothing -> Left UnauthorizedSignIn
                         Just user -> Right user
 
-getLoggedUser :: ActionM (Maybe (Entity User))
+getLoggedUser :: ActionM (Maybe User)
 getLoggedUser = do
   mbToken <- LoginSession.get
   case mbToken of
     Nothing ->
       return Nothing
     Just token -> do
-      liftIO . runDb . getUserFromToken $ token
+      liftIO . Query.run . getUserFromToken $ token
 
 signOut :: Conf -> ActionM ()
 signOut conf = LoginSession.delete conf >> status ok200
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 831abbf..d71b451 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -8,40 +8,40 @@ module Controller.Payment
   ) where
 
 import Control.Monad.IO.Class (liftIO)
-
-import Data.Text (Text)
-import Database.Persist
 import Network.HTTP.Types.Status (ok200, badRequest400)
 import Web.Scotty
 
 import Json (jsonId)
-import Model.Database
+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 $ runDb Payment.list) >>= json
+    (liftIO . Query.run $ map Json.fromPayment <$> Payment.list) >>= json
   )
 
 create :: Json.CreatePayment -> ActionM ()
 create (Json.CreatePayment name cost date category frequency) =
   Secure.loggedAction (\user ->
-    (liftIO . runDb $ do
+    (liftIO . Query.run $ do
       PaymentCategory.save name category
-      Payment.create (entityKey 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) =
   Secure.loggedAction (\user -> do
-    updated <- liftIO . runDb $ do
-      edited <- Payment.editOwn (entityKey user) paymentId name cost date frequency
+    updated <- liftIO . Query.run $ do
+      edited <- Payment.editOwn (User.id user) paymentId name cost date frequency
       _ <- if edited
         then PaymentCategory.save name category >> return ()
         else return ()
@@ -51,10 +51,10 @@ editOwn (Json.EditPayment paymentId name cost date category frequency) =
       else status badRequest400
   )
 
-deleteOwn :: Text -> ActionM ()
+deleteOwn :: PaymentId -> ActionM ()
 deleteOwn paymentId =
   Secure.loggedAction (\user -> do
-    deleted <- liftIO . runDb $ Payment.deleteOwn (entityKey user) (textToKey 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 1b8121d..152168c 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -4,48 +4,39 @@ module Controller.SignIn
   ( signIn
   ) where
 
-import Web.Scotty
-
-import Network.HTTP.Types.Status (ok200, badRequest400)
-
-import Database.Persist hiding (Key)
-
 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.Lazy as TL
 import qualified Data.Text.Encoding as TE
+import qualified Data.Text.Lazy as TL
+import Web.Scotty
 
 import Conf (Conf)
-import qualified Conf
-
-import SendMail
-
-import Text.Email.Validate as Email
-
-import Model.Database
-import Model.User
-import Model.SignIn
 import Model.Message.Key
-
+import qualified Conf
+import qualified Model.Query as Query
+import qualified Model.SignIn as SignIn
+import qualified Model.User as User
+import qualified SendMail
+import qualified Text.Email.Validate as Email
 import qualified View.Mail.SignIn as SignIn
 
 signIn :: Conf -> Text -> ActionM ()
 signIn conf login =
   if Email.isValid (TE.encodeUtf8 login)
     then do
-      maybeUser <- liftIO . runDb $ getUser login
+      maybeUser <- liftIO . Query.run $ User.getUser login
       case maybeUser of
         Just user -> do
-          token <- liftIO . runDb $ createSignInToken login
+          token <- liftIO . Query.run $ SignIn.createSignInToken login
           let url = T.concat [
                       if Conf.https conf then "https://" else "http://",
                       Conf.hostname conf,
                       "?signInToken=",
                       token
                     ]
-          maybeSentMail <- liftIO . sendMail $ SignIn.mail conf (entityVal user) url [login]
+          maybeSentMail <- liftIO . SendMail.sendMail $ SignIn.mail conf user url [login]
           case maybeSentMail of
             Right _ ->
               status ok200
diff --git a/src/server/Job/Daemon.hs b/src/server/Job/Daemon.hs
index 8259b18..0bc6f6e 100644
--- a/src/server/Job/Daemon.hs
+++ b/src/server/Job/Daemon.hs
@@ -2,21 +2,17 @@ module Job.Daemon
   ( runDaemons
   ) where
 
-import Data.Time.Clock (UTCTime)
-
 import Control.Concurrent (threadDelay, forkIO, ThreadId)
 import Control.Monad (forever)
+import Data.Time.Clock (UTCTime)
 
-import Model.Database
-
-import Job.Kind (Kind(..))
+import Conf (Conf)
 import Job.Frequency (Frequency(..), microSeconds)
+import Job.Kind (Kind(..))
 import Job.Model (getLastExecution, actualizeLastCheck, actualizeLastExecution)
 import Job.MonthlyPayment (monthlyPayment)
 import Job.WeeklyReport (weeklyReport)
-
-import Conf (Conf)
-
+import qualified Model.Query as Query
 import Utils.Time (belongToCurrentMonth, belongToCurrentWeek)
 
 runDaemons :: Conf -> IO ()
@@ -28,13 +24,13 @@ runDaemons conf = do
 runDaemon :: Kind -> Frequency -> (UTCTime -> IO Bool) -> (Maybe UTCTime -> IO UTCTime) -> IO ThreadId
 runDaemon kind frequency isLastExecutionTooOld runJob =
   forkIO . forever $ do
-    mbLastExecution <- runDb $ do
+    mbLastExecution <- Query.run $ do
       actualizeLastCheck kind
       getLastExecution kind
     hasToRun <- case mbLastExecution of
       Just lastExecution -> isLastExecutionTooOld lastExecution
       Nothing -> return True
     if hasToRun
-      then runJob mbLastExecution >>= (runDb . actualizeLastExecution kind)
+      then runJob mbLastExecution >>= (Query.run . actualizeLastExecution kind)
       else return ()
     threadDelay . microSeconds $ frequency
diff --git a/src/server/Job/Kind.hs b/src/server/Job/Kind.hs
index 473b7c4..af5d4f8 100644
--- a/src/server/Job/Kind.hs
+++ b/src/server/Job/Kind.hs
@@ -1,14 +1,22 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 module Job.Kind
   ( Kind(..)
   ) where
 
-import Database.Persist.TH
+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 qualified Data.Text as T
 
 data Kind =
   MonthlyPayment
   | WeeklyReport
   deriving (Eq, Show, Read)
 
-derivePersistField "Kind"
+instance FromField Kind where
+  fromField field = case fieldData field of
+    SQLText text -> Ok (read (T.unpack text) :: Kind)
+    _ -> Errors [error "SQLText field required for job kind"]
+
+instance ToField Kind where
+  toField kind = SQLText . T.pack . show $ kind
diff --git a/src/server/Job/Model.hs b/src/server/Job/Model.hs
index cd7297a..e1a3c77 100644
--- a/src/server/Job/Model.hs
+++ b/src/server/Job/Model.hs
@@ -1,33 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Job.Model
-  ( getLastExecution
+  ( Job(..)
+  , getLastExecution
   , actualizeLastExecution
   , actualizeLastCheck
   ) where
 
-import Control.Monad.IO.Class (liftIO)
-
-import Data.Time.Clock (UTCTime, getCurrentTime)
 import Data.Maybe (isJust)
-
-import Database.Persist
-
-import Model.Database
+import Data.Time.Clock (UTCTime, getCurrentTime)
+import Database.SQLite.Simple (Only(Only))
+import qualified Database.SQLite.Simple as SQLite
+import Prelude hiding (id)
 
 import Job.Kind
-
-getLastExecution :: Kind -> Persist (Maybe UTCTime)
-getLastExecution kind = do
-  mbJob <- fmap entityVal <$> selectFirst [JobKind ==. kind] []
-  return (mbJob >>= jobLastExecution)
-
-actualizeLastExecution :: Kind -> UTCTime -> Persist ()
-actualizeLastExecution kind time = do
-  jobKindDefined <- isJust <$> selectFirst [JobKind ==. kind] []
-  if jobKindDefined
-    then updateWhere [JobKind ==. kind] [JobLastExecution =. Just time]
-    else insert (Job kind (Just time) (Just time)) >> return ()
-
-actualizeLastCheck :: Kind -> Persist ()
-actualizeLastCheck kind = do
-  now <- liftIO getCurrentTime
-  updateWhere [JobKind ==. kind] [JobLastCheck =. Just now]
+import Model.Query (Query(Query))
+
+data Job = Job
+  { id :: String
+  , kind :: Kind
+  , lastExecution :: Maybe UTCTime
+  , lastCheck :: Maybe UTCTime
+  } deriving (Show)
+
+getLastExecution :: Kind -> Query (Maybe UTCTime)
+getLastExecution jobKind =
+  Query (\conn -> do
+    [Only time] <- SQLite.query conn "SELECT last_execution FROM job WHERE kind = ?" (Only jobKind) :: IO [Only (Maybe UTCTime)]
+    return time
+  )
+
+actualizeLastExecution :: Kind -> UTCTime -> Query ()
+actualizeLastExecution jobKind time =
+  Query (\conn -> do
+    [Only result] <- SQLite.query conn "SELECT 1 FROM job WHERE kind = ?" (Only jobKind) :: IO [Only (Maybe Int)]
+    if isJust result
+      then SQLite.execute conn "UPDATE job SET last_execution = ? WHERE kind = ?" (time, jobKind)
+      else SQLite.execute conn "INSERT INTO job (kind, last_execution, last_check) VALUES (?, ?, ?)" (jobKind, time, time)
+  )
+
+actualizeLastCheck :: Kind -> Query ()
+actualizeLastCheck jobKind =
+  Query (\conn -> do
+    now <- getCurrentTime
+    SQLite.execute conn "UPDATE job SET kind = ? WHERE last_check = ?" (jobKind, now)
+  )
diff --git a/src/server/Job/MonthlyPayment.hs b/src/server/Job/MonthlyPayment.hs
index bac7062..8c11ccf 100644
--- a/src/server/Job/MonthlyPayment.hs
+++ b/src/server/Job/MonthlyPayment.hs
@@ -2,23 +2,18 @@ module Job.MonthlyPayment
   ( monthlyPayment
   ) where
 
-import Control.Monad.IO.Class (liftIO)
-
 import Data.Time.Clock (UTCTime, getCurrentTime)
 
-import Database.Persist (entityVal, insert)
-
-import Model.Database
-import qualified Model.Payment as Payment
 import Model.Frequency
-
+import qualified Model.Payment as Payment
 import Utils.Time (timeToDay)
+import qualified Model.Query as Query
 
 monthlyPayment :: Maybe UTCTime -> IO UTCTime
-monthlyPayment _ = runDb $ do
-  monthlyPayments <- map entityVal <$> Payment.listMonthly
-  now <- liftIO $ getCurrentTime
-  actualDay <- liftIO $ timeToDay now
-  let punctualPayments = map (\p -> p { paymentFrequency = Punctual, paymentDate = actualDay, paymentCreatedAt = now }) monthlyPayments
-  _ <- sequence $ map insert punctualPayments
+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
+  _ <- Query.run (Payment.createMany punctualPayments)
   return now
diff --git a/src/server/Job/WeeklyReport.hs b/src/server/Job/WeeklyReport.hs
index 5cde3e9..5737c75 100644
--- a/src/server/Job/WeeklyReport.hs
+++ b/src/server/Job/WeeklyReport.hs
@@ -4,16 +4,13 @@ module Job.WeeklyReport
 
 import Data.Time.Clock (UTCTime, getCurrentTime)
 
-import Model.Database (runDb)
-import qualified Model.Payment as Payment
+import Conf (Conf)
 import qualified Model.Income as Income
+import qualified Model.Payment as Payment
+import qualified Model.Query as Query
 import qualified Model.User as User
-
-import SendMail
-
-import Conf (Conf)
-
-import View.Mail.WeeklyReport (mail)
+import qualified SendMail
+import qualified View.Mail.WeeklyReport as WeeklyReport
 
 weeklyReport :: Conf -> Maybe UTCTime -> IO UTCTime
 weeklyReport conf mbLastExecution = do
@@ -21,11 +18,11 @@ weeklyReport conf mbLastExecution = do
   case mbLastExecution of
     Nothing -> return ()
     Just lastExecution -> do
-      (payments, incomes, users) <- runDb $
+      (payments, incomes, users) <- Query.run $
         (,,) <$>
           Payment.modifiedDuring lastExecution now <*>
           Income.modifiedDuring lastExecution now <*>
           User.list
-      _ <- sendMail (mail conf users payments incomes lastExecution now)
+      _ <- SendMail.sendMail (WeeklyReport.mail conf users payments incomes lastExecution now)
       return ()
   return now
diff --git a/src/server/Json.hs b/src/server/Json.hs
index 408742a..cc6327a 100644
--- a/src/server/Json.hs
+++ b/src/server/Json.hs
@@ -6,19 +6,14 @@ module Json
   , jsonId
   ) where
 
-import Web.Scotty
-
+import Data.Int (Int64)
+import Data.Text (Text)
 import qualified Data.Aeson.Types as Json
 import qualified Data.HashMap.Strict as M
-import Data.Text (Text)
-
-import Database.Persist
-import Database.Persist.Sqlite
-
-import Model.Database
+import Web.Scotty
 
 jsonObject :: [(Text, Json.Value)] -> ActionM ()
 jsonObject = json . Json.Object . M.fromList
 
-jsonId :: (ToBackendKey SqlBackend a) => Key a -> ActionM ()
-jsonId key = json . Json.Object . M.fromList $ [("id", Json.Number . fromIntegral . keyToInt64 $ key)]
+jsonId :: Int64 -> ActionM ()
+jsonId key = json . Json.Object . M.fromList $ [("id", Json.Number . fromIntegral $ key)]
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 7ae8c1c..17c2594 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -5,7 +5,6 @@ import qualified Data.Text.Lazy as LT
 import Web.Scotty
 
 import Job.Daemon (runDaemons)
-import Model.Database (runMigrations)
 import qualified Conf
 import qualified Controller.Category as Category
 import qualified Controller.Income as Income
@@ -15,7 +14,6 @@ import qualified Controller.SignIn as SignIn
 
 main :: IO ()
 main = do
-  runMigrations
   conf <- Conf.get "application.conf"
   _ <- runDaemons conf
   scotty (Conf.port conf) $ do
diff --git a/src/server/Model/Category.hs b/src/server/Model/Category.hs
index 50c3622..9597bd9 100644
--- a/src/server/Model/Category.hs
+++ b/src/server/Model/Category.hs
@@ -1,56 +1,90 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.Category
-  ( list
+  ( CategoryId
+  , Category(..)
+  , list
   , create
   , edit
   , delete
   ) where
 
+import Data.Int (Int64)
+import Data.Maybe (isJust, listToMaybe)
 import Data.Text (Text)
-import Data.Maybe (isJust)
+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 Model.Query (Query(Query))
+
+type CategoryId = Int64
+
+data Category = Category
+  { id :: CategoryId
+  , name :: Text
+  , color :: Text
+  , createdAt :: UTCTime
+  , editedAt :: Maybe UTCTime
+  , deletedAt :: Maybe UTCTime
+  } deriving Show
+
+instance FromRow Category where
+  fromRow = Category <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
+
+list :: Query [Category]
+list =
+  Query (\conn ->
+    SQLite.query_ conn "SELECT * FROM category WHERE deleted_at IS NULL"
+  )
+
+create :: Text -> Text -> Query CategoryId
+create categoryName categoryColor =
+  Query (\conn -> do
+    now <- getCurrentTime
+    SQLite.execute
+      conn
+      "INSERT INTO category (name, color, created_at) VALUES (?, ?, ?)"
+      (categoryName, categoryColor, now)
+    SQLite.lastInsertRowId conn
+  )
+
+edit :: CategoryId -> Text -> Text -> Query Bool
+edit categoryId categoryName categoryColor =
+  Query (\conn -> do
+    mbCategory <- listToMaybe <$>
+      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId) :: IO [Category])
+    if isJust mbCategory
+      then do
+        now <- getCurrentTime
+        SQLite.execute
+          conn
+          "UPDATE category SET edited_at = ?, name = ?, color = ? WHERE id = ?"
+          (now, categoryName, categoryColor, categoryId)
+        return True
+      else
+        return False
+  )
 
-import Control.Monad.IO.Class (liftIO)
-
-import Database.Persist hiding (delete)
-
-import Model.Database
-import qualified Model.Json.Category as Json
-
-list :: Persist [Json.Category]
-list = map getJsonCategory <$> selectList [ CategoryDeletedAt ==. Nothing ] []
-
-getJsonCategory :: Entity Category -> Json.Category
-getJsonCategory categoryEntity =
-  Json.Category (entityKey categoryEntity) (categoryName category) (categoryColor category)
-  where category = entityVal categoryEntity
-
-create :: Text -> Text -> Persist CategoryId
-create name color = do
-  now <- liftIO getCurrentTime
-  insert (Category name color now Nothing Nothing)
-
-edit :: CategoryId -> Text -> Text -> Persist Bool
-edit categoryId name color = do
-  mbCategory <- get categoryId
-  if isJust mbCategory
-    then do
-      now <- liftIO getCurrentTime
-      update categoryId
-        [ CategoryEditedAt =. Just now
-        , CategoryName =. name
-        , CategoryColor =. color
-        ]
-      return True
-    else
-      return False
-
-delete :: CategoryId -> Persist Bool
-delete categoryId = do
-  mbCategory <- get categoryId
-  if isJust mbCategory
-    then do
-      now <- liftIO getCurrentTime
-      update categoryId [CategoryDeletedAt =. Just now]
-      return True
-    else
-      return False
+delete :: CategoryId -> Query Bool
+delete categoryId =
+  Query (\conn -> do
+    mbCategory <- listToMaybe <$>
+      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId) :: IO [Category])
+    if isJust mbCategory
+      then do
+        now <- getCurrentTime
+        SQLite.execute
+          conn
+          "UPDATE category SET deleted_at = ? WHERE id = ?" (now, categoryId)
+        return True
+      else
+        return False
+  )
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
deleted file mode 100644
index ba302de..0000000
--- a/src/server/Model/Database.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-{-# LANGUAGE EmptyDataDecls             #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs                      #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE QuasiQuotes                #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeFamilies               #-}
-
-module Model.Database where
-
-import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
-import Control.Monad.Trans.Resource (runResourceT, ResourceT)
-
-import Data.Text
-import Data.Time.Clock (UTCTime)
-import Data.Time.Calendar (Day)
-import Data.Int (Int64)
-
-import Database.Persist.Sqlite
-import Database.Persist.TH
-
-import Resource (Resource, createdAt, editedAt, deletedAt)
-
-import Model.Frequency
-
-import Job.Kind
-
-share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
-User
-  creation UTCTime
-  email Text
-  name Text
-  UniqUserEmail email
-  UniqUserName name
-  deriving Show
-Payment
-  userId UserId
-  name Text
-  cost Int
-  date Day
-  frequency Frequency
-  createdAt UTCTime
-  editedAt UTCTime Maybe
-  deletedAt UTCTime Maybe
-  deriving Show
-Category
-  name Text
-  color Text
-  createdAt UTCTime
-  editedAt UTCTime Maybe
-  deletedAt UTCTime Maybe
-  deriving Show
-PaymentCategory
-  name Text
-  category CategoryId
-  createdAt UTCTime
-  editedAt UTCTime Maybe
-  UniqPaymentCategoryName name
-  deriving Show
-SignIn
-  token Text
-  creation UTCTime
-  email Text
-  isUsed Bool
-  UniqSignInToken token
-  deriving Show
-Job
-  kind Kind
-  lastExecution UTCTime Maybe
-  lastCheck UTCTime Maybe
-  UniqJobName kind
-  deriving Show
-Income
-  userId UserId
-  date Day
-  amount Int
-  createdAt UTCTime
-  editedAt UTCTime Maybe
-  deletedAt UTCTime Maybe
-  deriving Show
-|]
-
-instance Resource Payment where
-  createdAt = paymentCreatedAt
-  editedAt = paymentEditedAt
-  deletedAt = paymentDeletedAt
-
-instance Resource Income where
-  createdAt = incomeCreatedAt
-  editedAt = incomeEditedAt
-  deletedAt = incomeDeletedAt
-
-type Persist a = SqlPersistT (ResourceT (NoLoggingT IO)) a
-
-runDb :: Persist a -> IO a
-runDb = runNoLoggingT . runResourceT . withSqliteConn "database" . runSqlConn
-
-runMigrations :: IO ()
-runMigrations = runDb $ runMigration migrateAll
-
-textToKey :: (ToBackendKey SqlBackend a) => Text -> Key a
-textToKey text = toSqlKey (read (unpack text) :: Int64)
-
-keyToInt64 :: (ToBackendKey SqlBackend a) => Key a -> Int64
-keyToInt64 = fromSqlKey
diff --git a/src/server/Model/Frequency.hs b/src/server/Model/Frequency.hs
index a6ba55c..f9958e1 100644
--- a/src/server/Model/Frequency.hs
+++ b/src/server/Model/Frequency.hs
@@ -6,21 +6,28 @@ module Model.Frequency
   ( Frequency(..)
   ) where
 
-import GHC.Generics
-
-import Web.Scotty
-
-import Database.Persist.TH
-
 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)
 
-derivePersistField "Frequency"
-
 instance Parsable Frequency where parseParam = readEither
 instance FromJSON Frequency
 instance ToJSON Frequency
+
+instance FromField Frequency where
+  fromField field = case fieldData field of
+    SQLText text -> Ok (read (T.unpack text) :: Frequency)
+    _ -> Errors [error "SQLText field required for frequency"]
+
+instance ToField Frequency where
+  toField frequency = SQLText . T.pack . show $ frequency
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index ff6accd..c6cdb55 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,73 +1,111 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.Income
-  ( list
+  ( IncomeId
+  , Income(..)
+  , list
   , create
   , editOwn
   , deleteOwn
   , modifiedDuring
   ) where
 
-import Data.Time.Clock (UTCTime, getCurrentTime)
+import Data.Int (Int64)
+import Data.Maybe (listToMaybe)
 import Data.Time.Calendar (Day)
+import Data.Time.Clock (UTCTime, getCurrentTime)
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
+import Prelude hiding (id)
+import qualified Database.SQLite.Simple as SQLite
+
+import Model.Query (Query(Query))
+import Model.User (User, UserId)
+import qualified Model.User as User
+import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
 
-import Control.Monad.IO.Class (liftIO)
+type IncomeId = Int64
 
-import Database.Persist
+data Income = Income
+  { id :: IncomeId
+  , userId :: UserId
+  , date :: Day
+  , amount :: Int
+  , createdAt :: UTCTime
+  , editedAt :: Maybe UTCTime
+  , deletedAt :: Maybe UTCTime
+  } deriving Show
 
-import Model.Database
-import qualified Model.Json.Income as Json
+instance Resource Income where
+  resourceCreatedAt = createdAt
+  resourceEditedAt = editedAt
+  resourceDeletedAt = deletedAt
 
-list :: Persist [Json.Income]
-list = map getJsonIncome <$> selectList [IncomeDeletedAt ==. Nothing] []
+instance FromRow Income where
+  fromRow = Income <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
 
-getJsonIncome :: Entity Income -> Json.Income
-getJsonIncome incomeEntity =
-  Json.Income (entityKey incomeEntity) (incomeUserId income) (incomeDate income) (incomeAmount income)
-  where income = entityVal incomeEntity
+list :: Query [Income]
+list = Query (\conn -> SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL")
 
-create :: UserId -> Day -> Int -> Persist IncomeId
-create userId date amount = do
-  now <- liftIO getCurrentTime
-  insert (Income userId date amount now Nothing Nothing)
+create :: UserId -> Day -> Int -> Query IncomeId
+create incomeUserId incomeDate incomeAmount =
+  Query (\conn -> do
+    now <- getCurrentTime
+    SQLite.execute
+      conn
+      "INSERT INTO income (user_id, date, amount, created_at) VALUES (?, ?, ?, ?)"
+      (incomeUserId, incomeDate, incomeAmount, now)
+    SQLite.lastInsertRowId conn
+  )
 
-editOwn :: UserId -> IncomeId -> Day -> Int -> Persist Bool
-editOwn userId incomeId date amount = do
-  mbIncome <- get incomeId
-  case mbIncome of
-    Just income ->
-      if incomeUserId income == userId
-        then do
-          now <- liftIO getCurrentTime
-          update incomeId
-            [ IncomeEditedAt =. Just now
-            , IncomeDate =. date
-            , IncomeAmount =. amount
-            ]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
+editOwn :: UserId -> IncomeId -> Day -> Int -> Query Bool
+editOwn incomeUserId incomeId incomeDate incomeAmount =
+  Query (\conn -> do
+    mbIncome <- listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
+    case mbIncome of
+      Just income ->
+        if userId income == incomeUserId
+          then do
+            now <- getCurrentTime
+            SQLite.execute
+              conn
+              "UPDATE income SET edited_at = ?, date = ?, amount = ? WHERE id = ?"
+              (now, incomeDate, incomeAmount, incomeId)
+            return True
+          else
+            return False
+      Nothing ->
+        return False
+  )
 
-deleteOwn :: Entity User -> IncomeId -> Persist Bool
-deleteOwn user incomeId = do
-  mbIncome <- get incomeId
-  case mbIncome of
-    Just income ->
-      if incomeUserId income == entityKey user
-        then do
-          now <- liftIO getCurrentTime
-          update incomeId [IncomeDeletedAt =. Just now]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
+deleteOwn :: User -> IncomeId -> Query Bool
+deleteOwn user incomeId =
+  Query (\conn -> do
+    mbIncome <- listToMaybe <$> SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
+    case mbIncome of
+      Just income ->
+        if userId income == User.id user
+          then do
+            now <- getCurrentTime
+            SQLite.execute conn "UPDATE income SET deleted_at = ? WHERE id = ?" (now, incomeId)
+            return True
+          else
+            return False
+      Nothing ->
+        return False
+  )
 
-modifiedDuring :: UTCTime -> UTCTime -> Persist [Income]
+modifiedDuring :: UTCTime -> UTCTime -> Query [Income]
 modifiedDuring start end =
-  map entityVal <$> selectList
-    (   [IncomeCreatedAt >=. start, IncomeCreatedAt <. end]
-    ||. [IncomeEditedAt >=. Just start, IncomeEditedAt <. Just end]
-    ||. [IncomeDeletedAt >=. Just start, IncomeDeletedAt <. Just end]
-    )
-    []
+  Query (\conn ->
+    SQLite.query
+      conn
+      "SELECT * FROM income WHERE (created_at >= ? AND created_at <= ?) OR (edited_at >= ? AND edited_at <= ?) OR (deleted_at >= ? AND deleted_at <= ?)"
+      (start, end, start, end, start, end)
+  )
diff --git a/src/server/Model/Init.hs b/src/server/Model/Init.hs
index 7610b25..7a9ccea 100644
--- a/src/server/Model/Init.hs
+++ b/src/server/Model/Init.hs
@@ -4,27 +4,27 @@ module Model.Init
   ( getInit
   ) where
 
-import Control.Monad.IO.Class (liftIO)
-
-import Database.Persist
-
-import Model.Database
-
 import Model.Json.Init (Init)
-import qualified Model.Payment as Payment
-import qualified Model.User as User
-import qualified Model.Income as Income
+import Model.Query (Query)
+import Model.User (User)
 import qualified Model.Category as Category
-import qualified Model.PaymentCategory as PaymentCategory
-
+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 :: Entity User -> Persist Init
+getInit :: User -> Query Init
 getInit user =
-  liftIO . runDb $ Init.Init <$>
-    (map User.getJson <$> User.list) <*>
-    (return . entityKey $ user) <*>
-    Payment.list <*>
-    Income.list <*>
-    Category.list <*>
-    PaymentCategory.list
+  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)
diff --git a/src/server/Model/Json/Category.hs b/src/server/Model/Json/Category.hs
index daad4c2..8b5e527 100644
--- a/src/server/Model/Json/Category.hs
+++ b/src/server/Model/Json/Category.hs
@@ -2,14 +2,15 @@
 
 module Model.Json.Category
   ( Category(..)
+  , fromCategory
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
 import Data.Text (Text)
+import GHC.Generics
 
-import Model.Database (CategoryId)
+import Model.Category (CategoryId)
+import qualified Model.Category as M
 
 data Category = Category
   { id :: CategoryId
@@ -18,3 +19,6 @@ data Category = Category
   } 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/CreatePayment.hs b/src/server/Model/Json/CreatePayment.hs
index 5bc6b47..6ab3a5b 100644
--- a/src/server/Model/Json/CreatePayment.hs
+++ b/src/server/Model/Json/CreatePayment.hs
@@ -4,13 +4,12 @@ module Model.Json.CreatePayment
   ( CreatePayment(..)
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
-import Data.Time.Calendar (Day)
 import Data.Text (Text)
+import Data.Time.Calendar (Day)
+import GHC.Generics
 
-import Model.Database (CategoryId)
+import Model.Category (CategoryId)
 import Model.Frequency (Frequency)
 
 data CreatePayment = CreatePayment
diff --git a/src/server/Model/Json/EditCategory.hs b/src/server/Model/Json/EditCategory.hs
index bda3418..a10ce39 100644
--- a/src/server/Model/Json/EditCategory.hs
+++ b/src/server/Model/Json/EditCategory.hs
@@ -4,12 +4,11 @@ module Model.Json.EditCategory
   ( EditCategory(..)
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
 import Data.Text (Text)
+import GHC.Generics
 
-import Model.Database (CategoryId)
+import Model.Category (CategoryId)
 
 data EditCategory = EditCategory
   { id :: CategoryId
diff --git a/src/server/Model/Json/EditIncome.hs b/src/server/Model/Json/EditIncome.hs
index be3c7dc..9b29379 100644
--- a/src/server/Model/Json/EditIncome.hs
+++ b/src/server/Model/Json/EditIncome.hs
@@ -9,7 +9,7 @@ import GHC.Generics
 import Data.Aeson
 import Data.Time.Calendar (Day)
 
-import Model.Database (IncomeId)
+import Model.Income (IncomeId)
 
 data EditIncome = EditIncome
   { id :: IncomeId
diff --git a/src/server/Model/Json/EditPayment.hs b/src/server/Model/Json/EditPayment.hs
index 35f44e5..b7d4d7d 100644
--- a/src/server/Model/Json/EditPayment.hs
+++ b/src/server/Model/Json/EditPayment.hs
@@ -4,14 +4,14 @@ module Model.Json.EditPayment
   ( EditPayment(..)
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
-import Data.Time.Calendar (Day)
 import Data.Text (Text)
+import Data.Time.Calendar (Day)
+import GHC.Generics
 
+import Model.Category (CategoryId)
 import Model.Frequency (Frequency)
-import Model.Database (PaymentId, CategoryId)
+import Model.Payment (PaymentId)
 
 data EditPayment = EditPayment
   { id :: PaymentId
diff --git a/src/server/Model/Json/Income.hs b/src/server/Model/Json/Income.hs
index bb1ac97..7e23a84 100644
--- a/src/server/Model/Json/Income.hs
+++ b/src/server/Model/Json/Income.hs
@@ -2,14 +2,16 @@
 
 module Model.Json.Income
   ( Income(..)
+  , fromIncome
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
 import Data.Time.Calendar (Day)
+import GHC.Generics
 
-import Model.Database (IncomeId, UserId)
+import Model.Income (IncomeId)
+import Model.User (UserId)
+import qualified Model.Income as M
 
 data Income = Income
   { id :: IncomeId
@@ -19,3 +21,6 @@ data Income = Income
   } 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
index b9f7f40..530c3b7 100644
--- a/src/server/Model/Json/Init.hs
+++ b/src/server/Model/Json/Init.hs
@@ -5,17 +5,16 @@ module Model.Json.Init
   , InitResult(..)
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
+import GHC.Generics
 
-import Model.Database (UserId)
-import Model.Json.User (User)
-import Model.Json.Payment (Payment)
-import Model.Json.Income (Income)
 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]
diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs
index 04c6de8..e406c0f 100644
--- a/src/server/Model/Json/Payment.hs
+++ b/src/server/Model/Json/Payment.hs
@@ -2,16 +2,19 @@
 
 module Model.Json.Payment
   ( Payment(..)
+  , fromPayment
   ) where
 
-import GHC.Generics
-
-import Data.Text (Text)
 import Data.Aeson
+import Data.Text (Text)
 import Data.Time.Calendar (Day)
+import GHC.Generics
+import Prelude hiding (id)
 
-import Model.Database (PaymentId, UserId)
 import Model.Frequency
+import Model.Payment (PaymentId)
+import Model.User (UserId)
+import qualified Model.Payment as M
 
 data Payment = Payment
   { id :: PaymentId
@@ -24,3 +27,14 @@ data Payment = Payment
 
 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
index edd4388..fd97674 100644
--- a/src/server/Model/Json/PaymentCategory.hs
+++ b/src/server/Model/Json/PaymentCategory.hs
@@ -2,14 +2,15 @@
 
 module Model.Json.PaymentCategory
   ( PaymentCategory(..)
+  , fromPaymentCategory
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
 import Data.Text (Text)
+import GHC.Generics
 
-import Model.Database (CategoryId)
+import Model.Category (CategoryId)
+import qualified Model.PaymentCategory as M
 
 data PaymentCategory = PaymentCategory
   { name :: Text
@@ -17,3 +18,6 @@ data PaymentCategory = PaymentCategory
   } 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/User.hs b/src/server/Model/Json/User.hs
index ebc347b..c289fe0 100644
--- a/src/server/Model/Json/User.hs
+++ b/src/server/Model/Json/User.hs
@@ -2,14 +2,15 @@
 
 module Model.Json.User
   ( User(..)
+  , fromUser
   ) where
 
-import GHC.Generics
-
 import Data.Aeson
 import Data.Text (Text)
+import GHC.Generics
 
-import Model.Database (UserId)
+import Model.User (UserId)
+import qualified Model.User as M
 
 data User = User
   { id :: UserId
@@ -19,3 +20,6 @@ data User = User
 
 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/Payment.hs b/src/server/Model/Payment.hs
index d8caaa8..88df477 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,100 +1,164 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Model.Payment
-  ( find
+  ( PaymentId
+  , Payment(..)
+  , find
   , list
   , listMonthly
   , create
+  , createMany
   , editOwn
   , deleteOwn
   , modifiedDuring
   ) where
 
+import Data.Int (Int64)
+import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import Data.Time (UTCTime)
-import Data.Time.Clock (getCurrentTime)
 import Data.Time.Calendar (Day)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow), ToRow)
+import Database.SQLite.Simple.ToField (ToField(toField))
+import Prelude hiding (id)
+import qualified Database.SQLite.Simple as SQLite
 
-import Control.Monad.IO.Class (liftIO)
+import Model.Frequency
+import Model.Query (Query(Query))
+import Model.User (UserId)
+import Resource (Resource, resourceCreatedAt, resourceEditedAt, resourceDeletedAt)
 
-import Database.Persist
+type PaymentId = Int64
 
-import Model.Database
-import Model.Frequency
-import qualified Model.Json.Payment as P
+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
 
-find :: PaymentId -> Persist (Maybe (Entity Payment))
-find paymentId = selectFirst [ PaymentId ==. paymentId ] []
+instance Resource Payment where
+  resourceCreatedAt = createdAt
+  resourceEditedAt = editedAt
+  resourceDeletedAt = deletedAt
 
-list :: Persist [P.Payment]
-list = map getJsonPayment <$> selectList [ PaymentDeletedAt ==. Nothing ] []
+instance FromRow Payment where
+  fromRow = Payment <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
 
-listMonthly :: Persist [Entity Payment]
-listMonthly =
-  selectList
-    [ PaymentDeletedAt ==. Nothing
-    , PaymentFrequency ==. Monthly
+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 (createdAt p)
     ]
-    [ Desc PaymentName ]
-
-getJsonPayment :: Entity Payment -> P.Payment
-getJsonPayment paymentEntity =
-  let payment = entityVal paymentEntity
-  in  P.Payment
-        { P.id = entityKey paymentEntity
-        , P.date = paymentDate payment
-        , P.name = paymentName payment
-        , P.cost = paymentCost payment
-        , P.userId = paymentUserId payment
-        , P.frequency = paymentFrequency payment
-        }
-
-create :: UserId -> Text -> Int -> Day -> Frequency -> Persist PaymentId
-create userId name cost date frequency = do
-  now <- liftIO getCurrentTime
-  insert (Payment userId name cost date frequency now Nothing Nothing)
-
-editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Persist Bool
-editOwn userId paymentId name cost date frequency = do
-  mbPayment <- get paymentId
-  case mbPayment of
-    Just payment ->
-      if paymentUserId payment == userId
-        then do
-          now <- liftIO getCurrentTime
-          update paymentId
-            [ PaymentEditedAt =. Just now
-            , PaymentName =. name
-            , PaymentCost =. cost
-            , PaymentDate =. date
-            , PaymentFrequency =. frequency
-            ]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
-
-deleteOwn :: UserId -> PaymentId -> Persist Bool
-deleteOwn userId paymentId = do
-  mbPayment <- get paymentId
-  case mbPayment of
-    Just payment ->
-      if paymentUserId payment == userId
-        then do
-          now <- liftIO getCurrentTime
-          update paymentId [PaymentDeletedAt =. Just now]
-          return True
-        else
-          return False
-    Nothing ->
-      return False
-
-modifiedDuring :: UTCTime -> UTCTime -> Persist [Payment]
+
+find :: PaymentId -> Query (Maybe Payment)
+find paymentId =
+  Query (\conn -> listToMaybe <$>
+    SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
+  )
+
+list :: Query [Payment]
+list =
+  Query (\conn ->
+    SQLite.query_ conn "SELECT * FROM payment WHERE deleted_at IS NULL"
+  )
+
+listMonthly :: Query [Payment]
+listMonthly =
+  Query (\conn ->
+    SQLite.query
+      conn
+      "SELECT * FROM payment WHERE deleted_at IS NULL AND frequency = ? ORDER BY name DESC"
+      (Only Monthly)
+  )
+
+create :: UserId -> Text -> Int -> Day -> Frequency -> Query PaymentId
+create paymentUserId 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)
+    SQLite.lastInsertRowId conn
+  )
+
+createMany :: [Payment] -> Query ()
+createMany payments =
+  Query (\conn ->
+    SQLite.executeMany
+      conn
+      "INSERT INTO payment (user_id, name, cost, date, frequency, created_at) VALUES (?, ?, ?, ?, ?, ?)"
+      payments
+  )
+
+editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
+editOwn paymentUserId 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
+          then do
+            now <- getCurrentTime
+            SQLite.execute
+              conn
+              "UPDATE payment SET edited_at = ?, name = ?, cost = ?, date = ?, frequency = ? WHERE id = ?"
+              (now, paymentName, paymentCost, paymentDate, paymentFrequency, paymentId)
+            return True
+          else
+            return False
+      Nothing ->
+        return False
+  )
+
+deleteOwn :: UserId -> PaymentId -> Query Bool
+deleteOwn paymentUserId 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
+          then do
+            now <- getCurrentTime
+            SQLite.execute
+              conn
+              "UPDATE payment SET deleted_at = ? WHERE id = ?"
+              (now, paymentId)
+            return True
+          else
+            return False
+      Nothing ->
+        return False
+  )
+
+modifiedDuring :: UTCTime -> UTCTime -> Query [Payment]
 modifiedDuring start end =
-  map entityVal <$> selectList
-    (   [PaymentFrequency ==. Punctual, PaymentCreatedAt >=. start, PaymentCreatedAt <. end]
-    ||. [PaymentFrequency ==. Punctual, PaymentEditedAt >=. Just start, PaymentEditedAt <. Just end]
-    ||. [PaymentFrequency ==. Punctual, PaymentDeletedAt >=. Just start, PaymentDeletedAt <. Just end]
-    )
-    []
+  Query (\conn ->
+    SQLite.query
+      conn
+      "SELECT * FROM payment WHERE (created_at >= ? AND created_at <= ?) OR (edited_at >= ? AND edited_at <= ?) OR (deleted_at >= ? AND deleted_at <= ?)"
+      (start, end, start, end, start, end)
+  )
diff --git a/src/server/Model/PaymentCategory.hs b/src/server/Model/PaymentCategory.hs
index 3b0b858..668fb01 100644
--- a/src/server/Model/PaymentCategory.hs
+++ b/src/server/Model/PaymentCategory.hs
@@ -1,48 +1,71 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Model.PaymentCategory
-  ( list
+  ( PaymentCategoryId
+  , PaymentCategory(..)
+  , list
   , listByCategory
   , save
   ) where
 
-import Control.Monad.IO.Class (liftIO)
-import Data.Maybe (isJust)
-
+import Data.Int (Int64)
+import Data.Maybe (isJust, listToMaybe)
 import Data.Text (Text)
+import Data.Time (UTCTime)
 import Data.Time.Clock (getCurrentTime)
-import Database.Persist
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
 import qualified Data.Text as T
+import qualified Database.SQLite.Simple as SQLite
 
-import Model.Database
-import qualified Model.Json.PaymentCategory as Json
+import Model.Category (CategoryId)
+import Model.Query (Query(Query))
 import qualified Utils.Text as T
 
-list :: Persist [Json.PaymentCategory]
-list = map getJsonPaymentCategory <$> selectList [] []
-
-listByCategory :: CategoryId -> Persist [Entity PaymentCategory]
-listByCategory category = selectList [ PaymentCategoryCategory ==. category ] []
-
-getJsonPaymentCategory :: Entity PaymentCategory -> Json.PaymentCategory
-getJsonPaymentCategory entity =
-  Json.PaymentCategory (paymentCategoryName pc) (paymentCategoryCategory pc)
-  where pc = entityVal entity
-
-save :: Text -> CategoryId -> Persist ()
-save newName category = do
-  now <- liftIO getCurrentTime
-  mbPaymentCategory <- selectFirst [PaymentCategoryName ==. (formatPaymentName newName)] []
-  if isJust mbPaymentCategory
-    then
-      updateWhere
-        [ PaymentCategoryName ==. (formatPaymentName newName) ]
-        [ PaymentCategoryCategory =. category
-        , PaymentCategoryEditedAt =. Just now
-        ]
-    else do
-      _ <- insert $ PaymentCategory (formatPaymentName newName) category now Nothing
-      return ()
-
-formatPaymentName :: Text -> Text
-formatPaymentName = T.unaccent . T.toLower
+type PaymentCategoryId = Int64
+
+data PaymentCategory = PaymentCategory
+  { id :: PaymentCategoryId
+  , name :: Text
+  , category :: CategoryId
+  , createdAt :: UTCTime
+  , editedAt :: Maybe UTCTime
+  } deriving Show
+
+instance FromRow PaymentCategory where
+  fromRow = PaymentCategory <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
+
+list :: Query [PaymentCategory]
+list = Query (\conn -> SQLite.query_ conn "SELECT * from payment_category")
+
+listByCategory :: CategoryId -> Query [PaymentCategory]
+listByCategory cat =
+  Query (\conn ->
+    SQLite.query conn "SELECT * FROM payment_category WHERE category = ?" (Only cat)
+  )
+
+save :: Text -> CategoryId -> Query ()
+save newName categoryId =
+  Query (\conn -> do
+    now <- getCurrentTime
+    mbPaymentCategory <- listToMaybe <$>
+      (SQLite.query conn "SELECT * FROM payment_category WHERE name = ?" (Only newName) :: IO [PaymentCategory])
+    if isJust mbPaymentCategory
+      then
+        SQLite.execute
+          conn
+          "UPDATE payment_category SET category = ?, edited_at = ? WHERE name = ?"
+          (categoryId, now, formatPaymentName newName)
+      else do
+        SQLite.execute
+          conn
+          "INSERT INTO payment_category (name, category, created_at) VALUES (?, ?, ?)"
+          (formatPaymentName newName, categoryId, now)
+  )
+  where
+    formatPaymentName :: Text -> Text
+    formatPaymentName = T.unaccent . T.toLower
diff --git a/src/server/Model/Query.hs b/src/server/Model/Query.hs
new file mode 100644
index 0000000..d15fb5f
--- /dev/null
+++ b/src/server/Model/Query.hs
@@ -0,0 +1,32 @@
+module Model.Query
+  ( Query(..)
+  , run
+  ) where
+
+import Data.Functor (Functor)
+import Database.SQLite.Simple (Connection)
+import qualified Database.SQLite.Simple as SQLite
+
+data Query a = Query (Connection -> IO a)
+
+instance Functor Query where
+  fmap f (Query call) = Query (fmap f . call)
+
+instance Applicative Query where
+  pure x = Query (const $ return x)
+  (Query callF) <*> (Query callX) = Query (\conn -> do
+    x <- callX conn
+    f <- callF conn
+    return (f x))
+
+instance Monad Query where
+  (Query callX) >>= f = Query (\conn -> do
+    x <- callX conn
+    case f x of Query callY -> callY conn)
+
+run :: Query a -> IO a
+run (Query call) = do
+  conn <- SQLite.open "database"
+  result <- call conn
+  _ <- SQLite.close conn
+  return result
diff --git a/src/server/Model/SignIn.hs b/src/server/Model/SignIn.hs
index 06aba5a..c5182f0 100644
--- a/src/server/Model/SignIn.hs
+++ b/src/server/Model/SignIn.hs
@@ -1,40 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.SignIn
-  ( createSignInToken
+  ( SignIn(..)
+  , createSignInToken
   , getSignIn
   , signInTokenToUsed
-  , isLastValidToken
+  , isLastTokenValid
   ) where
 
+import Data.Int (Int64)
+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 qualified Database.SQLite.Simple as SQLite
 
-import Control.Monad.IO.Class (liftIO)
+import Model.Query (Query(Query))
+import Model.UUID (generateUUID)
 
-import Database.Persist
+type SignInId = Int64
 
-import Model.Database
-import Model.UUID (generateUUID)
+data SignIn = SignIn
+  { id :: SignInId
+  , token :: Text
+  , creation :: UTCTime
+  , email :: Text
+  , isUsed :: Bool
+  } deriving Show
 
-createSignInToken :: Text -> Persist Text
-createSignInToken email = do
-  now <- liftIO getCurrentTime
-  token <- liftIO generateUUID
-  _ <- insert $ SignIn token now email False
-  return token
+instance FromRow SignIn where
+  fromRow = SignIn <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
 
-getSignIn :: Text -> Persist (Maybe (Entity SignIn))
-getSignIn token =
-  selectFirst [SignInToken ==. token] []
+createSignInToken :: Text -> Query Text
+createSignInToken signInEmail =
+  Query (\conn -> do
+    now <- getCurrentTime
+    signInToken <- generateUUID
+    SQLite.execute conn "INSERT INTO sign_in (token, creation, email, is_used) VALUES (?, ?, ?, ?)" (signInToken, now, signInEmail, False)
+    return signInToken
+  )
 
-signInTokenToUsed :: SignInId -> Persist ()
+getSignIn :: Text -> Query (Maybe SignIn)
+getSignIn signInToken =
+  Query (\conn -> do
+    listToMaybe <$> (SQLite.query conn "SELECT * from sign_in WHERE token = ? LIMIT 1" (Only signInToken) :: IO [SignIn])
+  )
+
+signInTokenToUsed :: SignInId -> Query ()
 signInTokenToUsed tokenId =
-  update tokenId [SignInIsUsed =. True]
-
-isLastValidToken :: SignIn -> Persist Bool
-isLastValidToken signIn = do
-  maybe False ((== (signInToken signIn)) . signInToken . entityVal) <$>
-    selectFirst
-      [ SignInEmail ==. (signInEmail signIn)
-      , SignInIsUsed ==. True
-      ]
-      [ Desc SignInCreation ]
+  Query (\conn ->
+    SQLite.execute conn "UPDATE sign_in SET is_used = ? WHERE id = ?" (True, tokenId)
+  )
+
+isLastTokenValid :: SignIn -> Query Bool
+isLastTokenValid signIn =
+  Query (\conn -> do
+    [ Only lastToken ] <- SQLite.query conn "SELECT token from sign_in WHERE email = ? AND is_used = ? ORDER BY creation DESC LIMIT 1" (email signIn, True)
+    return . maybe False (== (token signIn)) $ lastToken
+  )
diff --git a/src/server/Model/User.hs b/src/server/Model/User.hs
index ab39822..c8a0d53 100644
--- a/src/server/Model/User.hs
+++ b/src/server/Model/User.hs
@@ -1,42 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.User
-  ( list
+  ( UserId
+  , User(..)
+  , list
   , getUser
-  , getJson
   , findUser
   , 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.List (find)
+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 Control.Monad.IO.Class (liftIO)
+import Model.Query (Query(Query))
 
-import Database.Persist
+type UserId = Int64
 
-import Model.Database
-import qualified Model.Json.User as Json
+data User = User
+  { id :: UserId
+  , creation :: UTCTime
+  , email :: Text
+  , name :: Text
+  } deriving Show
 
-list :: Persist [Entity User]
-list = selectList [] [Desc UserCreation]
+instance FromRow User where
+  fromRow = User <$> SQLite.field <*> SQLite.field <*> SQLite.field <*> SQLite.field
 
-getUser :: Text -> Persist (Maybe (Entity User))
-getUser email = selectFirst [UserEmail ==. email] []
+list :: Query [User]
+list = Query (\conn -> SQLite.query_ conn "SELECT * from user ORDER BY creation DESC")
 
-findUser :: UserId -> [Entity User] -> Maybe User
-findUser i = fmap entityVal . find ((==) i . entityKey)
+getUser :: Text -> Query (Maybe User)
+getUser userEmail =
+  Query (\conn -> listToMaybe <$>
+    SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
+  )
 
-getJson :: Entity User -> Json.User
-getJson userEntity =
-  let user = entityVal userEntity
-  in  Json.User (entityKey userEntity) (userName user) (userEmail user)
+findUser :: UserId -> [User] -> Maybe User
+findUser userId = find ((==) userId . id)
 
-createUser :: Text -> Text -> Persist UserId
-createUser email name = do
-  now <- liftIO getCurrentTime
-  insert $ User now email name
+createUser :: Text -> Text -> Query UserId
+createUser userEmail userName =
+  Query (\conn -> do
+    now <- getCurrentTime
+    SQLite.execute
+      conn
+      "INSERT INTO user (creation, email, name) VALUES (?, ?, ?)"
+      (now, userEmail, userName)
+    SQLite.lastInsertRowId conn
+  )
 
-deleteUser :: Text -> Persist ()
-deleteUser email =
-  deleteWhere [UserEmail ==. email]
+deleteUser :: Text -> Query ()
+deleteUser userEmail =
+  Query (\conn ->
+    SQLite.execute conn "DELETE FROM user WHERE email = ?" (Only userEmail)
+  )
diff --git a/src/server/Resource.hs b/src/server/Resource.hs
index 8999b77..f52bbfa 100644
--- a/src/server/Resource.hs
+++ b/src/server/Resource.hs
@@ -1,8 +1,8 @@
 module Resource
   ( Resource
-  , createdAt
-  , editedAt
-  , deletedAt
+  , resourceCreatedAt
+  , resourceEditedAt
+  , resourceDeletedAt
   , Status(..)
   , statuses
   , groupByStatus
@@ -15,9 +15,9 @@ import qualified Data.Map as M
 import Data.Time.Clock (UTCTime)
 
 class Resource a where
-  createdAt :: a -> UTCTime
-  editedAt :: a -> Maybe UTCTime
-  deletedAt :: a -> Maybe UTCTime
+  resourceCreatedAt :: a -> UTCTime
+  resourceEditedAt :: a -> Maybe UTCTime
+  resourceDeletedAt :: a -> Maybe UTCTime
 
 data Status =
   Created
@@ -46,9 +46,9 @@ statusDuring start end resource
   | not created && deleted = Just Deleted
   | otherwise = Nothing
   where
-    created = belongs (createdAt resource) start end
-    edited = fromMaybe False (fmap (\t -> belongs t start end) $ editedAt resource)
-    deleted = fromMaybe False (fmap (\t -> belongs t start end) $ deletedAt resource)
+    created = belongs (resourceCreatedAt resource) start end
+    edited = fromMaybe False (fmap (\t -> belongs t start end) $ resourceEditedAt resource)
+    deleted = fromMaybe False (fmap (\t -> belongs t start end) $ resourceDeletedAt resource)
 
 belongs :: UTCTime -> UTCTime -> UTCTime -> Bool
 belongs time start end = time >= start && time < end
diff --git a/src/server/Secure.hs b/src/server/Secure.hs
index 93d5a60..da48878 100644
--- a/src/server/Secure.hs
+++ b/src/server/Secure.hs
@@ -5,31 +5,27 @@ module Secure
   , getUserFromToken
   ) where
 
-import Web.Scotty
-
-import Network.HTTP.Types.Status (forbidden403)
-
-import Database.Persist (Entity, entityVal)
-
+import Control.Monad.IO.Class (liftIO)
 import Data.Text (Text)
 import Data.Text.Lazy (fromStrict)
+import Network.HTTP.Types.Status (forbidden403)
+import Web.Scotty
 
-import Model.User (getUser)
-import Model.SignIn (getSignIn)
-import Model.Database
 import Model.Message (getMessage)
-import qualified Model.Message.Key as Key
-
-import Control.Monad.IO.Class (liftIO)
-
+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
 
-loggedAction :: (Entity User -> ActionM ()) -> ActionM ()
+loggedAction :: (User -> ActionM ()) -> ActionM ()
 loggedAction action = do
   maybeToken <- LoginSession.get
   case maybeToken of
     Just token -> do
-      maybeUser <- liftIO . runDb . getUserFromToken $ token
+      maybeUser <- liftIO . Query.run . getUserFromToken $ token
       case maybeUser of
         Just user ->
           action user
@@ -40,11 +36,11 @@ loggedAction action = do
       status forbidden403
       html . fromStrict . getMessage $ Key.Forbidden
 
-getUserFromToken :: Text -> Persist (Maybe (Entity User))
+getUserFromToken :: Text -> Query (Maybe User)
 getUserFromToken token = do
-  mbSignIn <- fmap entityVal <$> getSignIn token
+  mbSignIn <- SignIn.getSignIn token
   case mbSignIn of
-    Just signIn -> do
-      getUser (signInEmail signIn)
+    Just signIn ->
+      User.getUser (SignIn.email signIn)
     Nothing ->
       return Nothing
diff --git a/src/server/View/Mail/SignIn.hs b/src/server/View/Mail/SignIn.hs
index 8eaa077..c7d40d8 100644
--- a/src/server/View/Mail/SignIn.hs
+++ b/src/server/View/Mail/SignIn.hs
@@ -6,13 +6,12 @@ module View.Mail.SignIn
 
 import Data.Text (Text)
 
-import Model.Database (User(..))
-import qualified Model.Mail as M
-import Model.Message.Key
-import Model.Message
-
 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
 
 mail :: Conf -> User -> Text -> [Text] -> M.Mail
 mail conf user url to =
@@ -20,5 +19,5 @@ mail conf user url to =
     { M.from = Conf.noReplyMail conf
     , M.to = to
     , M.subject = (getMessage SignInMailTitle)
-    , M.plainBody = getParamMessage [userName user, url] SignInMail
+    , M.plainBody = getParamMessage [name user, url] SignInMail
     }
diff --git a/src/server/View/Mail/WeeklyReport.hs b/src/server/View/Mail/WeeklyReport.hs
index e33459c..1a80b95 100644
--- a/src/server/View/Mail/WeeklyReport.hs
+++ b/src/server/View/Mail/WeeklyReport.hs
@@ -4,27 +4,29 @@ module View.Mail.WeeklyReport
   ( mail
   ) where
 
-import Data.Monoid ((<>))
-import Data.Maybe (catMaybes, fromMaybe)
+import Data.List (sortOn)
 import Data.Map (Map)
-import qualified Data.Map as M
+import Data.Maybe (catMaybes, fromMaybe)
+import Data.Monoid ((<>))
 import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time.Clock (UTCTime)
 import Data.Time.Calendar (Day, toGregorian)
-import Data.List (sortOn)
+import Data.Time.Clock (UTCTime)
+import qualified Data.Map as M
+import qualified Data.Text as T
 
 import Resource (Status(..), groupByStatus, statuses)
 
-import Database.Persist (Entity, entityVal)
-
-import Model.Database (Payment, Income, User, UserId)
-import qualified Model.Database as D
+import Model.Income (Income)
 import Model.Mail (Mail(Mail))
-import qualified Model.Mail as M
 import Model.Message (getMessage, getParamMessage, plural)
-import qualified Model.Message.Key as K
+import Model.Payment (Payment)
 import Model.User (findUser)
+import Model.User (User, UserId)
+import qualified Model.Income as 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 Conf (Conf)
 import qualified Conf as Conf
@@ -33,16 +35,16 @@ import qualified View.Format as Format
 
 import Utils.Time (monthToKey)
 
-mail :: Conf -> [Entity User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
+mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
 mail conf users payments incomes start end =
   Mail
     { M.from = Conf.noReplyMail conf
-    , M.to = map (D.userEmail . entityVal) users
+    , M.to = map User.email users
     , M.subject = T.concat [getMessage K.SharedCost, " − ", getMessage K.WeeklyReport]
     , M.plainBody = body conf users (groupByStatus start end payments) (groupByStatus start end incomes)
     }
 
-body :: Conf -> [Entity User] -> Map Status [Payment] -> Map Status [Income] -> Text
+body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
 body conf users paymentsByStatus incomesByStatus =
   if M.null paymentsByStatus && M.null incomesByStatus
     then
@@ -53,24 +55,24 @@ body conf users paymentsByStatus incomesByStatus =
         , map (\s -> incomeSection s conf users <$> M.lookup s incomesByStatus) statuses
         ]
 
-paymentSection :: Status -> Conf -> [Entity User] -> [Payment] -> Text
+paymentSection :: Status -> Conf -> [User] -> [Payment] -> Text
 paymentSection status conf users payments =
   section
     (plural (length payments) singleKey pluralKey)
-    (map (payedFor status conf users) . sortOn D.paymentDate $ payments)
+    (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)
 
-payedFor :: Status -> Conf -> [Entity User] -> Payment -> Text
+payedFor :: Status -> Conf -> [User] -> Payment -> Text
 payedFor status conf users payment =
   getParamMessage
-    [ formatUserName (D.paymentUserId payment) users
-    , Format.price conf . D.paymentCost $ payment
-    , D.paymentName payment
-    , formatDay $ D.paymentDate payment
+    [ formatUserName (Payment.userId payment) users
+    , Format.price conf . Payment.cost $ payment
+    , Payment.name payment
+    , formatDay $ Payment.date payment
     ]
     ( case status of
         Created -> K.PayedFor
@@ -78,23 +80,23 @@ payedFor status conf users payment =
         Deleted -> K.DidNotPayFor
     )
 
-incomeSection :: Status -> Conf -> [Entity User] -> [Income] -> Text
+incomeSection :: Status -> Conf -> [User] -> [Income] -> Text
 incomeSection status conf users incomes =
   section
     (plural (length incomes) singleKey pluralKey)
-    (map (isPayedFrom status conf users) . sortOn D.incomeDate $ incomes)
+    (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)
 
-isPayedFrom :: Status -> Conf -> [Entity User] -> Income -> Text
+isPayedFrom :: Status -> Conf -> [User] -> Income -> Text
 isPayedFrom status conf users income =
   getParamMessage
-    [ formatUserName (D.incomeUserId income) users
-    , Format.price conf . D.incomeAmount $ income
-    , formatDay $ D.incomeDate income
+    [ formatUserName (Income.userId income) users
+    , Format.price conf . Income.amount $ income
+    , formatDay $ Income.date income
     ]
     ( case status of
         Created -> K.IsPayedFrom
@@ -102,8 +104,8 @@ isPayedFrom status conf users income =
         Deleted -> K.IsNotPayedFrom
     )
 
-formatUserName :: UserId -> [Entity User] -> Text
-formatUserName userId = fromMaybe "−" . fmap D.userName . findUser userId
+formatUserName :: UserId -> [User] -> Text
+formatUserName userId = fromMaybe "−" . fmap User.name . findUser userId
 
 formatDay :: Day -> Text
 formatDay d =