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
|
module Persistence.User
( list
, get
, checkPassword
, createSignInToken
) where
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=)))
import qualified Database.SQLite.Simple as SQLite
import Common.Model (Email (..), Password (..), User (..))
import Model.HashedPassword (HashedPassword (..))
import qualified Model.HashedPassword as HashedPassword
import Model.Query (Query (Query))
import qualified Model.UUID as UUID
newtype Row = Row User
instance FromRow Row where
fromRow = Row <$> (User <$>
SQLite.field <*>
SQLite.field <*>
SQLite.field <*>
SQLite.field)
list :: Query [User]
list =
Query (\conn -> do
map (\(Row u) -> u) <$>
SQLite.query_ conn "SELECT id, creation, email, name from user ORDER BY creation DESC"
)
get :: Text -> Query (Maybe User)
get token =
Query (\conn -> do
fmap (\(Row u) -> u) . Maybe.listToMaybe <$>
SQLite.queryNamed
conn
"SELECT id, creation, email, name FROM user WHERE sign_in_token = :sign_in_token LIMIT 1"
[ ":sign_in_token" := token ]
)
data HashedPasswordRow = HashedPasswordRow HashedPassword
instance FromRow HashedPasswordRow where
fromRow = HashedPasswordRow <$> (HashedPassword <$> SQLite.field)
checkPassword :: Email -> Password -> Query Bool
checkPassword (Email email) password =
Query (\conn -> do
hashedPassword <- fmap (\(HashedPasswordRow p) -> p) . Maybe.listToMaybe <$>
SQLite.queryNamed
conn
"SELECT password FROM user WHERE email = :email LIMIT 1"
[ ":email" := email ]
case hashedPassword of
Just h ->
return (HashedPassword.check password h)
Nothing ->
return False
)
createSignInToken :: Email -> Query Text
createSignInToken (Email email) =
Query (\conn -> do
token <- UUID.generateUUID
SQLite.executeNamed
conn
"UPDATE user SET sign_in_token = :sign_in_token WHERE email = :email"
[ ":sign_in_token" := token
, ":email" := email
]
return token
)
|
