-- | Description: Interpreters for 'Password'
module Polysemy.Account.Interpreter.Password where

import Data.Elocrypt (genOptions, genPassword)
import Data.Password.Argon2 (
  PasswordCheck (PasswordCheckSuccess),
  PasswordHash (PasswordHash),
  checkPassword,
  hashPassword,
  mkPassword,
  )
import qualified Data.Text as Text
import System.Random (getStdGen)

import Polysemy.Account.Data.GeneratedPassword (GeneratedPassword (GeneratedPassword))
import Polysemy.Account.Data.HashedPassword (HashedPassword (HashedPassword))
import Polysemy.Account.Data.RawPassword (RawPassword (UnsafeRawPassword))
import Polysemy.Account.Effect.Password (Password (..))

-- | Interpret 'Password' trivially, not performing any hashing and generating sequences of asterisks.
interpretPasswordId ::
  InterpreterFor Password r
interpretPasswordId :: forall (r :: [Effect]). InterpreterFor Password r
interpretPasswordId =
  forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Hash (UnsafeRawPassword Text
pw) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HashedPassword
HashedPassword Text
pw)
    Check (UnsafeRawPassword Text
pw) (HashedPassword Text
apw) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
pw forall a. Eq a => a -> a -> Bool
== Text
apw)
    Generate Word
len ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> GeneratedPassword
GeneratedPassword (Int -> Text -> Text
Text.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
len) Text
"*"))

-- | Interpret 'Password' using the Argon2 algorithm and "Data.Elocrypt"-generated passwords.
interpretPassword ::
  Member (Embed IO) r =>
  InterpreterFor Password r
interpretPassword :: forall (r :: [Effect]).
Member (Embed IO) r =>
InterpreterFor Password r
interpretPassword =
  forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Hash (UnsafeRawPassword Text
pw) ->
      coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash Argon2)
hashPassword (Text -> Password
mkPassword Text
pw)
    Check (UnsafeRawPassword Text
pw) (HashedPassword Text
apw) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (PasswordCheck
PasswordCheckSuccess forall a. Eq a => a -> a -> Bool
== Password -> PasswordHash Argon2 -> PasswordCheck
checkPassword (Text -> Password
mkPassword Text
pw) (forall a. Text -> PasswordHash a
PasswordHash Text
apw))
    Generate Word
len ->
      Text -> GeneratedPassword
GeneratedPassword forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g. RandomGen g => Int -> GenOptions -> g -> (String, g)
genPassword (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
len) GenOptions
genOptions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed forall (m :: * -> *). MonadIO m => m StdGen
getStdGen