module Utils.Workflow
  ( RouteWorkflowScope, DBWorkflowScope, IdWorkflowScope, CryptoIDWorkflowScope
  , _DBWorkflowScope
  , fromRouteWorkflowScope, toRouteWorkflowScope
  , DBWorkflowGraph, IdWorkflowGraph
  , _DBWorkflowGraph
  , DBWorkflowState, IdWorkflowState
  , _DBWorkflowState
  , decryptWorkflowStateIndex, encryptWorkflowStateIndex
  , isTopWorkflowScope
  ) where

import Import.NoFoundation

import qualified Data.CryptoID.Class.ImplicitNamespace as I
import qualified Crypto.MAC.KMAC as Crypto
import qualified Data.ByteArray as BA
import qualified Data.Binary as Binary
import Crypto.Hash.Algorithms (SHAKE256)
import Language.Haskell.TH (nameBase)


type RouteWorkflowScope = WorkflowScope TermId SchoolId (TermId, SchoolId, CourseShorthand)
type DBWorkflowScope = WorkflowScope TermIdentifier SchoolShorthand SqlBackendKey
type IdWorkflowScope = WorkflowScope TermId SchoolId CourseId
type CryptoIDWorkflowScope = WorkflowScope TermId SchoolId CryptoUUIDCourse


_DBWorkflowScope :: Iso' IdWorkflowScope DBWorkflowScope
_DBWorkflowScope = iso toScope' toScope
  where
    toScope' scope = scope
      & over (typesCustom @WorkflowChildren @(WorkflowScope TermId SchoolId CourseId) @(WorkflowScope TermIdentifier SchoolId CourseId)) unTermKey
      & over (typesCustom @WorkflowChildren @(WorkflowScope TermIdentifier SchoolId CourseId) @(WorkflowScope TermIdentifier SchoolShorthand CourseId)) unSchoolKey
      & over (typesCustom @WorkflowChildren @(WorkflowScope TermIdentifier SchoolShorthand CourseId) @(WorkflowScope TermIdentifier SchoolShorthand SqlBackendKey) @CourseId @SqlBackendKey) (view _SqlKey)
    toScope scope' = scope'
      & over (typesCustom @WorkflowChildren @(WorkflowScope TermIdentifier SchoolShorthand SqlBackendKey) @(WorkflowScope TermId SchoolShorthand SqlBackendKey)) TermKey
      & over (typesCustom @WorkflowChildren @(WorkflowScope TermId SchoolShorthand SqlBackendKey) @(WorkflowScope TermId SchoolId SqlBackendKey)) SchoolKey
      & over (typesCustom @WorkflowChildren @(WorkflowScope TermId SchoolId SqlBackendKey) @(WorkflowScope TermId SchoolId CourseId) @SqlBackendKey @CourseId) (review _SqlKey)

fromRouteWorkflowScope :: ( MonadIO m
                          , BackendCompatible SqlReadBackend backend
                          )
                       => RouteWorkflowScope
                       -> MaybeT (ReaderT backend m) IdWorkflowScope
fromRouteWorkflowScope rScope = hoist (withReaderT $ projectBackend @SqlReadBackend) . forOf (typesCustom @WorkflowChildren @(WorkflowScope TermId SchoolId (TermId, SchoolId, CourseShorthand)) @(WorkflowScope TermId SchoolId CourseId) @(TermId, SchoolId, CourseShorthand) @CourseId) rScope $ \(tid, ssh, csh) -> MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh

toRouteWorkflowScope :: ( MonadIO m
                        , BackendCompatible SqlReadBackend backend
                        )
                     => IdWorkflowScope
                     -> MaybeT (ReaderT backend m) RouteWorkflowScope
toRouteWorkflowScope scope = hoist (withReaderT $ projectBackend @SqlReadBackend) . forOf (typesCustom @WorkflowChildren @(WorkflowScope TermId SchoolId CourseId) @(WorkflowScope TermId SchoolId (TermId, SchoolId, CourseShorthand)) @CourseId @(TermId, SchoolId, CourseShorthand)) scope $ \cId -> MaybeT (get cId) <&> \Course{..} -> (courseTerm, courseSchool, courseShorthand)


type IdWorkflowGraph = WorkflowGraph FileReference UserId
type DBWorkflowGraph = WorkflowGraph FileReference SqlBackendKey


_DBWorkflowGraph :: Iso' IdWorkflowGraph DBWorkflowGraph
_DBWorkflowGraph = iso toDB fromDB
  where
    toDB = over (typesCustom @WorkflowChildren @(WorkflowGraph FileReference UserId) @(WorkflowGraph FileReference SqlBackendKey) @UserId @SqlBackendKey) (view _SqlKey)
    fromDB = over (typesCustom @WorkflowChildren @(WorkflowGraph FileReference SqlBackendKey) @(WorkflowGraph FileReference UserId) @SqlBackendKey @UserId) (review _SqlKey)


type IdWorkflowState = WorkflowState FileReference UserId
type DBWorkflowState = WorkflowState FileReference SqlBackendKey
  

_DBWorkflowState :: Iso' IdWorkflowState DBWorkflowState
_DBWorkflowState = iso toDB fromDB
  where
    toDB = over (typesCustom @WorkflowChildren @(WorkflowState FileReference UserId) @(WorkflowState FileReference SqlBackendKey) @UserId @SqlBackendKey) (view _SqlKey)
    fromDB = over (typesCustom @WorkflowChildren @(WorkflowState FileReference SqlBackendKey) @(WorkflowState FileReference UserId) @SqlBackendKey @UserId) (review _SqlKey)


data WorkflowStateIndexKeyException
  = WorkflowStateIndexCryptoIDKeyCouldNotDecodeRandom
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving anyclass (Exception)
  
workflowStateIndexCryptoIDKey :: (MonadCrypto m, MonadCryptoKey m ~ CryptoIDKey) => WorkflowWorkflowId -> m CryptoIDKey
workflowStateIndexCryptoIDKey wwId = cryptoIDKey $ \cIDKey -> either (const $ throwM WorkflowStateIndexCryptoIDKeyCouldNotDecodeRandom) (views _3 return) . Binary.decodeOrFail . fromStrict . BA.convert $
  Crypto.kmac @(SHAKE256 CryptoIDCipherKeySize) (encodeUtf8 . (pack :: String -> Text) $ nameBase 'workflowStateIndexCryptoIDKey) (toStrict $ Binary.encode wwId) cIDKey
  
encryptWorkflowStateIndex :: ( MonadCrypto m
                             , MonadCryptoKey m ~ CryptoIDKey
                             , MonadHandler m
                             )
                          => WorkflowWorkflowId -> WorkflowStateIndex -> m CryptoUUIDWorkflowStateIndex
encryptWorkflowStateIndex wwId stIx = do
  cIDKey <- workflowStateIndexCryptoIDKey wwId
  $cachedHereBinary (wwId, stIx) . flip runReaderT cIDKey $ I.encrypt stIx
  
decryptWorkflowStateIndex :: ( MonadCrypto m
                             , MonadCryptoKey m ~ CryptoIDKey
                             , MonadHandler m
                             )
                          => WorkflowWorkflowId -> CryptoUUIDWorkflowStateIndex -> m WorkflowStateIndex
decryptWorkflowStateIndex wwId cID = do
  cIDKey <- workflowStateIndexCryptoIDKey wwId
  $cachedHereBinary (wwId, cID) . flip runReaderT cIDKey $ I.decrypt cID


isTopWorkflowScope :: WorkflowScope termid schoolid courseid -> Bool
isTopWorkflowScope = (`elem` [WSGlobal', WSTerm', WSSchool', WSTermSchool']) . classifyWorkflowScope