module Handler.Utils.Workflow.Workflow
  ( ensureScope
  , followEdge
  , followAutomaticEdges, WorkflowAutomaticEdgeException(..)
  , sourceWorkflowActionInfos
  , module Handler.Utils.Workflow.Restriction
  ) where

import Import

import Utils.Workflow
import Handler.Utils.Workflow.EdgeForm
import Handler.Utils.Workflow.Restriction

import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Data.Conduit.Combinators as C


ensureScope :: IdWorkflowScope -> CryptoFileNameWorkflowWorkflow -> MaybeT DB WorkflowWorkflowId
ensureScope wiScope cID = do
  wId <- catchMaybeT (Proxy @CryptoIDError) $ decrypt cID
  WorkflowWorkflow{..} <- MaybeT $ get wId
  let wiScope' = wiScope
        & _wisTerm   %~ unTermKey
        & _wisSchool %~ unSchoolKey
        & _wisCourse %~ view _SqlKey
  guard $ workflowWorkflowScope == wiScope'
  return wId

followEdge :: ( MonadHandler m
              , HandlerSite m ~ UniWorX
              , MonadThrow m
              )
           => IdWorkflowGraph -> WorkflowEdgeForm -> Maybe IdWorkflowState -> m IdWorkflowState
-- | Remember to invalidate auth cache
followEdge graph edgeRes cState = do
  act <- workflowEdgeFormToAction edgeRes
  followAutomaticEdges graph $ maybe id (<>) cState (act `ncons` mempty)

data WorkflowAutomaticEdgeException
  = WorkflowAutomaticEdgeCycle [(WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel)]
  | WorkflowAutomaticEdgeAmbiguity (Set (WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel))
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving anyclass (Exception)

followAutomaticEdges :: forall m.
                        ( MonadIO m
                        , MonadThrow m
                        )
                     => IdWorkflowGraph -> IdWorkflowState -> m IdWorkflowState
followAutomaticEdges WorkflowGraph{..} = go []
  where
    go :: [((WorkflowGraphNodeLabel, Set WorkflowPayloadLabel), (WorkflowGraphEdgeLabel, WorkflowGraphNodeLabel))] -- ^ Should encode all state from which automatic edges decide whether they can be followed
       -> IdWorkflowState
       -> m IdWorkflowState
    go automaticEdgesTaken history
      | null automaticEdgeOptions = return history
      | [(edgeLbl, nodeLbl)] <- automaticEdgeOptions = if
          | (edgeDecisionInput, (edgeLbl, nodeLbl)) `elem` automaticEdgesTaken
            -> throwM . WorkflowAutomaticEdgeCycle . reverse $ map (view _2) automaticEdgesTaken
          | otherwise -> do
              wpTime <- liftIO getCurrentTime
              let wpUser = Nothing
                  wpPayload = mempty
                  wpTo = nodeLbl
                  wpVia = edgeLbl
              go ((edgeDecisionInput, (edgeLbl, nodeLbl)) : automaticEdgesTaken) $ history <> (WorkflowAction{..} `ncons` mempty)
      | otherwise = throwM . WorkflowAutomaticEdgeAmbiguity $ Set.fromList automaticEdgeOptions
      where
        cState = wpTo $ last history
        automaticEdgeOptions = nub $ do
          (nodeLbl, WGN{..}) <- Map.toList wgNodes
          (edgeLbl, WorkflowGraphEdgeAutomatic{..}) <- Map.toList wgnEdges
          guard $ wgeSource == cState
          whenIsJust wgeRestriction $ guard . checkWorkflowRestriction (Just history)
          return (edgeLbl, nodeLbl)
        filledPayloads = Map.keysSet . Map.filter (not . Set.null) $ workflowStateCurrentPayloads history
        edgeDecisionInput = (cState, filledPayloads)


sourceWorkflowActionInfos
  :: forall backend m.
     ( MonadHandler m, HandlerSite m ~ UniWorX
     , BackendCompatible SqlReadBackend backend
     , MonadCrypto m, MonadCryptoKey m ~ CryptoIDKey
     , MonadCatch m, MonadUnliftIO m
     , MonadAP (ReaderT backend m)
     )
  => WorkflowWorkflowId
  -> WorkflowState FileReference UserId
  -> ConduitT () (WorkflowActionInfo FileReference UserId) (ReaderT backend m) ()
-- ^ Does `mayViewWorkflowAction`
sourceWorkflowActionInfos wwId wState = do
  mAuthId <- maybeAuthId
  let authCheck WorkflowActionInfo{..}
        = mayViewWorkflowAction mAuthId wwId waiAction
  yieldMany (workflowActionInfos wState) .| C.filterM authCheck