aboutsummaryrefslogtreecommitdiff
path: root/server/src/Persistence/User.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Persistence/User.hs')
-rw-r--r--server/src/Persistence/User.hs78
1 files changed, 0 insertions, 78 deletions
diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs
deleted file mode 100644
index 12145ac..0000000
--- a/server/src/Persistence/User.hs
+++ /dev/null
@@ -1,78 +0,0 @@
-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
- )