wolf 0.2.7 → 0.2.8
raw patch · 4 files changed
+50/−42 lines, 4 files
Files
- main/Act.hs +28/−22
- main/Act2.hs +14/−9
- src/Network/AWS/Flow.hs +7/−10
- wolf.cabal +1/−1
main/Act.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-} module Act ( main ) where@@ -74,16 +75,19 @@ encodeText :: ToJSON a => a -> Text encodeText = toStrict . toLazyText . encodeToTextBuilder . toJSON -exec :: MonadIO m => Args -> Container -> Uid -> Metadata -> [Blob] -> m (Metadata, [Artifact])+handler :: MonadBaseControl IO m => m () -> m (Maybe SomeException)+handler a = handle (return . Just) $ a >> return Nothing++exec :: MonadIO m => Args -> Container -> Uid -> Metadata -> [Blob] -> m (Metadata, [Artifact], Maybe SomeException) exec Args{..} container uid metadata blobs = shelly $ withDir $ \dir dataDir storeDir -> do control $ dataDir </> pack "control.json" storeInput $ storeDir </> pack "input" dataInput $ dataDir </> pack "input.json"- maybe (docker dataDir storeDir container) (bash dir container) aContainerless+ e <- maybe (docker dataDir storeDir container) (bash dir container) aContainerless result <- dataOutput $ dataDir </> pack "output.json" artifacts <- storeOutput $ storeDir </> pack "output"- return (result, artifacts) where+ return (result, artifacts, e) where withDir action = withTmpDir $ \dir -> do mkdir $ dir </> pack "data"@@ -129,25 +133,27 @@ storeOutput dir = do artifacts <- findWhen test_f dir forM artifacts $ readArtifact dir- docker dataDir storeDir Container{..} = do- devices <- forM cDevices $ \device ->- liftM strip $ run "readlink" ["-f", device]- run_ "docker" $ concat- [["run"]- , concatMap (("--device" :) . return) devices- , concatMap (("--env" :) . return) cEnvironment- , concatMap (("--link" :) . return) cLink- , concatMap (("--volume" :) . return) $- toTextIgnore dataDir <> ":/app/data" :- toTextIgnore storeDir <> ":/app/store" : cVolumes- , [cImage]- , words cCommand- ]- bash dir Container{..} bashDir = do- files <- ls $ fromText $ pack bashDir- forM_ files $ flip cp_r dir- cd dir- maybe (return ()) (uncurry $ run_ . fromText) $ uncons $ words cCommand+ docker dataDir storeDir Container{..} =+ handler $ do+ devices <- forM cDevices $ \device ->+ liftM strip $ run "readlink" ["-f", device]+ run_ "docker" $ concat+ [["run"]+ , concatMap (("--device" :) . return) devices+ , concatMap (("--env" :) . return) cEnvironment+ , concatMap (("--link" :) . return) cLink+ , concatMap (("--volume" :) . return) $+ toTextIgnore dataDir <> ":/app/data" :+ toTextIgnore storeDir <> ":/app/store" : cVolumes+ , [cImage]+ , words cCommand+ ]+ bash dir Container{..} bashDir =+ handler $ do+ files <- ls $ fromText $ pack bashDir+ forM_ files $ flip cp_r dir+ cd dir+ maybe (return ()) (uncurry $ run_ . fromText) $ uncons $ words cCommand call :: Args -> IO () call Args{..} = do
main/Act2.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-} module Act2 ( main ) where@@ -50,16 +51,19 @@ encodeText :: ToJSON a => a -> Text encodeText = toStrict . toLazyText . encodeToTextBuilder . toJSON -exec :: MonadIO m => Text -> Uid -> Metadata -> [Blob] -> m (Metadata, [Artifact])+handler :: MonadBaseControl IO m => m () -> m (Maybe SomeException)+handler a = handle (return . Just) $ a >> return Nothing++exec :: MonadIO m => Text -> Uid -> Metadata -> [Blob] -> m (Metadata, [Artifact], Maybe SomeException) exec cmdline uid metadata blobs = shelly $ withDir $ \dir dataDir storeDir -> do control $ dataDir </> pack "control.json" storeInput $ storeDir </> pack "input" dataInput $ dataDir </> pack "input.json"- bash dir+ e <- bash dir result <- dataOutput $ dataDir </> pack "output.json" artifacts <- storeOutput $ storeDir </> pack "output"- return (result, artifacts) where+ return (result, artifacts, e) where withDir action = withTmpDir $ \dir -> do mkdir $ dir </> pack "data"@@ -93,12 +97,13 @@ storeOutput dir = do artifacts <- findWhen test_f dir forM artifacts $ readArtifact dir- bash dir = do- bashDir <- pwd- files <- ls bashDir- forM_ files $ flip cp_r dir- cd dir- maybe (return ()) (uncurry $ run_ . fromText) $ uncons $ words cmdline+ bash dir =+ handler $ do+ bashDir <- pwd+ files <- ls bashDir+ forM_ files $ flip cp_r dir+ cd dir+ maybe (return ()) (uncurry $ run_ . fromText) $ uncons $ words cmdline call :: Args -> IO () call Args{..} = do
src/Network/AWS/Flow.hs view
@@ -36,7 +36,6 @@ import Data.Char import qualified Data.HashMap.Strict as Map import Data.Text ( pack )-import Data.Typeable import Formatting hiding ( string ) import Network.AWS.SWF import Network.HTTP.Types@@ -94,13 +93,12 @@ actException :: MonadFlow m => Token -> SomeException -> m () actException token e = do- logError' $ sformat ("event=act-exception-type " % stext) $ show $ typeOf e logError' $ sformat ("event=act-exception " % stext) $ show e maybe' ((textToString $ show e) =~ exitCode) (respondActivityTaskFailedAction token) $ \code -> do if code == 255 then respondActivityTaskCanceledAction token else respondActivityTaskFailedAction token -act :: MonadFlow m => Queue -> (Uid -> Metadata -> [Blob] -> m (Metadata, [Artifact])) -> m ()+act :: MonadFlow m => Queue -> (Uid -> Metadata -> [Blob] -> m (Metadata, [Artifact], Maybe SomeException)) -> m () act queue action = handle serializeError $ do logInfo' "event=act"@@ -112,13 +110,12 @@ unless (null keys) $ logInfo' $ sformat ("event=list-blobs uid=" % stext) uid blobs <- forM keys $ getObjectAction uid unless (null blobs) $ logInfo' $ sformat ("event=blobs uid=" % stext) uid- handle (actException token) $ do- (output, artifacts) <- action uid input blobs- maybe_ output $ logDebug' . sformat ("event=act-output " % stext)- logInfo' $ sformat ("event=act-finish uid=" % stext) uid- forM_ artifacts $ putObjectAction uid- unless (null artifacts) $ logInfo' $ sformat ("event=artifacts uid=" % stext) uid- respondActivityTaskCompletedAction token output+ (output, artifacts, e) <- action uid input blobs+ maybe_ output $ logDebug' . sformat ("event=act-output " % stext)+ logInfo' $ sformat ("event=act-finish uid=" % stext) uid+ forM_ artifacts $ putObjectAction uid+ unless (null artifacts) $ logInfo' $ sformat ("event=artifacts uid=" % stext) uid+ maybe (respondActivityTaskCompletedAction token output) (actException token) e decide :: MonadFlow m => Plan -> m () decide plan@Plan{..} =
wolf.cabal view
@@ -1,5 +1,5 @@ name: wolf-version: 0.2.7+version: 0.2.8 synopsis: Amazon Simple Workflow Service Wrapper. homepage: https://github.com/swift-nav/wolf license: MIT