wolf 0.2.8.2 → 0.2.9
raw patch · 4 files changed
+41/−32 lines, 4 files
Files
- main/Act2.hs +28/−24
- main/Options.hs +8/−7
- src/Network/AWS/Flow.hs +2/−0
- wolf.cabal +3/−1
main/Act2.hs view
@@ -6,6 +6,8 @@ import BasicPrelude hiding ( ByteString, (</>), (<.>), hash, length, readFile, find ) import Codec.Compression.GZip+import Control.Concurrent+import Control.Concurrent.Async import Control.Monad.Trans.Resource import Data.Aeson.Encode import Data.ByteString ( length )@@ -13,6 +15,7 @@ import Data.Text ( pack, strip ) import Data.Text.Lazy ( toStrict ) import Data.Text.Lazy.Builder hiding ( fromText )+import Data.Time import Data.Yaml hiding ( Parser ) import Filesystem.Path ( (<.>), dropExtension ) import Network.AWS.Data.Crypto@@ -25,7 +28,7 @@ { aConfig :: FilePath , aQueue :: Queue , aCommandLine :: Text- , aGzipless :: Bool+ , aTimeout :: Int } deriving ( Eq, Read, Show ) args :: Parser Args@@ -33,7 +36,7 @@ configFile <*> (pack <$> queue) <*> (pack <$> commandLine) <*>- gzipless+ timeout parser :: ParserInfo Args parser =@@ -56,8 +59,8 @@ handler :: MonadBaseControl IO m => m () -> m (Maybe SomeException) handler a = handle (return . Just) $ a >> return Nothing -exec :: MonadIO m => Args -> Text -> Uid -> Metadata -> [Blob] -> m (Metadata, [Artifact], Maybe SomeException)-exec Args{..} cmdline uid metadata blobs =+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"@@ -76,26 +79,15 @@ control file = writefile file $ encodeText $ Control uid writeArtifact file blob =- if aGzipless then- writeBinary file $ BL.toStrict blob- else- writeBinary (dropExtension file) $ BL.toStrict $ decompress blob+ writeBinary (dropExtension file) $ BL.toStrict $ decompress blob readArtifact dir file = do key <- relativeTo dir file- if aGzipless then do- blob <- readBinary file- return ( toTextIgnore key- , hash blob- , fromIntegral $ length blob- , BL.fromStrict blob- )- else do- blob <- BL.toStrict . compress . BL.fromStrict <$> readBinary file- return ( toTextIgnore (key <.> "gz")- , hash blob- , fromIntegral $ length blob- , BL.fromStrict blob- )+ blob <- BL.toStrict . compress . BL.fromStrict <$> readBinary file+ return ( toTextIgnore (key <.> "gz")+ , hash blob+ , fromIntegral $ length blob+ , BL.fromStrict blob+ ) dataInput file = maybe (return ()) (writefile file) metadata dataOutput file =@@ -118,12 +110,24 @@ cd dir maybe (return ()) (uncurry $ run_ . fromText) $ uncons $ words cmdline +watchdog :: MVar UTCTime -> Int -> IO ()+watchdog timestamp duration =+ forever $ do+ now <- getCurrentTime+ now' <- readMVar timestamp+ when (diffUTCTime now now' > fromIntegral duration) $+ throwIO $ userError "watchdog expired"+ threadDelay 1000000+ call :: Args -> IO () call Args{..} = do config <- decodeFile aConfig >>= maybeThrow (userError "Bad Config") env <- flowEnv config- forever $ runResourceT $ runFlowT env $- act aQueue $ exec Args{..} aCommandLine+ timestamp <- newEmptyMVar+ void $ concurrently (watchdog timestamp aTimeout) $ do+ forever $ runResourceT $ runFlowT env $ do+ liftIO $ getCurrentTime >>= putMVar timestamp+ act aQueue $ exec aCommandLine main :: IO () main = execParser parser >>= call
main/Options.hs view
@@ -6,8 +6,8 @@ , queue , containerless , gzip- , gzipless , commandLine+ , timeout ) where import BasicPrelude@@ -66,12 +66,6 @@ $ long "gzip" <> help "GZIP contents of artifacts" -gzipless :: Parser Bool-gzipless =- switch- $ long "gzipless"- <> help "disable GZIP contents of artifacts"- commandLine :: Parser String commandLine = strOption@@ -80,3 +74,10 @@ <> metavar "COMMAND" <> help "Command to run" +timeout :: Parser Int+timeout =+ option auto+ $ long "timeout"+ <> short 't'+ <> metavar "TIMEOUT"+ <> help "Timeout in seconds"
src/Network/AWS/Flow.hs view
@@ -105,11 +105,13 @@ (token', uid, input) <- pollForActivityTaskAction queue token <- maybeThrow (userError "No Token") token' logInfo' $ sformat ("event=act-begin uid=" % stext) uid+ maybe_ input $ logDebug' . sformat ("event=act-input " % stext) keys <- listObjectsAction uid 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 (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
wolf.cabal view
@@ -1,5 +1,5 @@ name: wolf-version: 0.2.8.2+version: 0.2.9 synopsis: Amazon Simple Workflow Service Wrapper. homepage: https://github.com/swift-nav/wolf license: MIT@@ -170,6 +170,7 @@ ghc-options: -Wall -main-is Act2 build-depends: aeson , amazonka-core+ , async , base , basic-prelude , bytestring@@ -178,6 +179,7 @@ , shelly , system-filepath , text+ , time , transformers , wolf , yaml