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/Model/HashedPassword.hs | 27 +++++++++++++++++
 server/src/Model/SignIn.hs         | 60 ++------------------------------------
 2 files changed, 30 insertions(+), 57 deletions(-)
 create mode 100644 server/src/Model/HashedPassword.hs

(limited to 'server/src/Model')

diff --git a/server/src/Model/HashedPassword.hs b/server/src/Model/HashedPassword.hs
new file mode 100644
index 0000000..c71e372
--- /dev/null
+++ b/server/src/Model/HashedPassword.hs
@@ -0,0 +1,27 @@
+module Model.HashedPassword
+  ( hash
+  , check
+  , HashedPassword(..)
+  ) where
+
+import qualified Crypto.BCrypt         as BCrypt
+import           Data.Text             (Text)
+import qualified Data.Text.Encoding    as TE
+
+import           Common.Model.Password (Password (..))
+
+newtype HashedPassword = HashedPassword Text deriving (Show)
+
+hash :: Password -> IO (Maybe HashedPassword)
+hash (Password p) = do
+  hashed <- BCrypt.hashPasswordUsingPolicy BCrypt.slowerBcryptHashingPolicy (TE.encodeUtf8 p)
+  case hashed of
+    Nothing ->
+      return Nothing
+
+    Just h ->
+      return . Just . HashedPassword . TE.decodeUtf8 $ h
+
+check :: Password -> HashedPassword -> Bool
+check (Password p) (HashedPassword h) =
+  BCrypt.validatePassword (TE.encodeUtf8 h) (TE.encodeUtf8 p)
diff --git a/server/src/Model/SignIn.hs b/server/src/Model/SignIn.hs
index bcdce61..a217bae 100644
--- a/server/src/Model/SignIn.hs
+++ b/server/src/Model/SignIn.hs
@@ -1,64 +1,10 @@
 module Model.SignIn
   ( SignIn(..)
-  , createSignInToken
-  , getSignIn
-  , signInTokenToUsed
-  , isLastTokenValid
   ) where
 
-import           Data.Int               (Int64)
-import qualified Data.Maybe             as Maybe
-import           Data.Text              (Text)
-import           Data.Time.Clock        (getCurrentTime)
-import           Data.Time.Clock        (UTCTime)
-import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
-import qualified Database.SQLite.Simple as SQLite
-
-import           Model.Query            (Query (Query))
-import           Model.UUID             (generateUUID)
-
-type SignInId = Int64
+import           Common.Model (Email, Password)
 
 data SignIn = SignIn
-  { id       :: SignInId
-  , token    :: Text
-  , creation :: UTCTime
-  , email    :: Text
-  , isUsed   :: Bool
+  { _signIn_email    :: Email
+  , _signIn_password :: Password
   } 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
-    Maybe.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
-  )
-- 
cgit v1.2.3