git.iko.soy/docker-hs
on master help sign in
Adds ability to name a contianer
commit43b535246c62e24c3d6e8547fef8382f88d8f379 authorDeni Bertovic <deni@denibertovic.com> dateThu 1 Sep 2016, 21:44 (10 years ago) parent1bfa17e
5 files changed+13−11
compare with master
unifiedsplit
examples/Example.hs+2−2 src/Docker/Client/Api.hs+2−2 src/Docker/Client/Http.hs+1−1 src/Docker/Client/Internal.hs+4−2 src/Docker/Client/Types.hs+4−4
examples/Example.hs+2−2
@@ -4,7 +4,7 @@ runNginxContainer :: IO ContainerID
44runNginxContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do
55 let pb = PortBinding 80 TCP [HostPort "0.0.0.0" 8000]
66 let myCreateOpts = addPortBinding (defaultCreateOpts "nginx:latest") pb
7− cid <- createContainer myCreateOpts
7+ cid <- createContainer myCreateOpts (Just "myNginxContainer")
88 case cid of
99 Left err -> error $ show err
1010 Right i -> do
@@ -22,7 +22,7 @@ runPostgresContainer :: IO ContainerID
2222runPostgresContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do
2323 let pb = PortBinding 5432 TCP [HostPort "0.0.0.0" 5432]
2424 let myCreateOpts = addBinds [Bind "/tmp" "/tmp" Nothing] $ addPortBinding (defaultCreateOpts "postgres:9.5") pb
25− cid <- createContainer myCreateOpts
25+ cid <- createContainer myCreateOpts Nothing
2626 case cid of
2727 Left err -> error $ show err
2828 Right i -> do
src/Docker/Client/Api.hs+2−2
@@ -77,8 +77,8 @@ listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse
7777-- | Creates a docker container but does __not__ start it. See
7878-- 'CreateOpts' for a list of options and you can use 'defaultCreateOpts'
7979-- for some sane defaults.
80−createContainer :: forall m. Monad m => CreateOpts -> DockerT m (Either DockerError ContainerID)
81−createContainer opts = requestHelper POST (CreateContainerEndpoint opts) >>= parseResponse
80+createContainer :: forall m. Monad m => CreateOpts -> Maybe ContainerName -> DockerT m (Either DockerError ContainerID)
81+createContainer opts cn = requestHelper POST (CreateContainerEndpoint opts cn) >>= parseResponse
8282
8383-- | Start a container from a given 'ContainerID' that we get from
8484-- 'createContainer'. See 'StartOpts' for a list of configuration options
src/Docker/Client/Http.hs+1−1
@@ -179,7 +179,7 @@ statusCodeToError (ListImagesEndpoint _) st =
179179 Nothing
180180 else
181181 Just $ DockerInvalidStatusCode st
182−statusCodeToError (CreateContainerEndpoint _) st =
182+statusCodeToError (CreateContainerEndpoint _ _) st =
183183 if st == status201 then
184184 Nothing
185185 else
src/Docker/Client/Internal.hs+4−2
@@ -26,7 +26,9 @@ getEndpoint :: Endpoint -> T.Text
2626getEndpoint VersionEndpoint = encodeURL ["version"]
2727getEndpoint (ListContainersEndpoint _) = encodeURL ["containers", "json"] -- Make use of lsOpts here
2828getEndpoint (ListImagesEndpoint _) = encodeURL ["images", "json"] -- Make use of lsOpts here
29−getEndpoint (CreateContainerEndpoint _) = encodeURL ["containers", "create"]
29+getEndpoint (CreateContainerEndpoint _ cn) = case cn of
30+ Just cn -> encodeURLWithQuery ["containers", "create"] [("name", Just (encodeQ $ T.unpack cn))]
31+ Nothing -> encodeURL ["containers", "create"]
3032getEndpoint (StartContainerEndpoint startOpts cid) = encodeURLWithQuery ["containers", fromContainerID cid, "start"] query
3133 where query = case (detachKeys startOpts) of
3234 WithCtrl c -> [("detachKeys", Just (encodeQ $ ctrl ++ [c]))]
@@ -61,7 +63,7 @@ getEndpointRequestBody :: Endpoint -> Maybe BSL.ByteString
6163getEndpointRequestBody VersionEndpoint = Nothing
6264getEndpointRequestBody (ListContainersEndpoint _) = Nothing
6365getEndpointRequestBody (ListImagesEndpoint _) = Nothing
64−getEndpointRequestBody (CreateContainerEndpoint opts) = Just $ JSON.encode opts
66+getEndpointRequestBody (CreateContainerEndpoint opts _) = Just $ JSON.encode opts
6567getEndpointRequestBody (StartContainerEndpoint _ _) = Nothing
6668getEndpointRequestBody (StopContainerEndpoint _ _) = Nothing
6769getEndpointRequestBody (KillContainerEndpoint _ _) = Nothing
src/Docker/Client/Types.hs+4−4
@@ -102,7 +102,7 @@ data Endpoint =
102102 VersionEndpoint
103103 | ListContainersEndpoint ListOpts
104104 | ListImagesEndpoint ListOpts
105− | CreateContainerEndpoint CreateOpts
105+ | CreateContainerEndpoint CreateOpts (Maybe ContainerName)
106106 | StartContainerEndpoint StartOpts ContainerID
107107 | StopContainerEndpoint Timeout ContainerID
108108 | KillContainerEndpoint Signal ContainerID
@@ -204,7 +204,7 @@ data ContainerDetails = ContainerDetails {
204204 , containerDetailsId :: ContainerID
205205 , containerDetailsImage :: ImageID
206206 , mountLabel :: Text
207− , name :: Text
207+ , names :: [Text]
208208 , networkSettings :: NetworkSettings
209209 , path :: FilePath
210210 , processLabel :: Text
@@ -331,7 +331,7 @@ instance FromJSON ContainerDetails where
331331 id <- parseJSON v
332332 image <- o .: "Image"
333333 mountLabel <- o .: "MountLabel"
334− name <- o .: "Name"
334+ names <- o .: "Names"
335335 networkSettings <- o .: "NetworkSettings"
336336 path <- o .: "Path"
337337 processLabel <- o .: "ProcessLabel"
@@ -339,7 +339,7 @@ instance FromJSON ContainerDetails where
339339 restartCount <- o .: "RestartCount"
340340 state <- o .: "State"
341341 mounts <- o .: "Mounts"
342− return $ ContainerDetails appArmor args config created driver hostConfig hostnamePath hostsPath logPath id image mountLabel name networkSettings path processLabel resolveConfPath restartCount state mounts
342+ return $ ContainerDetails appArmor args config created driver hostConfig hostnamePath hostsPath logPath id image mountLabel names networkSettings path processLabel resolveConfPath restartCount state mounts
343343 parseJSON _ = fail "ContainerDetails is not an object"
344344
345345instance ToJSON ContainerID where