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
|
{-# LANGUAGE OverloadedStrings #-}
module Model.SignIn
( SignIn(..)
, createSignInToken
, getSignIn
, signInTokenToUsed
, 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 Model.Query (Query(Query))
import Model.UUID (generateUUID)
type SignInId = Int64
data SignIn = SignIn
{ id :: SignInId
, token :: Text
, creation :: UTCTime
, email :: Text
, isUsed :: Bool
} deriving Show
instance FromRow SignIn where
fromRow = SignIn <$>
SQLite.field <*>
SQLite.field <*>
SQLite.field <*>
SQLite.field <*>
SQLite.field
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
)
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 =
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
)
|
