
module Zero.Account.Model
  (
    accountExists
  , insertAccount
  , deleteAccount
  , getAccountById
  , getAccountByEmail
  , getVerificationStatusByEmail
  , getVerificationCodeByEmail
  ) where

------------------------------------------------------------------------------

import           Control.Monad (when, unless)
import qualified Data.Vector as V
import qualified Data.Text as T
import           Zero.Persistence
import           Zero.Account.Internal (Account(..), AccountStatus(..))
import           Zero.Account.Relations
import           Zero.Account.Verification.Internal (Verification(..), VerificationCode(..))
import           Zero.Crypto (generateBytes, hexBS)

------------------------------------------------------------------------------
-- Model
------------------------------------------------------------------------------

-- | Checks whether an account exists
accountExists :: SessionId -> Connection -> Text -> IO (Bool)
accountExists sid conn s = do
  maybeAccount <- getAccountByEmail sid conn s
  case maybeAccount of
    Just _  -> return True
    Nothing -> return False

-- | Create a new account.
insertAccount :: SessionId -> Connection -> Account -> IO ()
insertAccount sid conn u@Account{..} = do
  kA <- generateBytes 32
  wrap_kB <- generateBytes 32
  let accountAttributes' = attributesFromList (V.toList accountAttributes)
  let accountTuples = mkTupleSetFromList accountAttributes' [
        [ TextAtom a_userId
        , TextAtom a_email
        , TextAtom a_verifier
        , TextAtom a_salt
        , TextAtom $ hexBS kA
        , TextAtom $ hexBS wrap_kB
        ] ]
  case accountTuples of
    Right tuples -> do
      eRes <- executeDatabaseContextExpr sid conn (Insert "account" (MakeStaticRelation accountAttributes' tuples))
      case eRes of
        Left err ->
          error $ show err
        Right _ ->
          return ()
    Left err ->
      error $ show err

-- | Deletes an account by its id.
deleteAccount sid conn userId = do
  let p = AttributeEqualityPredicate "user_id#" (NakedAtomExpr (TextAtom userId))
  let q = Delete "account" p
  _ <- executeDatabaseContextExpr sid conn q
  return ()

-- | Fetches an account by its Id.
getAccountById :: SessionId -> Connection -> Text -> IO (Maybe Account)
getAccountById sid conn uid = do
  let p = AttributeEqualityPredicate "user_id#" (NakedAtomExpr (TextAtom uid))
  let q = Restrict p (RelationVariable "account" ())
  rel <- executeRelationalExpr sid conn q
  case rel of
    Left err ->
      error $ show err
    Right rl -> do
      let accounts = accountsFromRelation rl
      if not (null accounts) then
        return $ Just $ head accounts
        else
        return Nothing

-- | Fetches an account by e-mail address.
getAccountByEmail :: SessionId -> Connection -> Text -> IO (Maybe Account)
getAccountByEmail sid conn email = do
  let p = AttributeEqualityPredicate "email#" (NakedAtomExpr (TextAtom email))
  let q = Restrict p (RelationVariable "account" ())
  rel <- executeRelationalExpr sid conn q
  case rel of
    Left err ->
      error $ show err
    Right rl -> do
      let accounts = accountsFromRelation rl
      if not (null accounts) then
        return $ Just $ head accounts
      else
        return Nothing

-- | Fetches the status of an account by e-mail address.
getVerificationStatusByEmail :: SessionId -> Connection -> Text -> IO (Maybe Verification)
getVerificationStatusByEmail sid conn email = do
  let r = AttributeEqualityPredicate "email#" (NakedAtomExpr (TextAtom email))
  let p = Project (convertAttributeNames accountVerificationAttributes) (Join accountRelationVar verificationRelationVar)
  let q = Restrict r p
  rel <- executeRelationalExpr sid conn q
  case rel of
    Left err ->
      error $ show err
    Right rl ->
      return $ verificationStatusFromRelation rl

-- | Fetches the verification code associated with the supplied email address.
getVerificationCodeByEmail :: SessionId -> Connection -> Text -> IO (Maybe VerificationCode)
getVerificationCodeByEmail sid conn email = do
  let r = AttributeEqualityPredicate "email#" (NakedAtomExpr (TextAtom email))
  let p = Project (convertAttributeNames accountVerificationAttributes) (Join accountRelationVar verificationRelationVar)
  let q = Restrict r p
  rel <- executeRelationalExpr sid conn q
  case rel of
    Left err ->
      error $ show err
    Right rl ->
      return $ verificationCodeFromRelation rl
