From af8353c6164aaaaa836bfed181f883ac86bb76a5 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 19 Jan 2020 14:03:31 +0100
Subject: Sign in with email and password

---
 server/src/Persistence/User.hs | 48 +++++++++++++++++++++++++++++++++++++-----
 1 file changed, 43 insertions(+), 5 deletions(-)

(limited to 'server/src/Persistence/User.hs')

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
   )
-- 
cgit v1.2.3