aboutsummaryrefslogtreecommitdiff
path: root/server/src/Persistence
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Persistence')
-rw-r--r--server/src/Persistence/User.hs48
1 files changed, 43 insertions, 5 deletions
diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs
index 89eb57d..12145ac 100644
--- a/server/src/Persistence/User.hs
+++ b/server/src/Persistence/User.hs
@@ -1,17 +1,21 @@
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 Prelude hiding (id)
-import Common.Model (User (..))
+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
@@ -26,15 +30,49 @@ list :: Query [User]
list =
Query (\conn -> do
map (\(Row u) -> u) <$>
- SQLite.query_ conn "SELECT * from user ORDER BY creation DESC"
+ SQLite.query_ conn "SELECT id, creation, email, name from user ORDER BY creation DESC"
)
get :: Text -> Query (Maybe User)
-get email =
+get token =
Query (\conn -> do
fmap (\(Row u) -> u) . Maybe.listToMaybe <$>
SQLite.queryNamed
conn
- "SELECT * FROM user WHERE email = :email LIMIT 1"
+ "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
)