loup 0.0.4 → 0.0.5

raw patch · 5 files changed

+26/−17 lines, 5 files

Files

• loup.cabal +1/−1
• main/actor.hs +6/−0
• src/Network/AWS/Loup/Act.hs +14/−13
• src/Network/AWS/Loup/Converge.hs +4/−2
• src/Network/AWS/Loup/Decide.hs +1/−1

@@ -1,5 +1,5 @@ name:                  loup-version:               0.0.4+version:               0.0.5 synopsis:              Amazon Simple Workflow Service Wrapper for Work Pools. description:           Loup is a wrapper around Amazon Simple Workflow Service for Work Pools. homepage:              https://github.com/swift-nav/loup

@@ -16,8 +16,12 @@     -- ^ Workflow domain.   , queue    :: Text     -- ^ Queue to listen to act on.+  , count    :: Int+    -- ^ Number of actors to run concurrently.   , interval :: Int     -- ^ Interval to heartbeat at.+  , copy     :: Bool+    -- ^ Copy working directory.   , command  :: Text     -- ^ Command to run.   } deriving (Show, Generic)@@ -32,5 +36,7 @@   actMain     (domain args)     (queue args)+    (count args)     (interval args)+    (copy args)     (command args)

@@ -16,7 +16,7 @@ import Network.AWS.Loup.Prelude import Network.AWS.Loup.Types import Network.AWS.SWF-import Turtle                          hiding (input)+import Turtle                          hiding (count, input)  -- | Poll for activity. --@@ -46,12 +46,13 @@  -- | Run a managed action inside a temp directory. ---intempdir :: MonadControl m => Managed a -> m ()-intempdir action =+intempdir :: MonadControl m => Bool -> Managed a -> m ()+intempdir copy action =   bracket pwd cd $ \fromdir ->     sh $ using $ do       todir <- mktempdir "/tmp" "loup-"-      cptree fromdir todir+      when copy $+        cptree fromdir todir       cd todir       action @@ -68,29 +69,29 @@  -- | Run command with input. ---runActivity :: MonadAmazonCtx c m => Text -> Text -> Maybe Text -> m ()-runActivity token command input = do+runActivity :: MonadAmazonCtx c m => Text -> Bool -> Text -> Maybe Text -> m ()+runActivity token copy command input = do   traceInfo "run" [ "command" .= command, "input" .= input]-  intempdir $ do+  intempdir copy $ do     liftIO $ maybe_ input $ writeTextFile "input.json"     stderr $ inshell command mempty   failActivity token  -- | Actor logic - poll for work, download artifacts, run command, upload artifacts. ---act :: MonadAmazonCtx c m => Text -> Text -> Int -> Text -> m ()-act domain queue interval command =+act :: MonadAmazonCtx c m => Text -> Text -> Int -> Bool -> Text -> m ()+act domain queue interval copy command =   preAmazonCtx [ "label" .= LabelAct, "domain" .= domain, "queue" .= queue ] $ do     traceInfo "poll" mempty     (token, input) <- pollActivity domain (taskList queue)     maybe_ token $ \token' -> do       traceInfo "start" mempty-      race_ (runHeartbeat token' interval) (runActivity token' command input)+      race_ (runHeartbeat token' interval) (runActivity token' copy command input)       traceInfo "finish" mempty  -- | Run actor from main with configuration. ---actMain :: MonadControl m => Text -> Text -> Int -> Text -> m ()-actMain domain queue interval command =+actMain :: MonadControl m => Text -> Text -> Int -> Int -> Bool -> Text -> m ()+actMain domain queue count interval copy command =   runResourceT $ runCtx $ runStatsCtx $ runAmazonCtx $-    forever $ act domain queue interval command+    runConcurrent $ replicate count $ forever $ act domain queue interval copy command

@@ -47,11 +47,13 @@ -- converge :: MonadAmazonCtx c m => Text -> Pool -> m () converge domain pool =-  preAmazonCtx [ "label" .= LabelDecide, "domain" .= domain, "pool" .= pool ] $ do+  preAmazonCtx [ "label" .= LabelDecide, "domain" .= domain ] $ do     let activity = pool ^. pTask ^. tActivityType     wids <- fromList <$> listWorkflows domain activity     let fold kvs as action = do-          let g k v bs = if k `member` bs then return $ k `delete` bs else action k v >> return bs+          let g k v bs = do+                let k' = k -.- show (hash v)+                if k' `member` bs then return $ k' `delete` bs else action k' v >> return bs           ifoldrM g as kvs     wids' <- fold (pool ^. pWorkers) wids $ \wid input -> do       traceInfo "start" [ "wid" .= wid, "input" .= input ]

@@ -147,7 +147,7 @@ -- decide :: MonadAmazonCtx c m => Text -> Plan -> m () decide domain plan =-  preAmazonCtx [ "label" .= LabelDecide, "domain" .= domain, "plan" .= plan ] $ do+  preAmazonCtx [ "label" .= LabelDecide, "domain" .= domain ] $ do     traceInfo "poll" mempty     (token, events) <- pollDecision domain (plan ^. pDecisionTask ^. tTaskList)     maybe_ token $ \token' -> do