{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

module Wire.HashPassword where

import Crypto.KDF.Argon2 qualified as Argon2
import Data.Misc
import Imports
import Polysemy
import Wire.API.Password (Password)
import Wire.API.Password qualified as Password

data HashPassword m a where
  HashPassword6 :: PlainTextPassword6 -> HashPassword m Password
  HashPassword8 :: PlainTextPassword8 -> HashPassword m Password

makeSem ''HashPassword

runHashPassword ::
  ( Member (Embed IO) r
  ) =>
  Argon2.Options ->
  InterpreterFor HashPassword r
runHashPassword :: forall (r :: EffectRow).
Member (Embed IO) r =>
Options -> InterpreterFor HashPassword r
runHashPassword Options
opts =
  (forall (rInitial :: EffectRow) x.
 HashPassword (Sem rInitial) x -> Sem r x)
-> Sem (HashPassword : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  HashPassword (Sem rInitial) x -> Sem r x)
 -> Sem (HashPassword : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    HashPassword (Sem rInitial) x -> Sem r x)
-> Sem (HashPassword : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$
    \case
      HashPassword6 PlainTextPassword6
pw6 -> Options -> PlainTextPassword6 -> Sem r Password
forall (r :: EffectRow) (t :: Nat).
Member (Embed IO) r =>
Options -> PlainTextPassword' t -> Sem r Password
hashPasswordImpl Options
opts PlainTextPassword6
pw6
      HashPassword8 PlainTextPassword8
pw8 -> Options -> PlainTextPassword8 -> Sem r Password
forall (r :: EffectRow) (t :: Nat).
Member (Embed IO) r =>
Options -> PlainTextPassword' t -> Sem r Password
hashPasswordImpl Options
opts PlainTextPassword8
pw8

hashPasswordImpl ::
  (Member (Embed IO) r) =>
  Argon2.Options ->
  PlainTextPassword' t ->
  Sem r Password
hashPasswordImpl :: forall (r :: EffectRow) (t :: Nat).
Member (Embed IO) r =>
Options -> PlainTextPassword' t -> Sem r Password
hashPasswordImpl Options
opts PlainTextPassword' t
pwd = do
  IO Password -> Sem r Password
forall a. IO a -> Sem r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Password -> Sem r Password) -> IO Password -> Sem r Password
forall a b. (a -> b) -> a -> b
$ Options -> PlainTextPassword' t -> IO Password
forall (m :: * -> *) (t :: Nat).
MonadIO m =>
Options -> PlainTextPassword' t -> m Password
Password.mkSafePassword Options
opts PlainTextPassword' t
pwd