summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormarkfine <>2017-04-06 19:52:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-04-06 19:52:00 (GMT)
commit8dab682c088408662bacb49dd1e16fd9fb0d1a6e (patch)
treed64daef741350a2d925f680e5188ecb29fff47d6
parentb2631f70b50cbeee8d492f3b5ede61b4b0ab11bd (diff)
version 0.3.110.3.11
-rw-r--r--src/Network/AWS/Wolf/Act.hs22
-rw-r--r--src/Network/AWS/Wolf/Ctx.hs23
-rw-r--r--src/Network/AWS/Wolf/Decide.hs27
-rw-r--r--src/Network/AWS/Wolf/Types/Ctx.hs33
-rw-r--r--wolf.cabal2
5 files changed, 75 insertions, 32 deletions
diff --git a/src/Network/AWS/Wolf/Act.hs b/src/Network/AWS/Wolf/Act.hs
index 31b5b43..56f1e0c 100644
--- a/src/Network/AWS/Wolf/Act.hs
+++ b/src/Network/AWS/Wolf/Act.hs
@@ -10,6 +10,7 @@ module Network.AWS.Wolf.Act
) where
import Data.Aeson
+import Data.Time
import Network.AWS.Wolf.Ctx
import Network.AWS.Wolf.File
import Network.AWS.Wolf.Prelude
@@ -49,7 +50,7 @@ callCommand' command =
-- | Run command and maybe returns an exception.
--
-run :: MonadCtx c m => String -> m (Maybe SomeException)
+run :: MonadStatsCtx c m => String -> m (Maybe SomeException)
run command =
preCtx [ "command" .= command ] $ do
traceInfo "begin" mempty
@@ -65,12 +66,17 @@ act queue command =
runAmazonCtx $
runAmazonWorkCtx queue $ do
traceInfo "poll" mempty
+ t0 <- liftIO getCurrentTime
(token, uid, input) <- pollActivity
+ t1 <- liftIO getCurrentTime
+ statsCount "wolf.act.poll.count" (1 :: Int) [ "queue" =. queue ]
+ statsHistogram "wolf.act.poll.elapsed" (diffUTCTime t1 t0) [ "queue" =. queue ]
maybe_ token $ \token' ->
maybe_ uid $ \uid' ->
withCurrentWorkDirectory uid' $ \wd ->
runAmazonStoreCtx uid' $ do
traceInfo "start" [ "input" .= input, "dir" .= wd ]
+ t2 <- liftIO getCurrentTime
dd <- dataDirectory wd
sd <- storeDirectory wd
isd <- inputDirectory sd
@@ -82,14 +88,20 @@ act queue command =
upload osd
output <- readText (dd </> "output.json")
maybe (completeActivity token' output) (const $ failActivity token') e
+ t3 <- liftIO getCurrentTime
traceInfo "finish" [ "output" .= output ]
+ let status = textFromString $ maybe "complete" (const "fail") e
+ statsCount "wolf.act.activity.count" (1 :: Int) [ "queue" =. queue, "status" =. status ]
+ statsHistogram "wolf.act.activity.elapsed" (diffUTCTime t3 t2) [ "queue" =. queue ]
+
-- | Run actor from main with config file.
--
actMain :: MonadControl m => FilePath -> Text -> String -> m ()
actMain cf queue command =
runResourceT $
- runCtx $ 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/Ctx.hs b/src/Network/AWS/Wolf/Ctx.hs
index 0d7e4b3..2651640 100644
--- a/src/Network/AWS/Wolf/Ctx.hs
+++ b/src/Network/AWS/Wolf/Ctx.hs
@@ -3,9 +3,7 @@
{-# LANGUAGE OverloadedStrings #-}
module Network.AWS.Wolf.Ctx
- ( runCtx
- , preCtx
- , runConfCtx
+ ( runConfCtx
, preConfCtx
, runAmazonCtx
, preAmazonCtx
@@ -27,21 +25,22 @@ import Network.HTTP.Types
-- | Handler for exceptions, traces and rethrows.
--
-catcher :: MonadCtx c m => SomeException -> m a
+catcher :: MonadStatsCtx c m => SomeException -> m a
catcher e = do
traceError "exception" [ "error" .= displayException e ]
+ statsCount "wolf.exception" (1 :: Int) mempty
throwIO e
-- | Run configuration context.
--
-runConfCtx :: MonadCtx c m => Conf -> TransT ConfCtx m a -> m a
+runConfCtx :: MonadStatsCtx c m => Conf -> TransT ConfCtx m a -> m a
runConfCtx conf action = do
let preamble =
[ "domain" .= (conf ^. cDomain)
, "bucket" .= (conf ^. cBucket)
, "prefix" .= (conf ^. cPrefix)
]
- c <- view ctx <&> cPreamble <>~ preamble
+ c <- view statsCtx <&> cPreamble <>~ preamble
runTransT (ConfCtx c conf) $ catch action catcher
-- | Update configuration context's preamble.
@@ -82,14 +81,20 @@ preAmazonStoreCtx preamble action = do
c <- view amazonStoreCtx <&> cPreamble <>~ preamble
runTransT c $ catch action catcher
+throttled :: MonadAmazon c m => m a -> m a
+throttled action = do
+ traceError "throttled" mempty
+ statsCount "wolf.throttled" (1 :: Int) mempty
+ liftIO $ threadDelay $ 5 * 1000000
+ catch action $ throttler action
+
-- | Amazon throttle handler.
--
throttler :: MonadAmazon c m => m a -> Error -> m a
throttler action e =
case e of
- ServiceError se -> do
- let delay = liftIO $ threadDelay $ 5 * 1000000
- bool (throwIO e) (delay >> (catch action $ throttler action)) $
+ ServiceError se ->
+ bool (throwIO e) (throttled action) $
se ^. serviceStatus == badRequest400 &&
se ^. serviceCode == "Throttling"
_ ->
diff --git a/src/Network/AWS/Wolf/Decide.hs b/src/Network/AWS/Wolf/Decide.hs
index 166ce60..e3aa8e2 100644
--- a/src/Network/AWS/Wolf/Decide.hs
+++ b/src/Network/AWS/Wolf/Decide.hs
@@ -10,6 +10,7 @@ module Network.AWS.Wolf.Decide
) where
import Data.Aeson
+import Data.Time
import Data.UUID
import Data.UUID.V4
import Network.AWS.SWF
@@ -88,25 +89,35 @@ schedule = do
decide :: MonadConf c m => Plan -> m ()
decide p =
preConfCtx [ "label" .= LabelDecide ] $
- runAmazonCtx $
- runAmazonWorkCtx (p ^. pStart ^. tQueue) $ do
+ runAmazonCtx $ do
+ let queue = p ^. pStart ^. tQueue
+ runAmazonWorkCtx queue $ do
traceInfo "poll" mempty
+ t0 <- liftIO getCurrentTime
(token, hes) <- pollDecision
+ t1 <- liftIO getCurrentTime
+ statsCount "wolf.decide.poll.count" (1 :: Int) [ "queue" =. queue ]
+ statsHistogram "wolf.decide.poll.elapsed" (diffUTCTime t1 t0) [ "queue" =. queue ]
maybe_ token $ \token' ->
runAmazonDecisionCtx p hes $ do
traceInfo "start" mempty
+ t2 <- liftIO getCurrentTime
schedule >>=
completeDecision token'
+ t3 <- liftIO getCurrentTime
traceInfo "finish" mempty
+ statsCount "wolf.decide.decision.count" (1 :: Int) [ "queue" =. queue ]
+ statsHistogram "wolf.decide.decision.elapsed" (diffUTCTime t3 t2) [ "queue" =. queue ]
-- | Run decider from main with config file.
--
decideMain :: MonadControl m => FilePath -> FilePath -> m ()
decideMain cf pf =
runResourceT $
- runCtx $ 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/Types/Ctx.hs b/src/Network/AWS/Wolf/Types/Ctx.hs
index eb807a6..6d6f42f 100644
--- a/src/Network/AWS/Wolf/Types/Ctx.hs
+++ b/src/Network/AWS/Wolf/Types/Ctx.hs
@@ -17,19 +17,22 @@ import Network.AWS.Wolf.Types.Product
-- Configuration context.
--
data ConfCtx = ConfCtx
- { _ccCtx :: Ctx
+ { _ccStatsCtx :: StatsCtx
-- ^ Parent context.
- , _ccConf :: Conf
+ , _ccConf :: Conf
-- ^ Configuration parameters.
}
-$(makeClassyConstraints ''ConfCtx [''HasCtx])
+$(makeClassyConstraints ''ConfCtx [''HasStatsCtx])
+
+instance HasStatsCtx ConfCtx where
+ statsCtx = ccStatsCtx
instance HasCtx ConfCtx where
- ctx = ccCtx
+ ctx = statsCtx . ctx
type MonadConf c m =
- ( MonadCtx c m
+ ( MonadStatsCtx c m
, HasConfCtx c
)
@@ -49,8 +52,11 @@ $(makeClassyConstraints ''AmazonCtx [''HasConfCtx, ''HasEnv])
instance HasConfCtx AmazonCtx where
confCtx = acConfCtx
+instance HasStatsCtx AmazonCtx where
+ statsCtx = confCtx . statsCtx
+
instance HasCtx AmazonCtx where
- ctx = confCtx . ccCtx
+ ctx = statsCtx . ctx
instance HasEnv AmazonCtx where
environment = acEnv
@@ -82,8 +88,11 @@ instance HasAmazonCtx AmazonStoreCtx where
instance HasConfCtx AmazonStoreCtx where
confCtx = amazonCtx . acConfCtx
+instance HasStatsCtx AmazonStoreCtx where
+ statsCtx = confCtx . statsCtx
+
instance HasCtx AmazonStoreCtx where
- ctx = confCtx . ccCtx
+ ctx = statsCtx . ctx
instance HasEnv AmazonStoreCtx where
environment = amazonCtx . acEnv
@@ -112,8 +121,11 @@ instance HasAmazonCtx AmazonWorkCtx where
instance HasConfCtx AmazonWorkCtx where
confCtx = amazonCtx . acConfCtx
+instance HasStatsCtx AmazonWorkCtx where
+ statsCtx = confCtx . statsCtx
+
instance HasCtx AmazonWorkCtx where
- ctx = confCtx . ccCtx
+ ctx = statsCtx . ctx
instance HasEnv AmazonWorkCtx where
environment = amazonCtx . acEnv
@@ -144,8 +156,11 @@ instance HasAmazonCtx AmazonDecisionCtx where
instance HasConfCtx AmazonDecisionCtx where
confCtx = amazonCtx . acConfCtx
+instance HasStatsCtx AmazonDecisionCtx where
+ statsCtx = confCtx . statsCtx
+
instance HasCtx AmazonDecisionCtx where
- ctx = confCtx . ccCtx
+ ctx = statsCtx . ctx
instance HasEnv AmazonDecisionCtx where
environment = amazonCtx . acEnv
diff --git a/wolf.cabal b/wolf.cabal
index 43346af..1f213c6 100644
--- a/wolf.cabal
+++ b/wolf.cabal
@@ -1,5 +1,5 @@
name: wolf
-version: 0.3.10
+version: 0.3.11
synopsis: Amazon Simple Workflow Service Wrapper.
description: Wolf is a wrapper around Amazon Simple Workflow Service.
homepage: https://github.com/swift-nav/wolf