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..aafa0a7 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 (ConduitM, 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 => ConduitM BSS.ByteString BSS.ByteString m () +processLog = do + -- 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' + case len of + 0 -> return () + n -> do + chunk <- CB.take n + yield . BS.toStrict $ chunk + processLog