43b5352 · docker-hs · git.iko.soy

examples/Example.hs+2−2

compare with master

unifiedsplit

@@ -4,7 +4,7 @@ runNginxContainer :: IO ContainerID

4runNginxContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

5 let pb = PortBinding 80 TCP [HostPort "0.0.0.0" 8000]

6 let myCreateOpts = addPortBinding (defaultCreateOpts "nginx:latest") pb

7− cid <- createContainer myCreateOpts

7+ cid <- createContainer myCreateOpts (Just "myNginxContainer")

8 case cid of

9 Left err -> error $ show err

10 Right i -> do

@@ -22,7 +22,7 @@ runPostgresContainer :: IO ContainerID

22runPostgresContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

23 let pb = PortBinding 5432 TCP [HostPort "0.0.0.0" 5432]

24 let myCreateOpts = addBinds [Bind "/tmp" "/tmp" Nothing] $ addPortBinding (defaultCreateOpts "postgres:9.5") pb

25− cid <- createContainer myCreateOpts

25+ cid <- createContainer myCreateOpts Nothing

26 case cid of

27 Left err -> error $ show err

28 Right i -> do

src/Docker/Client/Api.hs+2−2

@@ -77,8 +77,8 @@ listImages opts = requestHelper GET (ListImagesEndpoint opts) >>= parseResponse

77-- | Creates a docker container but does __not__ start it. See

78-- 'CreateOpts' for a list of options and you can use 'defaultCreateOpts'

79-- for some sane defaults.

80−createContainer :: forall m. Monad m => CreateOpts -> DockerT m (Either DockerError ContainerID)

80+createContainer :: forall m. Monad m => CreateOpts -> Maybe ContainerName -> DockerT m (Either DockerError ContainerID)

81−createContainer opts = requestHelper POST (CreateContainerEndpoint opts) >>= parseResponse

81+createContainer opts cn = requestHelper POST (CreateContainerEndpoint opts cn) >>= parseResponse

82

83-- | Start a container from a given 'ContainerID' that we get from

84-- 'createContainer'. See 'StartOpts' for a list of configuration options

src/Docker/Client/Http.hs+1−1

@@ -179,7 +179,7 @@ statusCodeToError (ListImagesEndpoint _) st =

179 Nothing

180 else

181 Just $ DockerInvalidStatusCode st

182−statusCodeToError (CreateContainerEndpoint _) st =

182+statusCodeToError (CreateContainerEndpoint _ _) st =

183 if st == status201 then

184 Nothing

185 else

src/Docker/Client/Internal.hs+4−2

@@ -26,7 +26,9 @@ getEndpoint :: Endpoint -> T.Text

26getEndpoint VersionEndpoint = encodeURL ["version"]

27getEndpoint (ListContainersEndpoint _) = encodeURL ["containers", "json"] -- Make use of lsOpts here

28getEndpoint (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"]

30getEndpoint (StartContainerEndpoint startOpts cid) = encodeURLWithQuery ["containers", fromContainerID cid, "start"] query

32getEndpoint (StartContainerEndpoint startOpts cid) = encodeURLWithQuery ["containers", fromContainerID cid, "start"] query

31 where query = case (detachKeys startOpts) of

33 where query = case (detachKeys startOpts) of

32 WithCtrl c -> [("detachKeys", Just (encodeQ $ ctrl ++ [c]))]

34 WithCtrl c -> [("detachKeys", Just (encodeQ $ ctrl ++ [c]))]

@@ -61,7 +63,7 @@ getEndpointRequestBody :: Endpoint -> Maybe BSL.ByteString

61getEndpointRequestBody VersionEndpoint = Nothing

63getEndpointRequestBody VersionEndpoint = Nothing

62getEndpointRequestBody (ListContainersEndpoint _) = Nothing

64getEndpointRequestBody (ListContainersEndpoint _) = Nothing

63getEndpointRequestBody (ListImagesEndpoint _) = Nothing

65getEndpointRequestBody (ListImagesEndpoint _) = Nothing

64−getEndpointRequestBody (CreateContainerEndpoint opts) = Just $ JSON.encode opts

66+getEndpointRequestBody (CreateContainerEndpoint opts _) = Just $ JSON.encode opts

65getEndpointRequestBody (StartContainerEndpoint _ _) = Nothing

67getEndpointRequestBody (StartContainerEndpoint _ _) = Nothing

66getEndpointRequestBody (StopContainerEndpoint _ _) = Nothing

68getEndpointRequestBody (StopContainerEndpoint _ _) = Nothing

67getEndpointRequestBody (KillContainerEndpoint _ _) = Nothing

69getEndpointRequestBody (KillContainerEndpoint _ _) = Nothing

src/Docker/Client/Types.hs+4−4

@@ -102,7 +102,7 @@ data Endpoint =

102 VersionEndpoint

103 | ListContainersEndpoint ListOpts

104 | ListImagesEndpoint ListOpts

105− | CreateContainerEndpoint CreateOpts

105+ | CreateContainerEndpoint CreateOpts (Maybe ContainerName)

106 | StartContainerEndpoint StartOpts ContainerID

107 | StopContainerEndpoint Timeout ContainerID

108 | KillContainerEndpoint Signal ContainerID

@@ -204,7 +204,7 @@ data ContainerDetails = ContainerDetails {

204 , containerDetailsId :: ContainerID

205 , containerDetailsImage :: ImageID

206 , mountLabel :: Text

207− , name :: Text

207+ , names :: [Text]

208 , networkSettings :: NetworkSettings

209 , path :: FilePath

210 , processLabel :: Text

@@ -331,7 +331,7 @@ instance FromJSON ContainerDetails where

331 id <- parseJSON v

332 image <- o .: "Image"

333 mountLabel <- o .: "MountLabel"

334− name <- o .: "Name"

334+ names <- o .: "Names"

335 networkSettings <- o .: "NetworkSettings"

336 path <- o .: "Path"

337 processLabel <- o .: "ProcessLabel"

@@ -339,7 +339,7 @@ instance FromJSON ContainerDetails where

339 restartCount <- o .: "RestartCount"

340 state <- o .: "State"

341 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

343 parseJSON _ = fail "ContainerDetails is not an object"

344

345instance ToJSON ContainerID where