From a95057c07caf79a88ebe54e84ba7d3aa893120f3 Mon Sep 17 00:00:00 2001 From: Jakub Janczak Date: Fri, 5 Jul 2019 14:45:50 +0200 Subject: [PATCH 1/2] Adding ability to load image from `docker save` command --- docker.cabal | 1 + src/Docker/Client/Api.hs | 4 ++++ src/Docker/Client/Http.hs | 5 +++++ src/Docker/Client/Internal.hs | 6 +++++- src/Docker/Client/Types.hs | 2 ++ 5 files changed, 17 insertions(+), 1 deletion(-) diff --git a/docker.cabal b/docker.cabal index 88975d9..0aa9b20 100644 --- a/docker.cabal +++ b/docker.cabal @@ -77,6 +77,7 @@ test-suite docker-hs-tests , aeson , containers , unordered-containers + , conduit , http-client , http-client-tls , http-types diff --git a/src/Docker/Client/Api.hs b/src/Docker/Client/Api.hs index 8d7c32b..52d9422 100644 --- a/src/Docker/Client/Api.hs +++ b/src/Docker/Client/Api.hs @@ -21,6 +21,7 @@ module Docker.Client.Api ( , deleteImage , buildImageFromDockerfile , pullImage + , loadImage -- * Network , createNetwork , removeNetwork @@ -217,6 +218,9 @@ buildImageFromDockerfile opts base = do pullImage :: forall m b . (MonadIO m, MonadMask m) => T.Text -> Tag -> Sink BS.ByteString m b -> DockerT m (Either DockerError b) pullImage name tag = requestHelper' POST (CreateImageEndpoint name tag Nothing) +loadImage :: forall m b . (MonadIO m, MonadMask m) => Bool -> FilePath -> Sink BS.ByteString m b -> DockerT m (Either DockerError b) +loadImage quiet fp = requestHelper' POST (LoadImageEndpoint quiet fp) + -- | Creates network createNetwork :: forall m. (MonadIO m, MonadMask m) => CreateNetworkOpts -> DockerT m (Either DockerError NetworkID) createNetwork opts = requestHelper POST (CreateNetworkEndpoint opts) >>= parseResponse diff --git a/src/Docker/Client/Http.hs b/src/Docker/Client/Http.hs index 5a2bb49..92a3dc6 100644 --- a/src/Docker/Client/Http.hs +++ b/src/Docker/Client/Http.hs @@ -268,6 +268,11 @@ statusCodeToError (BuildImageEndpoint _ _) st = Nothing else Just $ DockerInvalidStatusCode st +statusCodeToError (LoadImageEndpoint _ _) st = + if st == status200 then + Nothing + else + Just $ DockerInvalidStatusCode st statusCodeToError (CreateImageEndpoint _ _ _) st = if st == status200 then Nothing diff --git a/src/Docker/Client/Internal.hs b/src/Docker/Client/Internal.hs index eb3ed21..51e7b92 100644 --- a/src/Docker/Client/Internal.hs +++ b/src/Docker/Client/Internal.hs @@ -8,7 +8,7 @@ import qualified Data.Conduit.Binary as CB import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, encodeUtf8) import qualified Network.HTTP.Client as HTTP -import Network.HTTP.Conduit (requestBodySourceChunked) +import Network.HTTP.Conduit (requestBodySourceChunked, RequestBody(RequestBodyBS)) import Network.HTTP.Types (Query, encodePath, encodePathSegments) import Prelude hiding (all) @@ -75,6 +75,8 @@ getEndpoint v (CreateImageEndpoint name tag _) = encodeURLWithQuery [v, "images" where query = [("fromImage", Just n), ("tag", Just t)] n = encodeQ $ T.unpack name t = encodeQ $ T.unpack tag +getEndpoint v (LoadImageEndpoint quiet _) = encodeURLWithQuery [v, "images", "load"] query + where query = [("quiet", Just $ encodeQ $ show quiet)] getEndpoint v (DeleteImageEndpoint _ cid) = encodeURL [v, "images", fromImageID cid] getEndpoint v (CreateNetworkEndpoint _) = encodeURL [v, "networks", "create"] getEndpoint v (RemoveNetworkEndpoint nid) = encodeURL [v, "networks", fromNetworkID nid] @@ -97,6 +99,7 @@ getEndpointRequestBody (InspectContainerEndpoint _) = Nothing getEndpointRequestBody (BuildImageEndpoint _ fp) = Just $ requestBodySourceChunked $ CB.sourceFile fp getEndpointRequestBody (CreateImageEndpoint _ _ _) = Nothing +getEndpointRequestBody (LoadImageEndpoint _ fp) = Just $ requestBodySourceChunked $ CB.sourceFile fp getEndpointRequestBody (DeleteImageEndpoint _ _) = Nothing getEndpointRequestBody (CreateNetworkEndpoint opts) = Just $ HTTP.RequestBodyLBS (JSON.encode opts) @@ -104,5 +107,6 @@ getEndpointRequestBody (RemoveNetworkEndpoint _) = Nothing getEndpointContentType :: Endpoint -> BSC.ByteString getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar" +getEndpointContentType (LoadImageEndpoint _ _) = BSC.pack "application/tar" getEndpointContentType _ = BSC.pack "application/json; charset=utf-8" diff --git a/src/Docker/Client/Types.hs b/src/Docker/Client/Types.hs index 118f7d0..589de3b 100644 --- a/src/Docker/Client/Types.hs +++ b/src/Docker/Client/Types.hs @@ -112,6 +112,7 @@ import Data.Scientific (floatingOrInteger) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (UTCTime) +import qualified Data.ByteString as BS import qualified Data.Vector as V import GHC.Generics (Generic) import Prelude hiding (all, tail) @@ -136,6 +137,7 @@ data Endpoint = | InspectContainerEndpoint ContainerID | BuildImageEndpoint BuildOpts FilePath | CreateImageEndpoint T.Text Tag (Maybe T.Text) -- ^ Either pull an image from docker hub or imports an image from a tarball (or URL) + | LoadImageEndpoint Bool FilePath | DeleteImageEndpoint ImageDeleteOpts ImageID | CreateNetworkEndpoint CreateNetworkOpts | RemoveNetworkEndpoint NetworkID From dd0f4d5ece5ec10131d670122591d4d8d2874ad6 Mon Sep 17 00:00:00 2001 From: Jakub Janczak Date: Mon, 8 Jul 2019 10:28:40 +0200 Subject: [PATCH 2/2] Adding documentation --- src/Docker/Client/Api.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Docker/Client/Api.hs b/src/Docker/Client/Api.hs index 52d9422..410901c 100644 --- a/src/Docker/Client/Api.hs +++ b/src/Docker/Client/Api.hs @@ -218,6 +218,7 @@ buildImageFromDockerfile opts base = do pullImage :: forall m b . (MonadIO m, MonadMask m) => T.Text -> Tag -> Sink BS.ByteString m b -> DockerT m (Either DockerError b) pullImage name tag = requestHelper' POST (CreateImageEndpoint name tag Nothing) +-- | Loads a previously saved image loadImage :: forall m b . (MonadIO m, MonadMask m) => Bool -> FilePath -> Sink BS.ByteString m b -> DockerT m (Either DockerError b) loadImage quiet fp = requestHelper' POST (LoadImageEndpoint quiet fp)