summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormarkfine <>2017-04-11 04:31:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-04-11 04:31:00 (GMT)
commit1bf18b12c85009eb225134f4376982e1d549d11f (patch)
tree54c919ca0ee4da90657fa9dc2896e915e1aa4edc
parentc1ec9f3b7d48aade1684072b49f60211f94d0133 (diff)
version 0.3.130.3.13
-rw-r--r--main/counter.hs30
-rw-r--r--src/Network/AWS/Wolf.hs1
-rw-r--r--src/Network/AWS/Wolf/Count.hs59
-rw-r--r--src/Network/AWS/Wolf/SWF.hs22
-rw-r--r--src/Network/AWS/Wolf/Types/Sum.hs1
-rw-r--r--wolf.cabal12
6 files changed, 122 insertions, 3 deletions
diff --git a/main/counter.hs b/main/counter.hs
new file mode 100644
index 0000000..ca88dd8
--- /dev/null
+++ b/main/counter.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Run actor.
+--
+import Network.AWS.Wolf
+import Options.Generic
+
+-- | Args
+--
+-- Program arguments.
+--
+data Args = Args
+ { config :: FilePath
+ -- ^ Configuration file.
+ , plan :: FilePath
+ -- ^ Plan file to count on.
+ } deriving (Show, Generic)
+
+instance ParseRecord Args
+
+-- | Run counter.
+--
+main :: IO ()
+main = do
+ args <- getRecord "Counter"
+ countMain
+ (config args)
+ (plan args)
diff --git a/src/Network/AWS/Wolf.hs b/src/Network/AWS/Wolf.hs
index 91efc7c..c7775d3 100644
--- a/src/Network/AWS/Wolf.hs
+++ b/src/Network/AWS/Wolf.hs
@@ -5,5 +5,6 @@ module Network.AWS.Wolf
) where
import Network.AWS.Wolf.Act as Exports
+import Network.AWS.Wolf.Count as Exports
import Network.AWS.Wolf.Decide as Exports
import Network.AWS.Wolf.Prelude as Exports
diff --git a/src/Network/AWS/Wolf/Count.hs b/src/Network/AWS/Wolf/Count.hs
new file mode 100644
index 0000000..9ff175c
--- /dev/null
+++ b/src/Network/AWS/Wolf/Count.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | SWF Counter logic.
+--
+module Network.AWS.Wolf.Count
+ ( count
+ , countMain
+ ) where
+
+import Network.AWS.Wolf.Ctx
+import Network.AWS.Wolf.File
+import Network.AWS.Wolf.Prelude
+import Network.AWS.Wolf.SWF
+import Network.AWS.Wolf.Types
+
+-- | Count pending activities.
+--
+countActivity :: MonadAmazon c m => Task -> m ()
+countActivity t = do
+ traceInfo "count-act" [ "task" .= t ]
+ let queue = t ^. tQueue
+ runAmazonWorkCtx queue $ do
+ c <- countActivities
+ traceInfo "count-acitivities" [ "task" .= t, "count" .= c ]
+ statsGauge "wolf.act.queue.depth" c [ "queue" =. queue ]
+
+-- | Count open workflows.
+--
+countDecision :: MonadAmazon c m => Task -> m ()
+countDecision t = do
+ traceInfo "count-decision" [ "task" .= t ]
+ let queue = t ^. tQueue
+ runAmazonWorkCtx queue $ do
+ c <- countDecisions
+ traceInfo "count-decisions" [ "task" .= t, "count" .= c ]
+ statsGauge "wolf.decide.queue.depth" c [ "queue" =. queue ]
+
+-- | Counter logic - count all the queues.
+--
+count :: MonadConf c m => Plan -> m ()
+count p =
+ preConfCtx [ "label" .= LabelCount ] $
+ runAmazonCtx $ do
+ countDecision (p ^. pStart)
+ mapM_ countActivity (p ^. pTasks)
+
+-- | Run counter from main with config file.
+--
+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])
diff --git a/src/Network/AWS/Wolf/SWF.hs b/src/Network/AWS/Wolf/SWF.hs
index 9224be8..2e45b2b 100644
--- a/src/Network/AWS/Wolf/SWF.hs
+++ b/src/Network/AWS/Wolf/SWF.hs
@@ -6,6 +6,8 @@
module Network.AWS.Wolf.SWF
( pollActivity
, pollDecision
+ , countActivities
+ , countDecisions
, completeActivity
, failActivity
, completeDecision
@@ -46,6 +48,24 @@ pollDecision = do
, reverse $ concatMap (view pfdtrsEvents) pfdtrs
)
+-- | Count activities.
+--
+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)
+
+-- | Count decisions.
+--
+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)
+
-- | Successful job completion.
--
completeActivity :: MonadAmazon c m => Text -> Maybe Text -> m ()
@@ -96,5 +116,3 @@ failWork =
where
fweda =
failWorkflowExecutionDecisionAttributes
-
-
diff --git a/src/Network/AWS/Wolf/Types/Sum.hs b/src/Network/AWS/Wolf/Types/Sum.hs
index 006ed72..6af1638 100644
--- a/src/Network/AWS/Wolf/Types/Sum.hs
+++ b/src/Network/AWS/Wolf/Types/Sum.hs
@@ -16,6 +16,7 @@ data LabelType
= LabelWolf
| LabelAct
| LabelDecide
+ | LabelCount
deriving (Show, Eq)
$(deriveJSON spinalOptions ''LabelType)
diff --git a/wolf.cabal b/wolf.cabal
index 74c2790..54cfadf 100644
--- a/wolf.cabal
+++ b/wolf.cabal
@@ -1,5 +1,5 @@
name: wolf
-version: 0.3.12
+version: 0.3.13
synopsis: Amazon Simple Workflow Service Wrapper.
description: Wolf is a wrapper around Amazon Simple Workflow Service.
homepage: https://github.com/swift-nav/wolf
@@ -19,6 +19,7 @@ source-repository head
library
exposed-modules: Network.AWS.Wolf
other-modules: Network.AWS.Wolf.Act
+ , Network.AWS.Wolf.Count
, Network.AWS.Wolf.Ctx
, Network.AWS.Wolf.Decide
, Network.AWS.Wolf.File
@@ -76,6 +77,15 @@ executable wolf-decider
, optparse-generic
default-language: Haskell2010
+executable wolf-counter
+ hs-source-dirs: main
+ main-is: counter.hs
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
+ build-depends: base
+ , wolf
+ , optparse-generic
+ default-language: Haskell2010
+
executable shake-wolf
main-is: Shakefile.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall