-- | Description: Misc combinators
module Polysemy.Account.Accounts where

import Sqel (Uid (Uid))

import Polysemy.Account.Data.Account (Account (Account))
import Polysemy.Account.Data.AccountAuth (AccountAuth (AccountAuth))
import Polysemy.Account.Data.AccountCredentials (AccountCredentials (AccountCredentials))
import Polysemy.Account.Data.AccountName (AccountName)
import Polysemy.Account.Data.AccountStatus (AccountStatus (Active))
import Polysemy.Account.Data.AccountsError (AccountsError)
import Polysemy.Account.Data.AuthedAccount (AuthedAccount (AuthedAccount))
import qualified Polysemy.Account.Effect.Accounts as Accounts
import Polysemy.Account.Effect.Accounts (Accounts)

-- | Convenience function for unlocking the account matching the given name.
unlockAccountName ::
  Members [Accounts i p, Stop AccountsError] r =>
  AccountName ->
  Sem r ()
unlockAccountName :: forall i p (r :: EffectRow).
Members '[Accounts i p, Stop AccountsError] r =>
AccountName -> Sem r ()
unlockAccountName AccountName
name = do
  Uid i
i Account p
_ <- forall i p (r :: EffectRow).
Member (Accounts i p) r =>
AccountName -> Sem r (Uid i (Account p))
Accounts.byName AccountName
name
  forall i p (r :: EffectRow).
Member (Accounts i p) r =>
i -> AccountStatus -> Sem r ()
Accounts.setStatus i
i AccountStatus
Active

-- | Authenticate the given credentials against the storage backend and return the matched account's information.
login ::
  Member (Accounts i p) r =>
  AccountCredentials ->
  Sem r (AuthedAccount i p)
login :: forall i p (r :: EffectRow).
Member (Accounts i p) r =>
AccountCredentials -> Sem r (AuthedAccount i p)
login (AccountCredentials AccountName
username RawPassword
password) = do
  Uid i
authId (AccountAuth i
accountId AccountAuthDescription
_ HashedPassword
_ Maybe Datetime
_) <- forall i p (r :: EffectRow).
Member (Accounts i p) r =>
AccountName -> RawPassword -> Sem r (Uid i (AccountAuth i))
Accounts.authenticate AccountName
username RawPassword
password
  Uid i
_ (Account AccountName
name AccountStatus
status p
privs) <- forall i p (r :: EffectRow).
Member (Accounts i p) r =>
i -> Sem r (Uid i (Account p))
Accounts.byId i
accountId
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall i p.
i -> i -> AccountName -> AccountStatus -> p -> AuthedAccount i p
AuthedAccount i
accountId i
authId AccountName
name AccountStatus
status p
privs)

-- | Register an account with the given credentials.
--
-- Create the account in the storage backend, hash the password and store it, then mark the account as created.
register ::
  Member (Accounts i p) r =>
  AccountCredentials ->
  Sem r (AuthedAccount i p)
register :: forall i p (r :: EffectRow).
Member (Accounts i p) r =>
AccountCredentials -> Sem r (AuthedAccount i p)
register (AccountCredentials AccountName
username RawPassword
password) = do
  Uid i
accountId Account p
_ <- forall i p (r :: EffectRow).
Member (Accounts i p) r =>
AccountName -> Sem r (Uid i (Account p))
Accounts.create AccountName
username
  Uid i
authId (AccountAuth i
_ AccountAuthDescription
_ HashedPassword
_ Maybe Datetime
_) <- forall i p (r :: EffectRow).
Member (Accounts i p) r =>
i -> RawPassword -> Maybe Datetime -> Sem r (Uid i (AccountAuth i))
Accounts.addPassword i
accountId RawPassword
password forall a. Maybe a
Nothing
  Uid i
_ (Account AccountName
name AccountStatus
status p
privs) <- forall i p (r :: EffectRow).
Member (Accounts i p) r =>
i -> Sem r (Uid i (Account p))
Accounts.finalizeCreate i
accountId
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall i p.
i -> i -> AccountName -> AccountStatus -> p -> AuthedAccount i p
AuthedAccount i
accountId i
authId AccountName
name AccountStatus
status p
privs)