module Utils.Workflow
  ( RouteWorkflowScope, DBWorkflowScope, IdWorkflowScope, CryptoIDWorkflowScope
  , _DBWorkflowScope
  , fromRouteWorkflowScope, toRouteWorkflowScope
  , DBWorkflowGraph, IdWorkflowGraph
  , _DBWorkflowGraph
  , DBWorkflowState, IdWorkflowState
  , _DBWorkflowState
  , DBWorkflowAction, IdWorkflowAction
  , decryptWorkflowStateIndex, encryptWorkflowStateIndex
  , isTopWorkflowScope, isTopWorkflowScopeSql
  , selectWorkflowInstanceDescription
  , SharedWorkflowGraphException(..), getSharedDBWorkflowGraph, getSharedIdWorkflowGraph
  , insertSharedWorkflowGraph
  ) 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 qualified Crypto.Hash as Crypto
import Language.Haskell.TH (nameBase)
import qualified Data.Aeson as Aeson

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E

{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}


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)

type IdWorkflowAction = WorkflowAction FileReference UserId
type DBWorkflowAction = WorkflowAction FileReference SqlBackendKey


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

isTopWorkflowScopeSql :: E.SqlExpr (E.Value DBWorkflowScope) -> E.SqlExpr (E.Value Bool)
isTopWorkflowScopeSql = (`E.in_` E.valList [WSGlobal', WSTerm', WSSchool', WSTermSchool']) . classifyWorkflowScopeSql
  where classifyWorkflowScopeSql = (E.->. "tag")


selectWorkflowInstanceDescription :: ( MonadHandler m
                                     , BackendCompatible SqlReadBackend backend
                                     )
                                  => WorkflowInstanceId
                                  -> ReaderT backend m (Maybe (Entity WorkflowInstanceDescription))
selectWorkflowInstanceDescription wiId = withReaderT (projectBackend @SqlReadBackend) $ do
  descLangs <- E.select . E.from $ \workflowInstanceDescription -> do
    E.where_ $ workflowInstanceDescription E.^. WorkflowInstanceDescriptionInstance E.==. E.val wiId
    return $ workflowInstanceDescription E.^. WorkflowInstanceDescriptionLanguage
  descLang <- traverse selectLanguage . nonEmpty $ E.unValue <$> descLangs
  fmap join . for descLang $ \descLang' -> getBy $ UniqueWorkflowInstanceDescription wiId descLang'


data SharedWorkflowGraphException
  = SharedWorkflowGraphNotFound SharedWorkflowGraphId
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving anyclass (Exception)
  
getSharedDBWorkflowGraph :: ( MonadHandler m
                            , BackendCompatible SqlReadBackend backend
                            )
                         => SharedWorkflowGraphId
                         -> ReaderT backend m DBWorkflowGraph
getSharedDBWorkflowGraph swgId = $cachedHereBinary swgId . withReaderT (projectBackend @SqlReadBackend) $ do
  maybe (liftHandler . throwM $ SharedWorkflowGraphNotFound swgId) (return . sharedWorkflowGraphGraph) =<< get swgId
  
getSharedIdWorkflowGraph :: ( MonadHandler m
                            , BackendCompatible SqlReadBackend backend
                            )
                         => SharedWorkflowGraphId
                         -> ReaderT backend m IdWorkflowGraph
getSharedIdWorkflowGraph = fmap (review _DBWorkflowGraph) . getSharedDBWorkflowGraph

insertSharedWorkflowGraph :: ( MonadIO m
                             , BackendCompatible SqlBackend backend
                             )
                          => DBWorkflowGraph
                          -> ReaderT backend m SharedWorkflowGraphId
insertSharedWorkflowGraph graph = withReaderT (projectBackend @SqlBackend) $
    swgId' <$ repsert swgId' (SharedWorkflowGraph swgId graph)
  where
    swgId = WorkflowGraphReference . Crypto.hashlazy $ Aeson.encode graph
    swgId' = SharedWorkflowGraphKey swgId
