aboutsummaryrefslogtreecommitdiff
path: root/src/server/Model/Database.hs
blob: 0915afe1284390ccd33bd6a3842f60f86f87559a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
{-# 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.Int (Int64)

import Database.Persist.Sqlite
import Database.Persist.TH

import Model.Frequency
import Model.JobKind

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
User
  creation UTCTime
  email Text
  name Text
  UniqUserEmail email
  UniqUserName name
  deriving Show
Payment
  userId UserId
  creation UTCTime
  name Text
  cost Int
  deletedAt UTCTime Maybe
  frequency Frequency
  deriving Show
SignIn
  token Text
  creation UTCTime
  email Text
  isUsed Bool
  UniqSignInToken token
  deriving Show
Job
  kind JobKind
  lastExecution UTCTime Maybe
  lastCheck UTCTime Maybe
  UniqJobName kind
  deriving Show
Income
  userId UserId
  creation UTCTime
  amount Int
  deletedAt UTCTime Maybe
  deriving Show
|]

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