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 (..))
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
"*"))
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