git.iko.soy/docker-hs
on master help sign in
Adds missing apiVersion in urls
7c12763Deni Bertovic
src/Docker/Client/Http.hs+6−6
compare with master
unifiedsplit
@@ -4,8 +4,8 @@
4module Docker.Client.Http where
4module Docker.Client.Http where
5
5
6-- import Control.Monad.Base (MonadBase(..), liftBaseDefault)
6-- import Control.Monad.Base (MonadBase(..), liftBaseDefault)
7−import Control.Monad.Catch (MonadMask(..))
7+import Control.Monad.Catch (MonadMask (..))
8−import Control.Monad.Reader (ReaderT(..), runReaderT)
8+import Control.Monad.Reader (ReaderT (..), runReaderT)
9import qualified Data.ByteString.Char8 as BSC
9import qualified Data.ByteString.Char8 as BSC
10import qualified Data.ByteString.Lazy as BL
10import qualified Data.ByteString.Lazy as BL
11import Data.Conduit (Sink)
11import Data.Conduit (Sink)
@@ -21,9 +21,9 @@ import Network.HTTP.Client (defaultManagerSettings,
21 requestBody, requestHeaders)
21 requestBody, requestHeaders)
22import qualified Network.HTTP.Client as HTTP
22import qualified Network.HTTP.Client as HTTP
23import Network.HTTP.Client.Internal (makeConnection)
23import Network.HTTP.Client.Internal (makeConnection)
24+import qualified Network.HTTP.Simple as NHS
24import Network.HTTP.Types (StdMethod, status101, status200,
25import Network.HTTP.Types (StdMethod, status101, status200,
25 status201, status204)
26 status201, status204)
26−import qualified Network.HTTP.Simple as NHS
27import Network.TLS (ClientHooks (..),
27import Network.TLS (ClientHooks (..),
28 ClientParams (..), Shared (..),
28 ClientParams (..), Shared (..),
29 Supported (..),
29 Supported (..),
@@ -45,7 +45,7 @@ import Docker.Client.Internal (getEndpoint,
45 getEndpointContentType,
45 getEndpointContentType,
46 getEndpointRequestBody)
46 getEndpointRequestBody)
47import Docker.Client.Types (DockerClientOpts, Endpoint (..),
47import Docker.Client.Types (DockerClientOpts, Endpoint (..),
48− baseUrl)
48+ apiVer, baseUrl)
49
49
50type Request = HTTP.Request
50type Request = HTTP.Request
51type Response = HTTP.Response BL.ByteString
51type Response = HTTP.Response BL.ByteString
@@ -93,7 +93,7 @@ runDockerT (opts, h) r = runReaderT (unDockerT r) (opts, h)
93-- benefit from testing that on all of our Endpoints
93-- benefit from testing that on all of our Endpoints
94mkHttpRequest :: HttpVerb -> Endpoint -> DockerClientOpts -> Maybe Request
94mkHttpRequest :: HttpVerb -> Endpoint -> DockerClientOpts -> Maybe Request
95mkHttpRequest verb e opts = request
95mkHttpRequest 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)
97 initialR = parseUrl fullE
97 initialR = parseUrl fullE
98 request' = case initialR of
98 request' = case initialR of
99 Just ir ->
99 Just ir ->
@@ -110,7 +110,7 @@ defaultHttpHandler = do
110 return $ httpHandler manager
110 return $ httpHandler manager
111
111
112httpHandler :: (MonadIO m, MonadMask m) => HTTP.Manager -> HttpHandler m
112httpHandler :: (MonadIO m, MonadMask m) => HTTP.Manager -> HttpHandler m
113−httpHandler manager = HttpHandler $ \request' sink -> do -- runResourceT ..
113+httpHandler manager = HttpHandler $ \request' sink -> do -- runResourceT ..
114 let request = NHS.setRequestManager manager request'
114 let request = NHS.setRequestManager manager request'
115 try (NHS.httpSink request sink) >>= \res -> case res of
115 try (NHS.httpSink request sink) >>= \res -> case res of
116 Right res -> return res
116 Right res -> return res
src/Docker/Client/Internal.hs+26−26
@@ -24,44 +24,44 @@ encodeURLWithQuery ps q = decodeUtf8 $ toByteString $ encodePath ps q
24encodeQ :: String -> ByteString
24encodeQ :: String -> ByteString
25encodeQ = encodeUtf8 . T.pack
25encodeQ = encodeUtf8 . T.pack
26
26
27−getEndpoint :: Endpoint -> T.Text
27+getEndpoint :: ApiVersion -> Endpoint -> T.Text
28−getEndpoint VersionEndpoint = encodeURL ["version"]
28+getEndpoint v VersionEndpoint = encodeURL [v, "version"]
29−getEndpoint (ListContainersEndpoint _) = encodeURL ["containers", "json"] -- Make use of lsOpts here
29+getEndpoint v (ListContainersEndpoint _) = encodeURL [v, "containers", "json"] -- Make use of lsOpts here
30−getEndpoint (ListImagesEndpoint _) = encodeURL ["images", "json"] -- Make use of lsOpts here
30+getEndpoint v (ListImagesEndpoint _) = encodeURL [v, "images", "json"] -- Make use of lsOpts here
31−getEndpoint (CreateContainerEndpoint _ cn) = case cn of
31+getEndpoint v (CreateContainerEndpoint _ cn) = case cn of
32− Just cn -> encodeURLWithQuery ["containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]
32+ Just cn -> encodeURLWithQuery [v, "containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]
33− Nothing -> encodeURL ["containers", "create"]
33+ Nothing -> encodeURL [v, "containers", "create"]
34−getEndpoint (StartContainerEndpoint startOpts cid) = encodeURLWithQuery ["containers", fromContainerID cid, "start"] query
34+getEndpoint v (StartContainerEndpoint startOpts cid) = encodeURLWithQuery [v, "containers", fromContainerID cid, "start"] query
35 where query = case (detachKeys startOpts) of
35 where query = case (detachKeys startOpts) of
36 WithCtrl c -> [("detachKeys", Just (encodeQ $ ctrl ++ [c]))]
36 WithCtrl c -> [("detachKeys", Just (encodeQ $ ctrl ++ [c]))]
37 WithoutCtrl c -> [("detachKeys", Just (encodeQ [c]))]
37 WithoutCtrl c -> [("detachKeys", Just (encodeQ [c]))]
38 DefaultDetachKey -> []
38 DefaultDetachKey -> []
39 ctrl = ['c', 't', 'r', 'l', '-']
39 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
41 where query = case t of
41 where query = case t of
42− Timeout x -> [("t", Just (encodeQ $ show x))]
42+ Timeout x -> [("t", Just (encodeQ $ show x))]
43 DefaultTimeout -> []
43 DefaultTimeout -> []
44−getEndpoint (WaitContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "wait"]
44+getEndpoint v (WaitContainerEndpoint cid) = encodeURL [v, "containers", fromContainerID cid, "wait"]
45−getEndpoint (KillContainerEndpoint s cid) = encodeURLWithQuery ["containers", fromContainerID cid, "kill"] query
45+getEndpoint v (KillContainerEndpoint s cid) = encodeURLWithQuery [v, "containers", fromContainerID cid, "kill"] query
46 where query = case s of
46 where query = case s of
47 SIG x -> [("signal", Just (encodeQ $ show x))]
47 SIG x -> [("signal", Just (encodeQ $ show x))]
48− _ -> [("signal", Just (encodeQ $ show s))]
48+ _ -> [("signal", Just (encodeQ $ show s))]
49−getEndpoint (RestartContainerEndpoint t cid) = encodeURLWithQuery ["containers", fromContainerID cid, "restart"] query
49+getEndpoint v (RestartContainerEndpoint t cid) = encodeURLWithQuery [v, "containers", fromContainerID cid, "restart"] query
50 where query = case t of
50 where query = case t of
51− Timeout x -> [("t", Just (encodeQ $ show x))]
51+ Timeout x -> [("t", Just (encodeQ $ show x))]
52 DefaultTimeout -> []
52 DefaultTimeout -> []
53−getEndpoint (PauseContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "pause"]
53+getEndpoint v (PauseContainerEndpoint cid) = encodeURL [v, "containers", fromContainerID cid, "pause"]
54−getEndpoint (UnpauseContainerEndpoint cid) = encodeURL ["containers", fromContainerID cid, "unpause"]
54+getEndpoint v (UnpauseContainerEndpoint cid) = encodeURL [v, "containers", fromContainerID cid, "unpause"]
55-- Make use of since/timestamps/tail logopts here instead of ignoreing them
55-- Make use of since/timestamps/tail logopts here instead of ignoreing them
56−getEndpoint (ContainerLogsEndpoint (LogOpts stdout stderr _ _ _) follow cid) =
56+getEndpoint v (ContainerLogsEndpoint (LogOpts stdout stderr _ _ _) follow cid) =
57− encodeURLWithQuery ["containers", fromContainerID cid, "logs"] query
57+ encodeURLWithQuery [v, "containers", fromContainerID cid, "logs"] query
58 where query = [("stdout", Just (encodeQ $ show stdout)), ("stderr", Just (encodeQ $ show stderr)), ("follow", Just (encodeQ $ show follow))]
58 where query = [("stdout", Just (encodeQ $ show stdout)), ("stderr", Just (encodeQ $ show stderr)), ("follow", Just (encodeQ $ show follow))]
59−getEndpoint (DeleteContainerEndpoint (DeleteOpts removeVolumes force) cid) =
59+getEndpoint v (DeleteContainerEndpoint (DeleteOpts removeVolumes force) cid) =
60− encodeURLWithQuery ["containers", fromContainerID cid] query
60+ encodeURLWithQuery [v, "containers", fromContainerID cid] query
61 where query = [("v", Just (encodeQ $ show removeVolumes)), ("force", Just (encodeQ $ show force))]
61 where query = [("v", Just (encodeQ $ show removeVolumes)), ("force", Just (encodeQ $ show force))]
62−getEndpoint (InspectContainerEndpoint cid) =
62+getEndpoint v (InspectContainerEndpoint cid) =
63− encodeURLWithQuery ["containers", fromContainerID cid, "json"] []
63+ encodeURLWithQuery [v, "containers", fromContainerID cid, "json"] []
64−getEndpoint (BuildImageEndpoint o _) = encodeURLWithQuery ["build"] query
64+getEndpoint v (BuildImageEndpoint o _) = encodeURLWithQuery [v, "build"] query
65 where query = [("t", Just t), ("dockerfile", Just dockerfile), ("q", Just q), ("nocache", Just nocache), ("rm", Just rm), ("forcerm", Just forcerm), ("pull", Just pull)]
65 where query = [("t", Just t), ("dockerfile", Just dockerfile), ("q", Just q), ("nocache", Just nocache), ("rm", Just rm), ("forcerm", Just forcerm), ("pull", Just pull)]
66 t = encodeQ $ T.unpack $ buildImageName o
66 t = encodeQ $ T.unpack $ buildImageName o
67 dockerfile = encodeQ $ T.unpack $ buildDockerfileName o
67 dockerfile = encodeQ $ T.unpack $ buildDockerfileName o
@@ -70,7 +70,7 @@ getEndpoint (BuildImageEndpoint o _) = encodeURLWithQuery ["build"] query
70 rm = encodeQ $ show $ buildRemoveItermediate o
70 rm = encodeQ $ show $ buildRemoveItermediate o
71 forcerm = encodeQ $ show $ buildForceRemoveIntermediate o
71 forcerm = encodeQ $ show $ buildForceRemoveIntermediate o
72 pull = encodeQ $ show $ buildPullParent o
72 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
74 where query = [("fromImage", Just n), ("tag", Just t)]
74 where query = [("fromImage", Just n), ("tag", Just t)]
75 n = encodeQ $ T.unpack name
75 n = encodeQ $ T.unpack name
76 t = encodeQ $ T.unpack tag
76 t = encodeQ $ T.unpack tag
@@ -92,7 +92,7 @@ getEndpointRequestBody (DeleteContainerEndpoint _ _) = Nothing
92getEndpointRequestBody (InspectContainerEndpoint _) = Nothing
92getEndpointRequestBody (InspectContainerEndpoint _) = Nothing
93
93
94getEndpointRequestBody (BuildImageEndpoint _ fp) = Just $ requestBodySourceChunked $ CB.sourceFile fp
94getEndpointRequestBody (BuildImageEndpoint _ fp) = Just $ requestBodySourceChunked $ CB.sourceFile fp
95−getEndpointRequestBody (CreateImageEndpoint _ _) = Nothing
95+getEndpointRequestBody (CreateImageEndpoint _ _ _) = Nothing
96
96
97getEndpointContentType :: Endpoint -> BSC.ByteString
97getEndpointContentType :: Endpoint -> BSC.ByteString
98getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"
98getEndpointContentType (BuildImageEndpoint _ _) = BSC.pack "application/tar"