
module Zero.KeyFetchToken.Relations
  (
    defineKeyFetchTokenRelation
  , keyFetchStatesFromRelation
  , keyFetchTokensFromRelation
  , keyFetchTokenAttributes
  ) where

import qualified Data.Vector as V
import           Zero.Persistence
import           Zero.KeyFetchToken.Internal
import           Zero.Token.Internal

------------------------------------------------------------------------------
-- Relational Attributes
------------------------------------------------------------------------------

keyFetchTokenAttributes = V.fromList
  [ Attribute "token_id#" TextAtomType
  , Attribute "key" TextAtomType
  , Attribute "user" TextAtomType
  , Attribute "token" TextAtomType
  ]

keyFetchTokenMatrix = []

relvarMap :: [(RelVarName, Attributes)]
relvarMap =
  [ ( "keyFetchToken", keyFetchTokenAttributes ) ]

relvarDefinitions =
  map (\(name, attrs) -> Define name (map NakedAttributeExpr (V.toList attrs))) relvarMap

uniqueKeys = map (uncurry databaseContextExprForUniqueKey)
   [ ( "keyFetchToken", ["token_id#"] ) ]

keyFetchTokenRelations =
  relvarDefinitions ++ uniqueKeys

keyFetchTokenRelation :: Relation
keyFetchTokenRelation =
  case mkRelationFromList keyFetchTokenAttributes keyFetchTokenMatrix of
    Left err_ ->
      undefined
    Right rl ->
      rl

defineKeyFetchTokenRelation :: SessionId -> Connection -> IO (Either RelationalError ())
defineKeyFetchTokenRelation sid conn = do
  eRes <- mapM (executeDatabaseContextExpr sid conn) keyFetchTokenRelations
  handleCommit sid conn eRes

keyFetchTokenFromTuple (RelationTuple _ atoms) =
  let TextAtom tokenId = atoms ! 0
      TextAtom hmacKey = atoms ! 1
      TextAtom user = atoms ! 2
      TextAtom token = atoms ! 3
  in Token tokenId hmacKey user token

keyFetchStateFromTuple (RelationTuple _ atoms) =
  let TextAtom kA = atoms ! 4
      TextAtom wrap_kB = atoms ! 5
  in KeyFetchState kA wrap_kB

keyFetchStateFromRelation :: Relation -> Maybe KeyFetchState
keyFetchStateFromRelation r@(Relation attrNameSet tupleSet) =
  let tuples = asList tupleSet in
  if not (null tuples) then
    Just (keyFetchStateFromTuple (head tuples))
  else
    Nothing

keyFetchStatesFromRelation :: Relation -> [KeyFetchState]
keyFetchStatesFromRelation r@(Relation attrNameSet tupleSet) =
  let tuples = asList tupleSet in
  if not (null tuples) then
    map keyFetchStateFromTuple tuples
  else
    []

keyFetchTokenFromRelation :: Relation -> Maybe Token
keyFetchTokenFromRelation r@(Relation attrNameSet tupleSet) =
  let tuples = asList tupleSet in
  if not (null tuples) then
    Just $ keyFetchTokenFromTuple (head tuples)
  else
    Nothing

keyFetchTokensFromRelation :: Relation -> [Token]
keyFetchTokensFromRelation (Relation attrNameSet tupleSet) =
  let tuples = asList tupleSet in
  if not (null tuples) then
    map keyFetchTokenFromTuple tuples
  else
    []
