{-# options_haddock prune #-}

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

import Chronos (Datetime)
import Polysemy.Db (Id, Query, Store, newId)
import qualified Polysemy.Db.Effect.Query as Query
import qualified Polysemy.Db.Effect.Store as Store
import Sqel (Uid (Uid))

import Polysemy.Account.Data.Account (Account (Account))
import Polysemy.Account.Data.AccountAuth (AccountAuth (AccountAuth))
import Polysemy.Account.Data.AccountAuthDescription (AccountAuthDescription)
import Polysemy.Account.Data.AccountByName (AccountByName (AccountByName))
import Polysemy.Account.Data.AccountName (AccountName)
import qualified Polysemy.Account.Data.AccountStatus as AccountStatus
import Polysemy.Account.Data.AccountStatus (AccountStatus)
import qualified Polysemy.Account.Data.AccountsConfig as AccountsConfig
import Polysemy.Account.Data.AccountsConfig (AccountsConfig (AccountsConfig))
import Polysemy.Account.Data.AccountsError (
  AccountsClientError (Conflict, InvalidAuth, NoAccountId, NoAccountName),
  AccountsError (Client, Internal),
  )
import Polysemy.Account.Data.AuthForAccount (AuthForAccount (AuthForAccount))
import Polysemy.Account.Data.AuthedAccount (AuthedAccount (AuthedAccount))
import Polysemy.Account.Data.GeneratedPassword (GeneratedPassword (GeneratedPassword))
import Polysemy.Account.Data.RawPassword (RawPassword (UnsafeRawPassword))
import Polysemy.Account.Effect.Accounts (Accounts (..))
import qualified Polysemy.Account.Effect.Password as Password
import Polysemy.Account.Effect.Password (Password)
import Polysemy.Account.Interpreter.AccountByName (interpretAccountByNameState)
import Polysemy.Account.Interpreter.AuthForAccount (interpretAuthForAccountState)
import Polysemy.Account.Interpreter.Password (interpretPasswordId)

dbError ::
  ∀ eff e r .
  Show e =>
  Members [eff !! e, Stop AccountsError] r =>
  InterpreterFor eff r
dbError :: forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow).
(Show e, Members '[eff !! e, Stop AccountsError] r) =>
InterpreterFor eff r
dbError =
  forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (Text -> AccountsError
Internal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Show a, IsString b) => a -> b
show)

storeError ::
  ∀ a e i r .
  Show e =>
  Members [Store i a !! e, Stop AccountsError] r =>
  InterpreterFor (Store i a) r
storeError :: forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError =
  forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (Text -> AccountsError
Internal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Show a, IsString b) => a -> b
show)

queryError ::
  ∀ a q e r .
  Show e =>
  Members [Query q a !! e, Stop AccountsError] r =>
  InterpreterFor (Query q a) r
queryError :: forall a q e (r :: EffectRow).
(Show e, Members '[Query q a !! e, Stop AccountsError] r) =>
InterpreterFor (Query q a) r
queryError =
  forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Stop err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoist (Text -> AccountsError
Internal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Show a, IsString b) => a -> b
show)

config ::
  Show e =>
  Members [Reader (AccountsConfig p) !! e, Stop AccountsError] r =>
  Sem r (AccountsConfig p)
config :: forall e p (r :: EffectRow).
(Show e,
 Members '[Reader (AccountsConfig p) !! e, Stop AccountsError] r) =>
Sem r (AccountsConfig p)
config =
  forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow).
(Show e, Members '[eff !! e, Stop AccountsError] r) =>
InterpreterFor eff r
dbError forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask

byId ::
  ∀ i r a .
  Members [Store i a, Stop AccountsError] r =>
  i ->
  Sem r (Uid i a)
byId :: forall i (r :: EffectRow) a.
Members '[Store i a, Stop AccountsError] r =>
i -> Sem r (Uid i a)
byId i
accountId =
  forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (AccountsClientError -> AccountsError
Client AccountsClientError
NoAccountId) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
i -> Sem r (f d)
Store.fetch i
accountId

byName ::
  ∀ i r a .
  Members [Query AccountByName (Maybe (Uid i a)), Stop AccountsError] r =>
  AccountName ->
  Sem r (Uid i a)
byName :: forall i (r :: EffectRow) a.
Members
  '[Query AccountByName (Maybe (Uid i a)), Stop AccountsError] r =>
AccountName -> Sem r (Uid i a)
byName AccountName
name =
  forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (AccountsClientError -> AccountsError
Client AccountsClientError
NoAccountName) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall q o (r :: EffectRow). Member (Query q o) r => q -> Sem r o
Query.query (AccountName -> AccountByName
AccountByName AccountName
name)

authedAccount ::
  ∀ i p r .
  Members [Store i (Account p), Store i (AccountAuth i), Stop AccountsError] r =>
  i ->
  Sem r (AuthedAccount i p)
authedAccount :: forall i p (r :: EffectRow).
Members
  '[Store i (Account p), Store i (AccountAuth i), Stop AccountsError]
  r =>
i -> Sem r (AuthedAccount i p)
authedAccount i
authId = do
  Maybe (Uid i (AccountAuth i))
aa <- forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
i -> Sem r (f d)
Store.fetch i
authId
  Uid i
_ (AccountAuth i
accountId AccountAuthDescription
_ HashedPassword
_ Maybe Datetime
_) <- forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (AccountsClientError -> AccountsError
Client AccountsClientError
InvalidAuth) Maybe (Uid i (AccountAuth i))
aa
  Uid i
_ (Account AccountName
name AccountStatus
status p
privs) <- forall i (r :: EffectRow) a.
Members '[Store i a, Stop AccountsError] r =>
i -> Sem r (Uid i a)
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)

-- TODO see if Query for AccountAuth can be used without Uid, extracting it in the interpreter
authenticate ::
  Show e =>
  Member (Query AccountByName (Maybe (Uid i a)) !! e) r =>
  Member (Query (AuthForAccount i) [Uid i (AccountAuth i)] !! e) r =>
  Members [Stop AccountsError, Password] r =>
  AccountName ->
  RawPassword ->
  Sem r (Uid i (AccountAuth i))
authenticate :: forall e i a (r :: EffectRow).
(Show e, Member (Query AccountByName (Maybe (Uid i a)) !! e) r,
 Member (Query (AuthForAccount i) [Uid i (AccountAuth i)] !! e) r,
 Members '[Stop AccountsError, Password] r) =>
AccountName -> RawPassword -> Sem r (Uid i (AccountAuth i))
authenticate AccountName
name RawPassword
password = do
  Uid i
id' a
_ <- forall {a}. Maybe a -> Sem r a
notFound forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a q e (r :: EffectRow).
(Show e, Members '[Query q a !! e, Stop AccountsError] r) =>
InterpreterFor (Query q a) r
queryError (forall q o (r :: EffectRow). Member (Query q o) r => q -> Sem r o
Query.query (AccountName -> AccountByName
AccountByName AccountName
name))
  [Uid i (AccountAuth i)]
auths <- forall a q e (r :: EffectRow).
(Show e, Members '[Query q a !! e, Stop AccountsError] r) =>
InterpreterFor (Query q a) r
queryError (forall q o (r :: EffectRow). Member (Query q o) r => q -> Sem r o
Query.query (forall i. i -> AuthForAccount i
AuthForAccount i
id'))
  forall {a}. Maybe a -> Sem r a
invalid forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM Uid i (AccountAuth i) -> Sem r Bool
check [Uid i (AccountAuth i)]
auths
  where
    notFound :: Maybe a -> Sem r a
notFound =
      forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (AccountsClientError -> AccountsError
Client AccountsClientError
NoAccountName)
    check :: Uid i (AccountAuth i) -> Sem r Bool
check (Uid i
_ (AccountAuth i
_ AccountAuthDescription
_ HashedPassword
hash Maybe Datetime
_)) =
      forall (r :: EffectRow).
Member Password r =>
RawPassword -> HashedPassword -> Sem r Bool
Password.check RawPassword
password HashedPassword
hash
    invalid :: Maybe a -> Sem r a
invalid =
      forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (AccountsClientError -> AccountsError
Client AccountsClientError
InvalidAuth)

privileges ::
  ∀ i p r .
  Members [Store i (Account p), Stop AccountsError] r =>
  i ->
  Sem r p
privileges :: forall i p (r :: EffectRow).
Members '[Store i (Account p), Stop AccountsError] r =>
i -> Sem r p
privileges i
i =
  forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
i -> Sem r (f d)
Store.fetch i
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Uid i
_ (Account AccountName
_ AccountStatus
_ p
privs)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure p
privs
    Maybe (Uid i (Account p))
Nothing -> forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (AccountsClientError -> AccountsError
Client AccountsClientError
NoAccountId)

addPassword ::
  Members [Password, Store i (AccountAuth i), Id i, Stop AccountsError] r =>
  AccountAuthDescription ->
  i ->
  RawPassword ->
  Maybe Datetime ->
  Sem r (Uid i (AccountAuth i))
addPassword :: forall i (r :: EffectRow).
Members
  '[Password, Store i (AccountAuth i), Id i, Stop AccountsError] r =>
AccountAuthDescription
-> i
-> RawPassword
-> Maybe Datetime
-> Sem r (Uid i (AccountAuth i))
addPassword AccountAuthDescription
desc i
accountId RawPassword
password Maybe Datetime
expiry = do
  HashedPassword
hashedPassword <- forall (r :: EffectRow).
Member Password r =>
RawPassword -> Sem r HashedPassword
Password.hash RawPassword
password
  i
authId <- forall i (r :: EffectRow). Member (Id i) r => Sem r i
newId
  let auth :: Uid i (AccountAuth i)
auth = forall i a. i -> a -> Uid i a
Uid i
authId (forall i.
i
-> AccountAuthDescription
-> HashedPassword
-> Maybe Datetime
-> AccountAuth i
AccountAuth i
accountId AccountAuthDescription
desc HashedPassword
hashedPassword Maybe Datetime
expiry)
  Uid i (AccountAuth i)
auth forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
d -> Sem r ()
Store.insert Uid i (AccountAuth i)
auth

generatePassword ::
  Show e =>
  Members [Password, Store i (AccountAuth i), Reader (AccountsConfig p) !! e, Id i, Stop AccountsError] r =>
  i ->
  Maybe Datetime ->
  Sem r GeneratedPassword
generatePassword :: forall e i p (r :: EffectRow).
(Show e,
 Members
   '[Password, Store i (AccountAuth i),
     Reader (AccountsConfig p) !! e, Id i, Stop AccountsError]
   r) =>
i -> Maybe Datetime -> Sem r GeneratedPassword
generatePassword i
accountId Maybe Datetime
expiry = do
  AccountsConfig {p
Bool
Word
$sel:defaultPrivileges:AccountsConfig :: forall p. AccountsConfig p -> p
$sel:initActive:AccountsConfig :: forall p. AccountsConfig p -> Bool
$sel:passwordLength:AccountsConfig :: forall p. AccountsConfig p -> Word
defaultPrivileges :: p
initActive :: Bool
passwordLength :: Word
..} <- forall e p (r :: EffectRow).
(Show e,
 Members '[Reader (AccountsConfig p) !! e, Stop AccountsError] r) =>
Sem r (AccountsConfig p)
config
  pw :: GeneratedPassword
pw@(GeneratedPassword Text
raw) <- forall (r :: EffectRow).
Member Password r =>
Word -> Sem r GeneratedPassword
Password.generate Word
passwordLength
  coerce :: forall a b. Coercible a b => a -> b
coerce GeneratedPassword
pw forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall i (r :: EffectRow).
Members
  '[Password, Store i (AccountAuth i), Id i, Stop AccountsError] r =>
AccountAuthDescription
-> i
-> RawPassword
-> Maybe Datetime
-> Sem r (Uid i (AccountAuth i))
addPassword AccountAuthDescription
"auth token" i
accountId (Text -> RawPassword
UnsafeRawPassword Text
raw) Maybe Datetime
expiry

-- | Fail if the account name is already present in the store.
-- If the account status is `AccountStatus.Creating', however, a previous attempt has failed critically and the account
-- can be overwritten.
deletePreviousFailure ::
  Members [Store i (Account p), Stop AccountsError] r =>
  Uid i (Account p) ->
  Sem r ()
deletePreviousFailure :: forall i p (r :: EffectRow).
Members '[Store i (Account p), Stop AccountsError] r =>
Uid i (Account p) -> Sem r ()
deletePreviousFailure (Uid i
i (Account AccountName
_ AccountStatus
AccountStatus.Creating p
_)) =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
i -> Sem r (f d)
Store.delete i
i)
deletePreviousFailure Uid i (Account p)
_ =
  forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (AccountsClientError -> AccountsError
Client AccountsClientError
Conflict)

create ::
  ∀ i p e r .
  Members [Store i (Account p), Query AccountByName (Maybe (Uid i (Account p))), Reader (AccountsConfig p) !! e] r =>
  Members [Id i, Stop AccountsError] r =>
  AccountName ->
  p ->
  Sem r (Uid i (Account p))
create :: forall i p e (r :: EffectRow).
(Members
   '[Store i (Account p),
     Query AccountByName (Maybe (Uid i (Account p))),
     Reader (AccountsConfig p) !! e]
   r,
 Members '[Id i, Stop AccountsError] r) =>
AccountName -> p -> Sem r (Uid i (Account p))
create AccountName
name p
privs = do
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall i p (r :: EffectRow).
Members '[Store i (Account p), Stop AccountsError] r =>
Uid i (Account p) -> Sem r ()
deletePreviousFailure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall q o (r :: EffectRow). Member (Query q o) r => q -> Sem r o
Query.query (AccountName -> AccountByName
AccountByName AccountName
name)
  i
accountId <- forall i (r :: EffectRow). Member (Id i) r => Sem r i
newId
  let account :: Uid i (Account p)
account = forall i a. i -> a -> Uid i a
Uid i
accountId (forall p. AccountName -> AccountStatus -> p -> Account p
Account AccountName
name AccountStatus
AccountStatus.Creating p
privs)
  Uid i (Account p)
account forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
d -> Sem r ()
Store.upsert Uid i (Account p)
account

finishCreate ::
  ∀ i p r .
  Members [Store i (Account p), Stop AccountsError] r =>
  Bool ->
  i ->
  Sem r (Uid i (Account p))
finishCreate :: forall i p (r :: EffectRow).
Members '[Store i (Account p), Stop AccountsError] r =>
Bool -> i -> Sem r (Uid i (Account p))
finishCreate Bool
active i
accountId = do
  Uid i (Account p)
account :: Uid i (Account p) <- forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (Text -> AccountsError
Internal Text
"Account absent after password creation") forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
i -> Sem r (f d)
Store.fetch i
accountId
  let updatedAccount :: Uid i (Account p)
updatedAccount = Uid i (Account p)
account forall a b. a -> (a -> b) -> b
& forall a. IsLabel "payload" a => a
#payload forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsLabel "status" a => a
#status forall s t a b. ASetter s t a b -> b -> s -> t
.~ AccountStatus
status
  Uid i (Account p)
updatedAccount forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
d -> Sem r ()
Store.upsert (Uid i (Account p)
account forall a b. a -> (a -> b) -> b
& forall a. IsLabel "payload" a => a
#payload forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsLabel "status" a => a
#status forall s t a b. ASetter s t a b -> b -> s -> t
.~ AccountStatus
status)
  where
    status :: AccountStatus
status = if Bool
active then AccountStatus
AccountStatus.Active else AccountStatus
AccountStatus.Pending

setStatus ::
  Members [Store i (Account p), Stop AccountsError] r =>
  i ->
  AccountStatus ->
  Sem r ()
setStatus :: forall i p (r :: EffectRow).
Members '[Store i (Account p), Stop AccountsError] r =>
i -> AccountStatus -> Sem r ()
setStatus i
accountId AccountStatus
status = do
  Uid i (Account p)
account <- forall err (r :: EffectRow) a.
Member (Stop err) r =>
err -> Maybe a -> Sem r a
stopNote (AccountsClientError -> AccountsError
Client AccountsClientError
NoAccountId) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
i -> Sem r (f d)
Store.fetch i
accountId
  forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
d -> Sem r ()
Store.upsert (Uid i (Account p)
account forall a b. a -> (a -> b) -> b
& forall a. IsLabel "payload" a => a
#payload forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsLabel "status" a => a
#status forall s t a b. ASetter s t a b -> b -> s -> t
.~ AccountStatus
status)

updatePrivileges ::
  ∀ i p e r .
  Show e =>
  Members [Store i (Account p) !! e, Stop AccountsError] r =>
  i ->
  (p -> p) ->
  Sem r ()
updatePrivileges :: forall i p e (r :: EffectRow).
(Show e,
 Members '[Store i (Account p) !! e, Stop AccountsError] r) =>
i -> (p -> p) -> Sem r ()
updatePrivileges i
i p -> p
f =
  forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow).
(Show e, Members '[eff !! e, Stop AccountsError] r) =>
InterpreterFor eff r
dbError (forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
i -> Sem r (f d)
Store.fetch i
i) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Uid i (Account p)
account ->
      forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow).
(Show e, Members '[eff !! e, Stop AccountsError] r) =>
InterpreterFor eff r
dbError (forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
d -> Sem r ()
Store.upsert (Uid i (Account p)
account forall a b. a -> (a -> b) -> b
& forall a. IsLabel "payload" a => a
#payload forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsLabel "privileges" a => a
#privileges forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ p -> p
f))
    Maybe (Uid i (Account p))
Nothing ->
      forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop (AccountsClientError -> AccountsError
Client AccountsClientError
NoAccountId)

-- | Interpret 'Accounts' using 'Store' and 'Query' from [Polysemy.Db]("Polysemy.Db") as the storage backend.
interpretAccounts ::
  ∀ e i p r .
  Show e =>
  Member (Query AccountByName (Maybe (Uid i (Account p))) !! e) r =>
  Member (Query (AuthForAccount i) [Uid i (AccountAuth i)] !! e) r =>
  Members [Password, Store i (Account p) !! e, Store i (AccountAuth i) !! e, Reader (AccountsConfig p) !! e, Id i] r =>
  InterpreterFor (Accounts i p !! AccountsError) r
interpretAccounts :: forall e i p (r :: EffectRow).
(Show e,
 Member (Query AccountByName (Maybe (Uid i (Account p))) !! e) r,
 Member (Query (AuthForAccount i) [Uid i (AccountAuth i)] !! e) r,
 Members
   '[Password, Store i (Account p) !! e, Store i (AccountAuth i) !! e,
     Reader (AccountsConfig p) !! e, Id i]
   r) =>
InterpreterFor (Accounts i p !! AccountsError) r
interpretAccounts =
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    Authenticate AccountName
name RawPassword
password ->
      forall e i a (r :: EffectRow).
(Show e, Member (Query AccountByName (Maybe (Uid i a)) !! e) r,
 Member (Query (AuthForAccount i) [Uid i (AccountAuth i)] !! e) r,
 Members '[Stop AccountsError, Password] r) =>
AccountName -> RawPassword -> Sem r (Uid i (AccountAuth i))
authenticate AccountName
name RawPassword
password
    GeneratePassword i
accountId Maybe Datetime
expiry ->
      forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError (forall e i p (r :: EffectRow).
(Show e,
 Members
   '[Password, Store i (AccountAuth i),
     Reader (AccountsConfig p) !! e, Id i, Stop AccountsError]
   r) =>
i -> Maybe Datetime -> Sem r GeneratedPassword
generatePassword i
accountId Maybe Datetime
expiry)
    Create AccountName
name -> do
      AccountsConfig {p
Bool
Word
defaultPrivileges :: p
initActive :: Bool
passwordLength :: Word
$sel:defaultPrivileges:AccountsConfig :: forall p. AccountsConfig p -> p
$sel:initActive:AccountsConfig :: forall p. AccountsConfig p -> Bool
$sel:passwordLength:AccountsConfig :: forall p. AccountsConfig p -> Word
..} <- forall e p (r :: EffectRow).
(Show e,
 Members '[Reader (AccountsConfig p) !! e, Stop AccountsError] r) =>
Sem r (AccountsConfig p)
config
      forall a q e (r :: EffectRow).
(Show e, Members '[Query q a !! e, Stop AccountsError] r) =>
InterpreterFor (Query q a) r
queryError (forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError (forall i p e (r :: EffectRow).
(Members
   '[Store i (Account p),
     Query AccountByName (Maybe (Uid i (Account p))),
     Reader (AccountsConfig p) !! e]
   r,
 Members '[Id i, Stop AccountsError] r) =>
AccountName -> p -> Sem r (Uid i (Account p))
create AccountName
name p
defaultPrivileges))
    FinalizeCreate i
accountId -> do
      AccountsConfig {p
Bool
Word
defaultPrivileges :: p
initActive :: Bool
passwordLength :: Word
$sel:defaultPrivileges:AccountsConfig :: forall p. AccountsConfig p -> p
$sel:initActive:AccountsConfig :: forall p. AccountsConfig p -> Bool
$sel:passwordLength:AccountsConfig :: forall p. AccountsConfig p -> Word
..} <- forall e p (r :: EffectRow).
(Show e,
 Members '[Reader (AccountsConfig p) !! e, Stop AccountsError] r) =>
Sem r (AccountsConfig p)
config
      forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError (forall i p (r :: EffectRow).
Members '[Store i (Account p), Stop AccountsError] r =>
Bool -> i -> Sem r (Uid i (Account p))
finishCreate Bool
initActive i
accountId)
    AddPassword i
accountId RawPassword
password Maybe Datetime
expiry ->
      forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError (forall i (r :: EffectRow).
Members
  '[Password, Store i (AccountAuth i), Id i, Stop AccountsError] r =>
AccountAuthDescription
-> i
-> RawPassword
-> Maybe Datetime
-> Sem r (Uid i (AccountAuth i))
addPassword AccountAuthDescription
"user login" i
accountId RawPassword
password Maybe Datetime
expiry)
    SetStatus i
accountId AccountStatus
status ->
      forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError (forall i p (r :: EffectRow).
Members '[Store i (Account p), Stop AccountsError] r =>
i -> AccountStatus -> Sem r ()
setStatus i
accountId AccountStatus
status)
    ById i
accountId ->
      forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError (forall i (r :: EffectRow) a.
Members '[Store i a, Stop AccountsError] r =>
i -> Sem r (Uid i a)
byId i
accountId)
    ByName AccountName
name ->
      forall a q e (r :: EffectRow).
(Show e, Members '[Query q a !! e, Stop AccountsError] r) =>
InterpreterFor (Query q a) r
queryError (forall i (r :: EffectRow) a.
Members
  '[Query AccountByName (Maybe (Uid i a)), Stop AccountsError] r =>
AccountName -> Sem r (Uid i a)
byName AccountName
name)
    Authed i
authId ->
      forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError (forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError @(Account _) (forall i p (r :: EffectRow).
Members
  '[Store i (Account p), Store i (AccountAuth i), Stop AccountsError]
  r =>
i -> Sem r (AuthedAccount i p)
authedAccount i
authId))
    Update Uid i (Account p)
account ->
      forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError (forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
d -> Sem r ()
Store.upsert Uid i (Account p)
account)
    Privileges i
i ->
      forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError (forall i p (r :: EffectRow).
Members '[Store i (Account p), Stop AccountsError] r =>
i -> Sem r p
privileges i
i)
    UpdatePrivileges i
i p -> p
f ->
      forall i p e (r :: EffectRow).
(Show e,
 Members '[Store i (Account p) !! e, Stop AccountsError] r) =>
i -> (p -> p) -> Sem r ()
updatePrivileges i
i p -> p
f
    Accounts i p (Sem r0) x
All ->
      forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
Sem r [d]
Store.fetchAll
    Accounts i p (Sem r0) x
AllAuths ->
      forall a e i (r :: EffectRow).
(Show e, Members '[Store i a !! e, Stop AccountsError] r) =>
InterpreterFor (Store i a) r
storeError forall (f :: * -> *) i d (r :: EffectRow).
Member (QStore f i d) r =>
Sem r [d]
Store.fetchAll

-- | Interpret 'Accounts' and 'Password' using 'AtomicState' as storage backend.
interpretAccountsState ::
  ∀ i p r .
  Ord i =>
  Show i =>
  Members [Log, Id i, Embed IO] r =>
  AccountsConfig p ->
  [Uid i (Account p)] ->
  [Uid i (AccountAuth i)] ->
  InterpretersFor [Accounts i p !! AccountsError, Password] r
interpretAccountsState :: forall i p (r :: EffectRow).
(Ord i, Show i, Members '[Log, Id i, Embed IO] r) =>
AccountsConfig p
-> [Uid i (Account p)]
-> [Uid i (AccountAuth i)]
-> InterpretersFor '[Accounts i p !! AccountsError, Password] r
interpretAccountsState AccountsConfig p
conf [Uid i (Account p)]
accounts [Uid i (AccountAuth i)]
auths =
  forall (r :: EffectRow). InterpreterFor Password r
interpretPasswordId forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
InterpreterTrans (Resumable err eff) eff r
raiseResumable (forall i (r :: EffectRow) a. i -> Sem (Reader i : r) a -> Sem r a
runReader AccountsConfig p
conf) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall i p (r :: EffectRow).
(Ord i, Show i, Member (Embed IO) r) =>
[Uid i (Account p)] -> InterpretersFor (AccountQuery i p) r
interpretAccountByNameState [Uid i (Account p)]
accounts forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall {k} i (r :: EffectRow) (p :: k).
(Ord i, Show i, Member (Embed IO) r) =>
[Uid i (AccountAuth i)] -> InterpretersFor (AuthQuery i p) r
interpretAuthForAccountState [Uid i (AccountAuth i)]
auths forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall e i p (r :: EffectRow).
(Show e,
 Member (Query AccountByName (Maybe (Uid i (Account p))) !! e) r,
 Member (Query (AuthForAccount i) [Uid i (AccountAuth i)] !! e) r,
 Members
   '[Password, Store i (Account p) !! e, Store i (AccountAuth i) !! e,
     Reader (AccountsConfig p) !! e, Id i]
   r) =>
InterpreterFor (Accounts i p !! AccountsError) r
interpretAccounts forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (index :: Nat) (inserted :: EffectRow) (head :: EffectRow)
       (oldTail :: EffectRow) (tail :: EffectRow) (old :: EffectRow)
       (full :: EffectRow) a.
(ListOfLength index head, WhenStuck index InsertAtUnprovidedIndex,
 old ~ Append head oldTail, tail ~ Append inserted oldTail,
 full ~ Append head tail,
 InsertAtIndex index head tail oldTail full inserted) =>
Sem old a -> Sem full a
insertAt @1