From ab582760a5e70d5bb4a79cde8bc9440b0fc96c5c Mon Sep 17 00:00:00 2001 From: iko Date: Mon, 24 Feb 2020 23:16:03 +0300 Subject: [PATCH 1/4] Added log processing --- src/Docker/Client/Api.hs | 8 ++++---- src/Docker/Client/Internal.hs | 1 - src/Docker/Client/Utils.hs | 17 +++++++++++++++++ 3 files changed, 21 insertions(+), 5 deletions(-) diff --git a/src/Docker/Client/Api.hs b/src/Docker/Client/Api.hs index 8d7c32b..955b765 100644 --- a/src/Docker/Client/Api.hs +++ b/src/Docker/Client/Api.hs @@ -34,7 +34,7 @@ import Control.Monad.Reader (ask, lift) import Data.Aeson (FromJSON, eitherDecode') import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL -import Data.Conduit (Sink) +import Data.Conduit (Sink, (.|)) import qualified Data.Conduit.Binary as Conduit import qualified Data.Text as T import qualified Data.Text as Text @@ -172,7 +172,7 @@ inspectContainer cid = requestHelper GET (InspectContainerEndpoint cid) >>= pars -- __NOTE__: It's recommended to use one of the other 'LogDriverType's available (like -- syslog) for creating your containers. getContainerLogs :: forall m. (MonadIO m, MonadMask m) => LogOpts -> ContainerID -> DockerT m (Either DockerError BSL.ByteString) -getContainerLogs logopts cid = requestHelper GET (ContainerLogsEndpoint logopts False cid) +getContainerLogs logopts cid = getContainerLogsStream logopts cid Conduit.sinkLbs {-| Continuously gets the container's logs as a stream. Uses conduit. @@ -189,7 +189,8 @@ __Example__: -} getContainerLogsStream :: forall m b . (MonadIO m, MonadMask m) => LogOpts -> ContainerID -> Sink BS.ByteString m b -> DockerT m (Either DockerError b) -getContainerLogsStream logopts cid = requestHelper' GET (ContainerLogsEndpoint logopts True cid) +getContainerLogsStream logopts cid sink = + requestHelper' GET (ContainerLogsEndpoint logopts True cid) (processLog .| sink) -- JP: Should the second (follow) argument be True? XXX -- | Build an Image from a Dockerfile @@ -224,4 +225,3 @@ createNetwork opts = requestHelper POST (CreateNetworkEndpoint opts) >>= parseR -- | Removes a network removeNetwork :: forall m. (MonadIO m, MonadMask m) => NetworkID -> DockerT m (Either DockerError ()) removeNetwork nid = requestUnit DELETE $ RemoveNetworkEndpoint nid - diff --git a/src/Docker/Client/Internal.hs b/src/Docker/Client/Internal.hs index eb3ed21..fdbf868 100644 --- a/src/Docker/Client/Internal.hs +++ b/src/Docker/Client/Internal.hs @@ -105,4 +105,3 @@ getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing getEndpointContentType :: Endpoint -> BSC.ByteString getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar" getEndpointContentType _ = BSC.pack "application/json; charset=utf-8" - diff --git a/src/Docker/Client/Utils.hs b/src/Docker/Client/Utils.hs index 9c81a51..6a7b0e1 100644 --- a/src/Docker/Client/Utils.hs +++ b/src/Docker/Client/Utils.hs @@ -9,7 +9,11 @@ import qualified Codec.Archive.Tar as Tar import qualified Codec.Compression.GZip as GZip import Control.Monad (filterM, liftM, unless) import Control.Monad.IO.Class +import Data.Bits import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString as BSS +import Data.Conduit (ConduitT, yield) +import qualified Data.Conduit.Binary as CB import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Data.Text.IO as TIO @@ -129,3 +133,16 @@ exclusionCheck f ps = any id (map (\(ExclusionPattern p) -> f ~~ T.unpack p) ps) inclusionCheck :: FilePath -> [InclusionPattern] -> Bool inclusionCheck f ps = any id (map (\(InclusionPattern p) -> f ~~ T.unpack p) ps) + +processLog :: Monad m => ConduitT BSS.ByteString BSS.ByteString m () +processLog = do + -- metadata (is the next string is stdout or stderr) + _ <- CB.take 4 + len' <- CB.take 4 + let len = BS.foldl (\i w -> shiftL i 8 .&. fromIntegral w) 0 len' + case len of + 0 -> return () + n -> do + chunk <- CB.take n + yield . BS.toStrict $ chunk + processLog From 5cfdc4d7facd7043f530bce4ce0f0c57c923b029 Mon Sep 17 00:00:00 2001 From: iko Date: Mon, 24 Feb 2020 23:39:11 +0300 Subject: [PATCH 2/4] Fixed typo --- src/Docker/Client/Utils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Docker/Client/Utils.hs b/src/Docker/Client/Utils.hs index 6a7b0e1..63e1430 100644 --- a/src/Docker/Client/Utils.hs +++ b/src/Docker/Client/Utils.hs @@ -139,7 +139,7 @@ processLog = do -- metadata (is the next string is stdout or stderr) _ <- CB.take 4 len' <- CB.take 4 - let len = BS.foldl (\i w -> shiftL i 8 .&. fromIntegral w) 0 len' + let len = BS.foldl (\i w -> shiftL i 8 .|. fromIntegral w) 0 len' case len of 0 -> return () n -> do From d2524ec636160341d622491b90dd5efda88ece9b Mon Sep 17 00:00:00 2001 From: iko Date: Tue, 25 Feb 2020 02:08:19 +0300 Subject: [PATCH 3/4] Fixed typo --- src/Docker/Client/Utils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Docker/Client/Utils.hs b/src/Docker/Client/Utils.hs index 63e1430..ff3e75e 100644 --- a/src/Docker/Client/Utils.hs +++ b/src/Docker/Client/Utils.hs @@ -136,7 +136,7 @@ inclusionCheck f ps = any id (map (\(InclusionPattern p) -> f ~~ T.unpack p) ps) processLog :: Monad m => ConduitT BSS.ByteString BSS.ByteString m () processLog = do - -- metadata (is the next string is stdout or stderr) + -- metadata (is the next string stdout or stderr) _ <- CB.take 4 len' <- CB.take 4 let len = BS.foldl (\i w -> shiftL i 8 .|. fromIntegral w) 0 len' From 36eaac1ce0f21468041ab13240126e4563ab0de5 Mon Sep 17 00:00:00 2001 From: iko Date: Thu, 27 Feb 2020 12:42:06 +0300 Subject: [PATCH 4/4] ConduitT -> ConduitM --- src/Docker/Client/Utils.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Docker/Client/Utils.hs b/src/Docker/Client/Utils.hs index ff3e75e..aafa0a7 100644 --- a/src/Docker/Client/Utils.hs +++ b/src/Docker/Client/Utils.hs @@ -12,7 +12,7 @@ import Control.Monad.IO.Class import Data.Bits import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString as BSS -import Data.Conduit (ConduitT, yield) +import Data.Conduit (ConduitM, yield) import qualified Data.Conduit.Binary as CB import Data.Monoid ((<>)) import qualified Data.Text as T @@ -134,7 +134,7 @@ inclusionCheck :: FilePath -> [InclusionPattern] -> Bool inclusionCheck f ps = any id (map (\(InclusionPattern p) -> f ~~ T.unpack p) ps) -processLog :: Monad m => ConduitT BSS.ByteString BSS.ByteString m () +processLog :: Monad m => ConduitM BSS.ByteString BSS.ByteString m () processLog = do -- metadata (is the next string stdout or stderr) _ <- CB.take 4