summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormarkfine <>2017-06-23 07:55:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-06-23 07:55:00 (GMT)
commita9edd65fc9f175350fe962efba65b4636e80afcd (patch)
treec72b2b4c0eedf18a9cd4a18009048e61489e6892
parentdd8fdf57fb3d7173b3fba660e3b880328be81627 (diff)
version 0.3.190.3.19
-rw-r--r--src/Network/AWS/Wolf/Act.hs13
-rw-r--r--src/Network/AWS/Wolf/Count.hs17
-rw-r--r--src/Network/AWS/Wolf/Ctx.hs20
-rw-r--r--src/Network/AWS/Wolf/Decide.hs15
-rw-r--r--src/Network/AWS/Wolf/Prelude.hs1
-rw-r--r--src/Network/AWS/Wolf/SWF.hs54
-rw-r--r--src/Network/AWS/Wolf/Types/Ctx.hs52
-rw-r--r--wolf.cabal4
8 files changed, 80 insertions, 96 deletions
diff --git a/src/Network/AWS/Wolf/Act.hs b/src/Network/AWS/Wolf/Act.hs
index 37931b9..0366be3 100644
--- a/src/Network/AWS/Wolf/Act.hs
+++ b/src/Network/AWS/Wolf/Act.hs
@@ -47,7 +47,7 @@ upload dir = do
-- | callCommand wrapper that maybe returns an exception.
--
-callCommand' :: MonadMain m => String -> m (Maybe SomeException)
+callCommand' :: MonadControl m => String -> m (Maybe SomeException)
callCommand' command =
handle (return . Just) $ do
liftIO $ callCommand command
@@ -104,9 +104,8 @@ act queue command =
--
actMain :: MonadControl m => FilePath -> Text -> String -> m ()
actMain cf queue command =
- runResourceT $
- runCtx $
- runStatsCtx $ do
- conf <- readYaml cf
- runConfCtx conf $
- forever $ act queue command
+ runCtx $
+ runStatsCtx $ do
+ conf <- readYaml cf
+ runConfCtx conf $
+ forever $ act queue command
diff --git a/src/Network/AWS/Wolf/Count.hs b/src/Network/AWS/Wolf/Count.hs
index 9ff175c..277dd63 100644
--- a/src/Network/AWS/Wolf/Count.hs
+++ b/src/Network/AWS/Wolf/Count.hs
@@ -17,7 +17,7 @@ import Network.AWS.Wolf.Types
-- | Count pending activities.
--
-countActivity :: MonadAmazon c m => Task -> m ()
+countActivity :: MonadConf c m => Task -> m ()
countActivity t = do
traceInfo "count-act" [ "task" .= t ]
let queue = t ^. tQueue
@@ -28,7 +28,7 @@ countActivity t = do
-- | Count open workflows.
--
-countDecision :: MonadAmazon c m => Task -> m ()
+countDecision :: MonadConf c m => Task -> m ()
countDecision t = do
traceInfo "count-decision" [ "task" .= t ]
let queue = t ^. tQueue
@@ -50,10 +50,9 @@ count p =
--
countMain :: MonadControl m => FilePath -> FilePath -> m ()
countMain cf pf =
- runResourceT $
- runCtx $
- runStatsCtx $ do
- conf <- readYaml cf
- runConfCtx conf $ do
- plans <- readYaml pf
- mapM_ count (plans :: [Plan])
+ runCtx $
+ runStatsCtx $ do
+ conf <- readYaml cf
+ runConfCtx conf $ do
+ plans <- readYaml pf
+ mapM_ count (plans :: [Plan])
diff --git a/src/Network/AWS/Wolf/Ctx.hs b/src/Network/AWS/Wolf/Ctx.hs
index 84458ec..fa1fa74 100644
--- a/src/Network/AWS/Wolf/Ctx.hs
+++ b/src/Network/AWS/Wolf/Ctx.hs
@@ -47,12 +47,12 @@ topSomeExceptionCatch ex = do
-- | Run bottom TransT.
--
-runBotTransT :: (MonadMain m, HasCtx c) => c -> TransT c m a -> m a
+runBotTransT :: (MonadControl m, HasCtx c) => c -> TransT c m a -> m a
runBotTransT c action = runTransT c $ catches action [ Handler botErrorCatch, Handler botSomeExceptionCatch ]
-- | Run top TransT.
--
-runTopTransT :: (MonadMain m, HasStatsCtx c) => c -> TransT c m a -> m a
+runTopTransT :: (MonadControl m, HasStatsCtx c) => c -> TransT c m a -> m a
runTopTransT c action = runBotTransT c $ catch action topSomeExceptionCatch
-- | Run configuration context.
@@ -84,16 +84,16 @@ runAmazonCtx action = do
-- | Run amazon store context.
--
-runAmazonStoreCtx :: MonadAmazon c m => Text -> TransT AmazonStoreCtx m a -> m a
+runAmazonStoreCtx :: MonadConf c m => Text -> TransT AmazonStoreCtx m a -> m a
runAmazonStoreCtx uid action = do
let preamble = [ "uid" .= uid ]
- c <- view amazonCtx <&> cPreamble <>~ preamble
+ c <- view confCtx <&> cPreamble <>~ preamble
p <- (-/- uid) . view cPrefix <$> view ccConf
runBotTransT (AmazonStoreCtx c uid p) action
-- | Throttle throttle exceptions.
--
-throttled :: MonadAmazon c m => m a -> m a
+throttled :: MonadStatsCtx c m => m a -> m a
throttled action = do
traceError "throttled" mempty
statsIncrement "wolf.throttled" mempty
@@ -102,7 +102,7 @@ throttled action = do
-- | Amazon throttle handler.
--
-throttler :: MonadAmazon c m => m a -> Error -> m a
+throttler :: MonadStatsCtx c m => m a -> Error -> m a
throttler action e =
case e of
ServiceError se ->
@@ -114,16 +114,16 @@ throttler action e =
-- | Run amazon work context.
--
-runAmazonWorkCtx :: MonadAmazon c m => Text -> TransT AmazonWorkCtx m a -> m a
+runAmazonWorkCtx :: MonadConf c m => Text -> TransT AmazonWorkCtx m a -> m a
runAmazonWorkCtx queue action = do
let preamble = [ "queue" .= queue ]
- c <- view amazonCtx <&> cPreamble <>~ preamble
+ c <- view confCtx <&> cPreamble <>~ preamble
runBotTransT (AmazonWorkCtx c queue) (catch action $ throttler action)
-- | Run amazon decision context.
--
-runAmazonDecisionCtx :: MonadAmazon c m => Plan -> [HistoryEvent] -> TransT AmazonDecisionCtx m a -> m a
+runAmazonDecisionCtx :: MonadConf c m => Plan -> [HistoryEvent] -> TransT AmazonDecisionCtx m a -> m a
runAmazonDecisionCtx p hes action = do
let preamble = [ "name" .= (p ^. pStart ^. tName) ]
- c <- view amazonCtx <&> cPreamble <>~ preamble
+ c <- view confCtx <&> cPreamble <>~ preamble
runBotTransT (AmazonDecisionCtx c p hes) action
diff --git a/src/Network/AWS/Wolf/Decide.hs b/src/Network/AWS/Wolf/Decide.hs
index 13709da..f42a732 100644
--- a/src/Network/AWS/Wolf/Decide.hs
+++ b/src/Network/AWS/Wolf/Decide.hs
@@ -113,11 +113,10 @@ decide p =
--
decideMain :: MonadControl m => FilePath -> FilePath -> m ()
decideMain cf pf =
- runResourceT $
- runCtx $
- runStatsCtx $ do
- conf <- readYaml cf
- runConfCtx conf $ do
- plans <- readYaml pf
- runConcurrent $
- forever . decide <$> plans
+ runCtx $
+ runStatsCtx $ do
+ conf <- readYaml cf
+ runConfCtx conf $ do
+ plans <- readYaml pf
+ runConcurrent $
+ forever . decide <$> plans
diff --git a/src/Network/AWS/Wolf/Prelude.hs b/src/Network/AWS/Wolf/Prelude.hs
index a21a507..8b7cfc8 100644
--- a/src/Network/AWS/Wolf/Prelude.hs
+++ b/src/Network/AWS/Wolf/Prelude.hs
@@ -10,7 +10,6 @@ module Network.AWS.Wolf.Prelude
) where
import Control.Concurrent.Async.Lifted
-import Control.Monad.Trans.Control
import Preamble as Exports
-- | Run a list of actions concurrently.
diff --git a/src/Network/AWS/Wolf/SWF.hs b/src/Network/AWS/Wolf/SWF.hs
index 2e45b2b..8135fc0 100644
--- a/src/Network/AWS/Wolf/SWF.hs
+++ b/src/Network/AWS/Wolf/SWF.hs
@@ -20,6 +20,7 @@ import Control.Monad.Trans.AWS
import Data.Conduit
import Data.Conduit.List hiding (concatMap, map)
import Network.AWS.SWF
+import Network.AWS.Wolf.Ctx
import Network.AWS.Wolf.Prelude
import Network.AWS.Wolf.Types
@@ -27,14 +28,15 @@ 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
- pfatrs <- send (pollForActivityTask d tl)
- return
- ( pfatrs ^. pfatrsTaskToken
- , view weWorkflowId <$> pfatrs ^. pfatrsWorkflowExecution
- , pfatrs ^. pfatrsInput
- )
+ d <- view cDomain <$> view ccConf
+ tl <- taskList <$> view awcQueue
+ runResourceT $ runAmazonCtx $ do
+ pfatrs <- send (pollForActivityTask d tl)
+ return
+ ( pfatrs ^. pfatrsTaskToken
+ , view weWorkflowId <$> pfatrs ^. pfatrsWorkflowExecution
+ , pfatrs ^. pfatrsInput
+ )
-- | Poll for decisions.
--
@@ -42,11 +44,12 @@ pollDecision :: MonadAmazonWork c m => m (Maybe Text, [HistoryEvent])
pollDecision = do
d <- view cDomain <$> view ccConf
tl <- taskList <$> view awcQueue
- pfdtrs <- paginate (pollForDecisionTask d tl) $$ consume
- return
- ( join $ headMay $ map (view pfdtrsTaskToken) pfdtrs
- , reverse $ concatMap (view pfdtrsEvents) pfdtrs
- )
+ runResourceT $ runAmazonCtx $ do
+ pfdtrs <- paginate (pollForDecisionTask d tl) $$ consume
+ return
+ ( join $ headMay $ map (view pfdtrsTaskToken) pfdtrs
+ , reverse $ concatMap (view pfdtrsEvents) pfdtrs
+ )
-- | Count activities.
--
@@ -54,8 +57,9 @@ countActivities :: MonadAmazonWork c m => m Int
countActivities = do
d <- view cDomain <$> view ccConf
tl <- taskList <$> view awcQueue
- ptc <- send (countPendingActivityTasks d tl)
- return $ fromIntegral (ptc ^. ptcCount)
+ runResourceT $ runAmazonCtx $ do
+ ptc <- send (countPendingActivityTasks d tl)
+ return $ fromIntegral (ptc ^. ptcCount)
-- | Count decisions.
--
@@ -63,26 +67,30 @@ countDecisions :: MonadAmazonWork c m => m Int
countDecisions = do
d <- view cDomain <$> view ccConf
tl <- taskList <$> view awcQueue
- ptc <- send (countPendingDecisionTasks d tl)
- return $ fromIntegral (ptc ^. ptcCount)
+ runResourceT $ runAmazonCtx $ do
+ ptc <- send (countPendingDecisionTasks d tl)
+ return $ fromIntegral (ptc ^. ptcCount)
-- | Successful job completion.
--
-completeActivity :: MonadAmazon c m => Text -> Maybe Text -> m ()
+completeActivity :: MonadConf c m => Text -> Maybe Text -> m ()
completeActivity token output =
- void $ send $ set ratcResult output $ respondActivityTaskCompleted token
+ runResourceT $ runAmazonCtx $
+ void $ send $ set ratcResult output $ respondActivityTaskCompleted token
-- | Job failure.
--
-failActivity :: MonadAmazon c m => Text -> m ()
+failActivity :: MonadConf c m => Text -> m ()
failActivity token =
- void $ send $ respondActivityTaskFailed token
+ runResourceT $ runAmazonCtx $
+ void $ send $ respondActivityTaskFailed token
-- | Successful decision completion.
--
-completeDecision :: MonadAmazon c m => Text -> Decision -> m ()
+completeDecision :: MonadConf c m => Text -> Decision -> m ()
completeDecision token d =
- void $ send $ set rdtcDecisions (return d) $ respondDecisionTaskCompleted token
+ runResourceT $ runAmazonCtx $
+ void $ send $ set rdtcDecisions (return d) $ respondDecisionTaskCompleted token
-- | Schedule decision.
--
diff --git a/src/Network/AWS/Wolf/Types/Ctx.hs b/src/Network/AWS/Wolf/Types/Ctx.hs
index 6d6f42f..a324afa 100644
--- a/src/Network/AWS/Wolf/Types/Ctx.hs
+++ b/src/Network/AWS/Wolf/Types/Ctx.hs
@@ -72,21 +72,18 @@ type MonadAmazon c m =
-- Amazon store context.
--
data AmazonStoreCtx = AmazonStoreCtx
- { _ascAmazonCtx :: AmazonCtx
+ { _ascConfCtx :: ConfCtx
-- ^ Parent context.
- , _ascUid :: Text
+ , _ascUid :: Text
-- ^ Workflow uid.
- , _ascPrefix :: Text
+ , _ascPrefix :: Text
-- ^ Object prefix.
}
-$(makeClassyConstraints ''AmazonStoreCtx [''HasAmazonCtx])
-
-instance HasAmazonCtx AmazonStoreCtx where
- amazonCtx = ascAmazonCtx
+$(makeClassyConstraints ''AmazonStoreCtx [''HasConfCtx])
instance HasConfCtx AmazonStoreCtx where
- confCtx = amazonCtx . acConfCtx
+ confCtx = ascConfCtx
instance HasStatsCtx AmazonStoreCtx where
statsCtx = confCtx . statsCtx
@@ -94,11 +91,8 @@ instance HasStatsCtx AmazonStoreCtx where
instance HasCtx AmazonStoreCtx where
ctx = statsCtx . ctx
-instance HasEnv AmazonStoreCtx where
- environment = amazonCtx . acEnv
-
type MonadAmazonStore c m =
- ( MonadAmazon c m
+ ( MonadConf c m
, HasAmazonStoreCtx c
)
@@ -107,19 +101,16 @@ type MonadAmazonStore c m =
-- Amazon work context.
--
data AmazonWorkCtx = AmazonWorkCtx
- { _awcAmazonCtx :: AmazonCtx
+ { _awcConfCtx :: ConfCtx
-- ^ Parent context.
- , _awcQueue :: Text
+ , _awcQueue :: Text
-- ^ Workflow queue.
}
-$(makeClassyConstraints ''AmazonWorkCtx [''HasAmazonCtx])
-
-instance HasAmazonCtx AmazonWorkCtx where
- amazonCtx = awcAmazonCtx
+$(makeClassyConstraints ''AmazonWorkCtx [''HasConfCtx])
instance HasConfCtx AmazonWorkCtx where
- confCtx = amazonCtx . acConfCtx
+ confCtx = awcConfCtx
instance HasStatsCtx AmazonWorkCtx where
statsCtx = confCtx . statsCtx
@@ -127,11 +118,8 @@ instance HasStatsCtx AmazonWorkCtx where
instance HasCtx AmazonWorkCtx where
ctx = statsCtx . ctx
-instance HasEnv AmazonWorkCtx where
- environment = amazonCtx . acEnv
-
type MonadAmazonWork c m =
- ( MonadAmazon c m
+ ( MonadConf c m
, HasAmazonWorkCtx c
)
@@ -140,21 +128,18 @@ type MonadAmazonWork c m =
-- Amazon decision context.
--
data AmazonDecisionCtx = AmazonDecisionCtx
- { _adcAmazonCtx :: AmazonCtx
+ { _adcConfCtx :: ConfCtx
-- ^ Parent context.
- , _adcPlan :: Plan
+ , _adcPlan :: Plan
-- ^ Decision plan.
- , _adcEvents :: [HistoryEvent]
+ , _adcEvents :: [HistoryEvent]
-- ^ History events.
}
-$(makeClassyConstraints ''AmazonDecisionCtx [''HasAmazonCtx])
-
-instance HasAmazonCtx AmazonDecisionCtx where
- amazonCtx = adcAmazonCtx
+$(makeClassyConstraints ''AmazonDecisionCtx [''HasConfCtx])
instance HasConfCtx AmazonDecisionCtx where
- confCtx = amazonCtx . acConfCtx
+ confCtx = adcConfCtx
instance HasStatsCtx AmazonDecisionCtx where
statsCtx = confCtx . statsCtx
@@ -162,11 +147,8 @@ instance HasStatsCtx AmazonDecisionCtx where
instance HasCtx AmazonDecisionCtx where
ctx = statsCtx . ctx
-instance HasEnv AmazonDecisionCtx where
- environment = amazonCtx . acEnv
-
type MonadAmazonDecision c m =
- ( MonadAmazon c m
+ ( MonadConf c m
, HasAmazonDecisionCtx c
)
diff --git a/wolf.cabal b/wolf.cabal
index 6003668..dba8092 100644
--- a/wolf.cabal
+++ b/wolf.cabal
@@ -1,5 +1,5 @@
name: wolf
-version: 0.3.18
+version: 0.3.19
synopsis: Amazon Simple Workflow Service Wrapper.
description: Wolf is a wrapper around Amazon Simple Workflow Service.
homepage: https://github.com/swift-nav/wolf
@@ -45,10 +45,8 @@ library
, http-types
, lifted-async
, lifted-base
- , monad-control
, preamble
, process
- , resourcet
, time
, uuid
, yaml