git.iko.soy/docker-hs
on master help sign in
Adds missing apiVersion in urls
commit7c127632269fe0bd8a87a7dbbd760a6a23290bb0 authorDeni Bertovic <deni@denibertovic.com> dateMon 20 Mar 2017, 11:04 (10 years ago) parent5ce3fb0
2 files changed+32−32
compare with master
unifiedsplit
src/Docker/Client/Http.hs+6−6 src/Docker/Client/Internal.hs+26−26
src/Docker/Client/Http.hs+6−6
@@ -4,8 +4,8 @@
44module Docker.Client.Http where
55
66-- import Control.Monad.Base (MonadBase(..), liftBaseDefault)
7−import Control.Monad.Catch (MonadMask(..))
8−import Control.Monad.Reader (ReaderT(..), runReaderT)
7+import Control.Monad.Catch (MonadMask (..))
8+import Control.Monad.Reader (ReaderT (..), runReaderT)
99import qualified Data.ByteString.Char8 as BSC
1010import qualified Data.ByteString.Lazy as BL
1111import Data.Conduit (Sink)
@@ -21,9 +21,9 @@ import Network.HTTP.Client (defaultManagerSettings,
2121 requestBody, requestHeaders)
2222import qualified Network.HTTP.Client as HTTP
2323import Network.HTTP.Client.Internal (makeConnection)
24+import qualified Network.HTTP.Simple as NHS
2425import Network.HTTP.Types (StdMethod, status101, status200,
2526 status201, status204)
26−import qualified Network.HTTP.Simple as NHS
2727import Network.TLS (ClientHooks (..),
2828 ClientParams (..), Shared (..),
2929 Supported (..),
@@ -45,7 +45,7 @@ import Docker.Client.Internal (getEndpoint,
4545 getEndpointContentType,
4646 getEndpointRequestBody)
4747import Docker.Client.Types (DockerClientOpts, Endpoint (..),
48− baseUrl)
48+ apiVer, baseUrl)
4949
5050type Request = HTTP.Request
5151type Response = HTTP.Response BL.ByteString
@@ -93,7 +93,7 @@ runDockerT (opts, h) r = runReaderT (unDockerT r) (opts, h)
9393-- benefit from testing that on all of our Endpoints
9494mkHttpRequest :: HttpVerb -> Endpoint -> DockerClientOpts -> Maybe Request
9595mkHttpRequest verb e opts = request
96− where fullE = T.unpack (baseUrl opts) ++ T.unpack (getEndpoint e)
96+ where fullE = T.unpack (baseUrl opts) ++ T.unpack (getEndpoint (apiVer opts) e)
9797 initialR = parseUrl fullE
9898 request' = case initialR of
9999 Just ir ->
@@ -110,7 +110,7 @@ defaultHttpHandler = do
110110 return $ httpHandler manager
111111
112112httpHandler :: (MonadIO m, MonadMask m) => HTTP.Manager -> HttpHandler m
113−httpHandler manager = HttpHandler $ \request' sink -> do -- runResourceT ..
113+httpHandler manager = HttpHandler $ \request' sink -> do -- runResourceT ..
114114 let request = NHS.setRequestManager manager request'
115115 try (NHS.httpSink request sink) >>= \res -> case res of
116116 Right res -> return res
src/Docker/Client/Internal.hs+26−26
@@ -24,44 +24,44 @@ encodeURLWithQuery ps q = decodeUtf8 $ toByteString $ encodePath ps q
2424encodeQ :: String -> ByteString
2525encodeQ = encodeUtf8 . T.pack
2626
27−getEndpoint :: Endpoint -> T.Text
28−getEndpoint VersionEndpoint = encodeURL ["version"]
29−getEndpoint (ListContainersEndpoint _) = encodeURL ["containers", "json"] -- Make use of lsOpts here
30−getEndpoint (ListImagesEndpoint _) = encodeURL ["images", "json"] -- Make use of lsOpts here
31−getEndpoint (CreateContainerEndpoint _ cn) = case cn of
32− Just cn -> encodeURLWithQuery ["containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]
33− Nothing -> encodeURL ["containers", "create"]
34−getEndpoint (StartContainerEndpoint startOpts cid) = encodeURLWithQuery ["containers", fromContainerID cid, "start"] query
27+getEndpoint :: ApiVersion -> Endpoint -> T.Text
28+getEndpoint v VersionEndpoint = encodeURL [v, "version"]
29+getEndpoint v (ListContainersEndpoint _) = encodeURL [v, "containers", "json"] -- Make use of lsOpts here
30+getEndpoint v (ListImagesEndpoint _) = encodeURL [v, "images", "json"] -- Make use of lsOpts here
31+getEndpoint v (CreateContainerEndpoint _ cn) = case cn of
32+ Just cn -> encodeURLWithQuery [v, "containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]
33+ Nothing -> encodeURL [v, "containers", "create"]
34+getEndpoint v (StartContainerEndpoint startOpts cid) = encodeURLWithQuery [v, "containers", fromContainerID cid, "start"] query
3535 where query = case (detachKeys startOpts) of
3636 WithCtrl c -> [("detachKeys", Just (encodeQ $ ctrl ++ [c]))]
3737 WithoutCtrl c -> [("detachKeys", Just (encodeQ [c]))]
3838 DefaultDetachKey -> []
3939 ctrl = ['c', 't', 'r', 'l', '-']
40−getEndpoint (StopContainerEndpoint t cid) = encodeURLWithQuery ["containers", fromContainerID cid, "stop"] query
40+getEndpoint v (StopContainerEndpoint t cid) = encodeURLWithQuery [v, "containers", fromContainerID cid, "stop"] query
4141 where query = case t of
42− Timeout x -> [("t", Just (encodeQ $ show x))]
42+ Timeout x -> [("t", Just (encodeQ $ show x))]
4343 DefaultTimeout -> []
44−getEndpoint (WaitContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "wait"]
45−getEndpoint (KillContainerEndpoint s cid) = encodeURLWithQuery ["containers", fromContainerID cid, "kill"] query
44+getEndpoint v (WaitContainerEndpoint cid) = encodeURL [v, "containers", fromContainerID cid, "wait"]
45+getEndpoint v (KillContainerEndpoint s cid) = encodeURLWithQuery [v, "containers", fromContainerID cid, "kill"] query
4646 where query = case s of
4747 SIG x -> [("signal", Just (encodeQ $ show x))]
48− _ -> [("signal", Just (encodeQ $ show s))]
49−getEndpoint (RestartContainerEndpoint t cid) = encodeURLWithQuery ["containers", fromContainerID cid, "restart"] query
48+ _ -> [("signal", Just (encodeQ $ show s))]
49+getEndpoint v (RestartContainerEndpoint t cid) = encodeURLWithQuery [v, "containers", fromContainerID cid, "restart"] query
5050 where query = case t of
51− Timeout x -> [("t", Just (encodeQ $ show x))]
51+ Timeout x -> [("t", Just (encodeQ $ show x))]
5252 DefaultTimeout -> []
53−getEndpoint (PauseContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "pause"]
54−getEndpoint (UnpauseContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "unpause"]
53+getEndpoint v (PauseContainerEndpoint cid) = encodeURL [v, "containers", fromContainerID cid, "pause"]
54+getEndpoint v (UnpauseContainerEndpoint cid) = encodeURL [v, "containers", fromContainerID cid, "unpause"]
5555-- Make use of since/timestamps/tail logopts here instead of ignoreing them
56−getEndpoint (ContainerLogsEndpoint (LogOpts stdout stderr _ _ _) follow cid) =
57− encodeURLWithQuery ["containers", fromContainerID cid, "logs"] query
56+getEndpoint v (ContainerLogsEndpoint (LogOpts stdout stderr _ _ _) follow cid) =
57+ encodeURLWithQuery [v, "containers", fromContainerID cid, "logs"] query
5858 where query = [("stdout", Just (encodeQ $ show stdout)), ("stderr", Just (encodeQ $ show stderr)), ("follow", Just (encodeQ $ show follow))]
59−getEndpoint (DeleteContainerEndpoint (DeleteOpts removeVolumes force) cid) =
60− encodeURLWithQuery ["containers", fromContainerID cid] query
59+getEndpoint v (DeleteContainerEndpoint (DeleteOpts removeVolumes force) cid) =
60+ encodeURLWithQuery [v, "containers", fromContainerID cid] query
6161 where query = [("v", Just (encodeQ $ show removeVolumes)), ("force", Just (encodeQ $ show force))]
62−getEndpoint (InspectContainerEndpoint cid) =
63− encodeURLWithQuery ["containers", fromContainerID cid, "json"] []
64−getEndpoint (BuildImageEndpoint o _) = encodeURLWithQuery ["build"] query
62+getEndpoint v (InspectContainerEndpoint cid) =
63+ encodeURLWithQuery [v, "containers", fromContainerID cid, "json"] []
64+getEndpoint v (BuildImageEndpoint o _) = encodeURLWithQuery [v, "build"] query
6565 where query = [("t", Just t), ("dockerfile", Just dockerfile), ("q", Just q), ("nocache", Just nocache), ("rm", Just rm), ("forcerm", Just forcerm), ("pull", Just pull)]
6666 t = encodeQ $ T.unpack $ buildImageName o
6767 dockerfile = encodeQ $ T.unpack $ buildDockerfileName o
@@ -70,7 +70,7 @@ getEndpoint (BuildImageEndpoint o _) = encodeURLWithQuery ["build"] query
7070 rm = encodeQ $ show $ buildRemoveItermediate o
7171 forcerm = encodeQ $ show $ buildForceRemoveIntermediate o
7272 pull = encodeQ $ show $ buildPullParent o
73−getEndpoint (CreateImageEndpoint name tag _) = encodeURLWithQuery ["images", "create"] query
73+getEndpoint v (CreateImageEndpoint name tag _) = encodeURLWithQuery [v, "images", "create"] query
7474 where query = [("fromImage", Just n), ("tag", Just t)]
7575 n = encodeQ $ T.unpack name
7676 t = encodeQ $ T.unpack tag
@@ -92,7 +92,7 @@ getEndpointRequestBody (DeleteContainerEndpoint _ _) = Nothing
9292getEndpointRequestBody (InspectContainerEndpoint _) = Nothing
9393
9494getEndpointRequestBody (BuildImageEndpoint _ fp) = Just $ requestBodySourceChunked $ CB.sourceFile fp
95−getEndpointRequestBody (CreateImageEndpoint _ _) = Nothing
95+getEndpointRequestBody (CreateImageEndpoint _ _ _) = Nothing
9696
9797getEndpointContentType :: Endpoint -> BSC.ByteString
9898getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"