{-# language NoFieldSelectors #-}

-- | Description: Account auth data type
module Polysemy.Account.Data.AccountAuth where

import Chronos (Datetime)

import Polysemy.Account.Data.AccountAuthDescription (AccountAuthDescription)
import Polysemy.Account.Data.HashedPassword (HashedPassword)

-- | A hashed password associated with an account.
data AccountAuth i =
  AccountAuth {
    -- | The account ID belonging to this password.
    forall i. AccountAuth i -> i
account :: i,
    -- | A description of the password.
    forall i. AccountAuth i -> AccountAuthDescription
description :: AccountAuthDescription,
    -- | A password hash.
    forall i. AccountAuth i -> HashedPassword
password :: HashedPassword,
    -- | The date at which the password expires.
    forall i. AccountAuth i -> Maybe Datetime
expiry :: Maybe Datetime
  }
  deriving stock (AccountAuth i -> AccountAuth i -> Bool
forall i. Eq i => AccountAuth i -> AccountAuth i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountAuth i -> AccountAuth i -> Bool
$c/= :: forall i. Eq i => AccountAuth i -> AccountAuth i -> Bool
== :: AccountAuth i -> AccountAuth i -> Bool
$c== :: forall i. Eq i => AccountAuth i -> AccountAuth i -> Bool
Eq, Int -> AccountAuth i -> ShowS
forall i. Show i => Int -> AccountAuth i -> ShowS
forall i. Show i => [AccountAuth i] -> ShowS
forall i. Show i => AccountAuth i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountAuth i] -> ShowS
$cshowList :: forall i. Show i => [AccountAuth i] -> ShowS
show :: AccountAuth i -> String
$cshow :: forall i. Show i => AccountAuth i -> String
showsPrec :: Int -> AccountAuth i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> AccountAuth i -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i x. Rep (AccountAuth i) x -> AccountAuth i
forall i x. AccountAuth i -> Rep (AccountAuth i) x
$cto :: forall i x. Rep (AccountAuth i) x -> AccountAuth i
$cfrom :: forall i x. AccountAuth i -> Rep (AccountAuth i) x
Generic)