wolf 0.3.10 → 0.3.11

raw patch · 5 files changed

+75/−32 lines, 5 files

Files

• src/Network/AWS/Wolf/Act.hs +17/−5
• src/Network/AWS/Wolf/Ctx.hs +14/−9
• src/Network/AWS/Wolf/Decide.hs +19/−8
• src/Network/AWS/Wolf/Types/Ctx.hs +24/−9
• wolf.cabal +1/−1

@@ -10,6 +10,7 @@   ) 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 @@  -- | 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 @@     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 @@                 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

@@ -3,9 +3,7 @@ {-# LANGUAGE OverloadedStrings #-}  module Network.AWS.Wolf.Ctx-  ( runCtx-  , preCtx-  , runConfCtx+  ( runConfCtx   , preConfCtx   , runAmazonCtx   , preAmazonCtx@@ -27,21 +25,22 @@  -- | 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 @@   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"     _ ->

@@ -10,6 +10,7 @@   ) where  import Data.Aeson+import Data.Time import Data.UUID import Data.UUID.V4 import Network.AWS.SWF@@ -88,25 +89,35 @@ 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

@@ -17,19 +17,22 @@ -- 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 @@ 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 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 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 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

@@ -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