{-|
Module: IHP.AuthSupport.Authentication
Description: Authentication functions
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.AuthSupport.Authentication (verifyPassword, hashPassword, generateAuthenticationToken, Lockable (maxSignInAttemps), VerifiyPassword (..)) where

import IHP.Prelude
import qualified Crypto.PasswordStore
import qualified Test.RandomStrings

class Lockable entity where
    maxSignInAttemps :: entity -> Int

passwordStrength :: Int
passwordStrength :: Int
passwordStrength = Int
17

-- | Creates a password hash
-- 
-- __Example:__
-- 
-- > action CreateUserAction = do
-- >     newRecord @User
-- >         |> fill @'["passwordHash"]
-- >         |> validateField nonEmpty #passwordHash
-- >         |> ifValid \case
-- >             Left user -> ..
-- >             Right user -> do
-- >                 user <- user.passwordHash |> liftIO . hashPassword
-- >                 user <- createRecord user
-- > 
hashPassword :: Text -> IO Text
hashPassword :: Text -> IO Text
hashPassword Text
plainText = ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Int -> IO ByteString
Crypto.PasswordStore.makePassword (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
plainText) Int
passwordStrength
{-# INLINE hashPassword #-}


class VerifiyPassword a where
    verifyPassword' :: a -> Text -> Bool

instance VerifiyPassword Text where
    verifyPassword' :: Text -> Text -> Bool
verifyPassword' Text
passwordHash Text
plainText = ByteString -> ByteString -> Bool
Crypto.PasswordStore.verifyPassword (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
plainText) (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
passwordHash)

instance VerifiyPassword (Maybe Text) where
    verifyPassword' :: Maybe Text -> Text -> Bool
verifyPassword' (Just Text
passwordHash) Text
plainText = Text -> Text -> Bool
forall a. VerifiyPassword a => a -> Text -> Bool
verifyPassword' Text
passwordHash Text
plainText
    verifyPassword' Maybe Text
Nothing Text
_ = Bool
False

-- | Returns @True@ when a given non-hashed password matches the hashed password of the given user.
--
-- >>> user <- query @User |> filterWhere (#email, "hunter2@outlook.com") |> fetchOne
-- >>> verifyPassword user "hunter2"
-- True
verifyPassword :: (HasField "passwordHash" entity passwordField, VerifiyPassword passwordField) => entity -> Text -> Bool
verifyPassword :: forall entity passwordField.
(HasField "passwordHash" entity passwordField,
 VerifiyPassword passwordField) =>
entity -> Text -> Bool
verifyPassword entity
entity Text
plainText = passwordField -> Text -> Bool
forall a. VerifiyPassword a => a -> Text -> Bool
verifyPassword' entity
entity.passwordHash Text
plainText
{-# INLINE verifyPassword #-}


-- | Generates a 32 character random string
--
-- >>> token <- generateAuthenticationToken
-- "11D3OAbUfL0P9KNJ09VcUfCO0S9RwI"
generateAuthenticationToken :: IO Text
generateAuthenticationToken :: IO Text
generateAuthenticationToken = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Char -> Int -> IO String
Test.RandomStrings.randomWord IO Char
Test.RandomStrings.randomASCII Int
32
{-# INLINE generateAuthenticationToken #-}