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..410901c 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,10 @@ 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) + -- | 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