-- | Description: Error data types for the effect 'Polysemy.Account.Accounts'.
module Polysemy.Account.Data.AccountsError where

-- | Errors that indicate invalid client-supplied information.
data AccountsClientError =
  -- | No account was found for the given ID.
  NoAccountId
  |
  -- | Credentials did not match stored auth data.
  InvalidAuth
  |
  -- | No account was found for the given name.
  NoAccountName
  |
  -- | Name given for registration already exists in storage.
  Conflict
  deriving stock (AccountsClientError -> AccountsClientError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountsClientError -> AccountsClientError -> Bool
$c/= :: AccountsClientError -> AccountsClientError -> Bool
== :: AccountsClientError -> AccountsClientError -> Bool
$c== :: AccountsClientError -> AccountsClientError -> Bool
Eq, Int -> AccountsClientError -> ShowS
[AccountsClientError] -> ShowS
AccountsClientError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountsClientError] -> ShowS
$cshowList :: [AccountsClientError] -> ShowS
show :: AccountsClientError -> String
$cshow :: AccountsClientError -> String
showsPrec :: Int -> AccountsClientError -> ShowS
$cshowsPrec :: Int -> AccountsClientError -> ShowS
Show)

json ''AccountsClientError

-- | Errors produced by the effect 'Polysemy.Account.Accounts'.
data AccountsError =
  -- | Errors that indicate invalid client-supplied information.
  Client AccountsClientError
  |
  -- | Error indicating storage backend failure.
  Internal Text
  deriving stock (AccountsError -> AccountsError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountsError -> AccountsError -> Bool
$c/= :: AccountsError -> AccountsError -> Bool
== :: AccountsError -> AccountsError -> Bool
$c== :: AccountsError -> AccountsError -> Bool
Eq, Int -> AccountsError -> ShowS
[AccountsError] -> ShowS
AccountsError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountsError] -> ShowS
$cshowList :: [AccountsError] -> ShowS
show :: AccountsError -> String
$cshow :: AccountsError -> String
showsPrec :: Int -> AccountsError -> ShowS
$cshowsPrec :: Int -> AccountsError -> ShowS
Show)