aboutsummaryrefslogtreecommitdiff
path: root/server/src/Model
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Model')
-rw-r--r--server/src/Model/HashedPassword.hs27
-rw-r--r--server/src/Model/SignIn.hs60
2 files changed, 30 insertions, 57 deletions
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
- )