-
-
Notifications
You must be signed in to change notification settings - Fork 47
/
DB.hs
129 lines (101 loc) · 2.48 KB
/
DB.hs
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans -Wno-name-shadowing #-}
module Smos.Server.DB
( module Smos.Server.DB,
module Smos.Server.DB.Compressed,
module Database.Persist,
module Database.Persist.Sql,
)
where
import Control.Arrow (left)
import Data.ByteString (ByteString)
import Data.Mergeful.Timed
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time
import Data.Time.Zones.All
import Data.Validity
import Data.Validity.Persist ()
import Data.Word
import Database.Persist
import Database.Persist.Sql
import Database.Persist.TH
import GHC.Generics (Generic)
import Path
import Smos.API
import Smos.Data
import Smos.Server.DB.Compressed
share
[mkPersist sqlSettings, mkMigrate "serverAutoMigration"]
[persistLowerCase|
User
name Username
hashedPassword (PasswordHash Bcrypt)
created UTCTime
lastLogin UTCTime Maybe default=NULL
lastUse UTCTime Maybe default=NULL
UniqueUsername name
deriving Show
deriving Eq
deriving Generic
StripeCustomer
user UserId
customer Text -- Stripe customer id
UniqueStripeCustomer user customer
deriving Show
deriving Eq
deriving Generic
Subscription
user UserId
end UTCTime
UniqueSubscriptionUser user
deriving Show
deriving Eq
deriving Generic
ServerFile
user UserId
path (Path Rel File)
contents ByteString
time ServerTime
UniqueServerFilePath user path
deriving Show
deriving Eq
deriving Generic
Backup
user UserId
uuid BackupUUID
time UTCTime
size Word64
UniqueBackupUUID user uuid
deriving Show
deriving Eq
deriving Generic
BackupFile
backup BackupId
path (Path Rel File)
contents Compressed
deriving Show
deriving Eq
deriving Generic
|]
instance Validity Backup
instance PersistField TZLabel where
toPersistValue = toPersistValue . renderTZLabel
fromPersistValue pv = do
bs <- fromPersistValue pv
left T.pack $ parseTZLabel bs
instance PersistFieldSql TZLabel where
sqlType Proxy = sqlType (Proxy :: Proxy Text)