{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Network.AWS.Wolf.SWF
( pollActivity
, pollDecision
, countActivities
, countDecisions
, completeActivity
, failActivity
, completeDecision
, scheduleWork
, completeWork
, failWork
) where
import Control.Monad.Trans.AWS
import Data.Conduit
import Data.Conduit.List hiding (concatMap)
import Network.AWS.SWF
import Network.AWS.Wolf.Ctx
import Network.AWS.Wolf.Prelude
import Network.AWS.Wolf.Types
pollActivity :: MonadAmazonWork c m => m (Maybe Text, Maybe Text, Maybe Text)
pollActivity = do
d <- view cDomain <$> view ccConf
tl <- taskList <$> view awcQueue
runResourceT $ runAmazonCtx $ do
pfatrs <- send (pollForActivityTask d tl)
pure
( pfatrs ^. pfatrsTaskToken
, view weWorkflowId <$> pfatrs ^. pfatrsWorkflowExecution
, pfatrs ^. pfatrsInput
)
pollDecision :: MonadAmazonWork c m => m (Maybe Text, [HistoryEvent])
pollDecision = do
d <- view cDomain <$> view ccConf
tl <- taskList <$> view awcQueue
runResourceT $ runAmazonCtx $ do
pfdtrs <- paginate (pollForDecisionTask d tl) $$ consume
pure
( join $ headMay $ view pfdtrsTaskToken <$> pfdtrs
, reverse $ concatMap (view pfdtrsEvents) pfdtrs
)
countActivities :: MonadAmazonWork c m => m Int
countActivities = do
d <- view cDomain <$> view ccConf
tl <- taskList <$> view awcQueue
runResourceT $ runAmazonCtx $ do
ptc <- send (countPendingActivityTasks d tl)
pure $ fromIntegral (ptc ^. ptcCount)
countDecisions :: MonadAmazonWork c m => m Int
countDecisions = do
d <- view cDomain <$> view ccConf
tl <- taskList <$> view awcQueue
runResourceT $ runAmazonCtx $ do
ptc <- send (countPendingDecisionTasks d tl)
pure $ fromIntegral (ptc ^. ptcCount)
completeActivity :: MonadConf c m => Text -> Maybe Text -> m ()
completeActivity token output =
runResourceT $ runAmazonCtx $
void $ send $ set ratcResult output $ respondActivityTaskCompleted token
failActivity :: MonadConf c m => Text -> m ()
failActivity token =
runResourceT $ runAmazonCtx $
void $ send $ respondActivityTaskFailed token
completeDecision :: MonadConf c m => Text -> Decision -> m ()
completeDecision token d =
runResourceT $ runAmazonCtx $
void $ send $ set rdtcDecisions (pure d) $ respondDecisionTaskCompleted token
scheduleWork :: Text -> Text -> Text -> Text -> Maybe Text -> Maybe Text -> Decision
scheduleWork uid name version queue input priority =
decision ScheduleActivityTask &
dScheduleActivityTaskDecisionAttributes .~ pure satda
where
satda =
scheduleActivityTaskDecisionAttributes (activityType name version) uid &
satdaTaskList .~ pure (taskList queue) &
satdaInput .~ input &
satdaTaskPriority .~ priority
completeWork :: Maybe Text -> Decision
completeWork input =
decision CompleteWorkflowExecution &
dCompleteWorkflowExecutionDecisionAttributes .~ pure cweda
where
cweda =
completeWorkflowExecutionDecisionAttributes &
cwedaResult .~ input
failWork :: Decision
failWork =
decision FailWorkflowExecution &
dFailWorkflowExecutionDecisionAttributes .~ pure fweda
where
fweda =
failWorkflowExecutionDecisionAttributes