git.iko.soy/docker-hs
on master help sign in
Add quick contianer info for listing

and add port binding (which have a different structure than the actual PortBinding while creating the container yay.) also add returning of atleast of ContainerID on the endpoints that return nothing. At least this way we can pipe stopContainer back into startContainer without providing the contianer id in 2 places.

commit580f0def8843b8bb8f53ad58088070bf4854b8c3 authorDeni Bertovic <deni@denibertovic.com> dateTue 15 Mar 2016, 16:46 (11 years ago) parente0a072a
3 files changed+112−69
compare with master
unifiedsplit
src/Docker.hs+31−53 src/Docker/Internal.hs+2−4 src/Docker/Types.hs+79−12
src/Docker.hs+31−53
@@ -13,7 +13,7 @@ import Network.HTTP.Types (StdMethod (..))
1313import Docker.Internal
1414import Docker.Types
1515
16−getDockerVersion :: DockerT IO (DockerVersion)
16+getDockerVersion :: DockerT IO DockerVersion
1717getDockerVersion = do
1818 (opts, httpHandler) <- ask
1919 let request = fromJust $ mkHttpRequest GET VersionEndpoint opts
@@ -22,7 +22,7 @@ getDockerVersion = do
2222 let res = decode body
2323 return $ fromJust res
2424
25−listContainers :: ListOpts -> DockerT IO ([Container])
25+listContainers :: ListOpts -> DockerT IO [Container]
2626listContainers lopts = do
2727 (opts, httpHandler) <- ask
2828 let request = fromJust $ mkHttpRequest GET (ListContainersEndpoint lopts) opts
@@ -31,8 +31,7 @@ listContainers lopts = do
3131 let res = decode body
3232 return $ fromJust res
3333
34−
35−listImages :: ListOpts -> DockerT IO ([Image])
34+listImages :: ListOpts -> DockerT IO [Image]
3635listImages lopts = do
3736 (opts, httpHandler) <- ask
3837 let request = fromJust $ mkHttpRequest GET (ListImagesEndpoint lopts) opts
@@ -41,78 +40,57 @@ listImages lopts = do
4140 let res = decode body
4241 return $ fromJust res
4342
44−
45−createContainer :: CreateOpts -> DockerT IO (ContainerID)
43+createContainer :: CreateOpts -> DockerT IO ContainerID
4644createContainer = undefined
4745
48−startContainer :: StartOpts -> ContainerID -> DockerT IO (ContainerID)
46+startContainer :: StartOpts -> ContainerID -> DockerT IO ContainerID
4947startContainer sopts cid = do
5048 (opts, httpHandler) <- ask
51− let request = fromJust $ mkHttpRequest GET (StartContainerEndpoint sopts cid) opts
52− response <- liftIO $ httpHandler request
53− let body = responseBody response
54− let res = decode body
55− return $ fromJust res
56−
49+ let request = fromJust $ mkHttpRequest POST (StartContainerEndpoint sopts cid) opts
50+ _ <- liftIO $ httpHandler request
51+ return cid
5752
58−stopContainer :: Timeout -> ContainerID ->DockerT IO ()
53+stopContainer :: Timeout -> ContainerID ->DockerT IO ContainerID
5954stopContainer t cid = do
6055 (opts, httpHandler) <- ask
61− let request = fromJust $ mkHttpRequest GET (StopContainerEndpoint t cid) opts
62− response <- liftIO $ httpHandler request
63− let body = responseBody response
64− let res = decode body
65− return $ fromJust res
66−
56+ let request = fromJust $ mkHttpRequest POST (StopContainerEndpoint t cid) opts
57+ _ <- liftIO $ httpHandler request
58+ return cid
6759
68−killContainer :: Signal -> ContainerID -> DockerT IO ()
60+killContainer :: Signal -> ContainerID -> DockerT IO ContainerID
6961killContainer s cid = do
7062 (opts, httpHandler) <- ask
71− let request = fromJust $ mkHttpRequest GET (KillContainerEndpoint s cid) opts
72− response <- liftIO $ httpHandler request
73− let body = responseBody response
74− let res = decode body
75− return $ fromJust res
63+ let request = fromJust $ mkHttpRequest POST (KillContainerEndpoint s cid) opts
64+ _ <- liftIO $ httpHandler request
65+ return cid
7666
77−
78−restartContainer :: Timeout -> ContainerID -> DockerT IO ()
67+restartContainer :: Timeout -> ContainerID -> DockerT IO ContainerID
7968restartContainer t cid = do
8069 (opts, httpHandler) <- ask
81− let request = fromJust $ mkHttpRequest GET (RestartContainerEndpoint t cid) opts
82− response <- liftIO $ httpHandler request
83− let body = responseBody response
84− let res = decode body
85− return $ fromJust res
70+ let request = fromJust $ mkHttpRequest POST (RestartContainerEndpoint t cid) opts
71+ _ <- liftIO $ httpHandler request
72+ return cid
8673
87−
88−pauseContainer :: ContainerID -> DockerT IO ()
74+pauseContainer :: ContainerID -> DockerT IO ContainerID
8975pauseContainer cid = do
9076 (opts, httpHandler) <- ask
91− let request = fromJust $ mkHttpRequest GET (PauseContainerEndpoint cid) opts
92− response <- liftIO $ httpHandler request
93− let body = responseBody response
94− let res = decode body
95− return $ fromJust res
96−
77+ let request = fromJust $ mkHttpRequest POST (PauseContainerEndpoint cid) opts
78+ _ <- liftIO $ httpHandler request
79+ return cid
9780
98−unpauseContainer :: ContainerID -> DockerT IO ()
81+unpauseContainer :: ContainerID -> DockerT IO ContainerID
9982unpauseContainer cid = do
10083 (opts, httpHandler) <- ask
10184 let request = fromJust $ mkHttpRequest GET (UnpauseContainerEndpoint cid) opts
102− response <- liftIO $ httpHandler request
103− let body = responseBody response
104− let res = decode body
105− return $ fromJust res
106−
85+ _ <- liftIO $ httpHandler request
86+ return cid
10787
108−deleteContainer :: DeleteOpts -> ContainerID -> DockerT IO ()
88+deleteContainer :: DeleteOpts -> ContainerID -> DockerT IO ContainerID
10989deleteContainer dopts cid = do
11090 (opts, httpHandler) <- ask
111− let request = fromJust $ mkHttpRequest GET (DeleteContainerEndpoint dopts cid) opts
112− response <- liftIO $ httpHandler request
113− let body = responseBody response
114− let res = decode body
115− return $ fromJust res
91+ let request = fromJust $ mkHttpRequest DELETE (DeleteContainerEndpoint dopts cid) opts
92+ _ <- liftIO $ httpHandler request
93+ return cid
11694
11795getContainerLogs :: LogOpts -> ContainerID -> DockerT IO ()
11896getContainerLogs = undefined
src/Docker/Internal.hs+2−4
@@ -17,9 +17,8 @@ import Docker.Types
1717
1818-- The reason we return Maybe Request is because the parseURL function
1919-- might find out parameters are invalid and will fail to build a Request
20−-- Since we're building the Requests this shouldn't happen, but would
21−-- benefit from testing that for instance all of our Endpoints are solid
22−-- and so on.
20+-- Since we are the ones building the Requests this shouldn't happen, but would
21+-- benefit from testing that on all of our Endpoints
2322mkHttpRequest :: HttpVerb -> Endpoint -> DockerClientOpts -> Maybe Request
2423mkHttpRequest verb e opts = request
2524 where fullE = T.unpack (baseUrl opts) ++ T.unpack (getEndpoint e)
@@ -67,7 +66,6 @@ getEndpoint (RestartContainerEndpoint t cid) = encodeURLWithQuery ["containers",
6766 where query = case t of
6867 Timeout x -> [("t", Just (encodeQ $ show x))]
6968 DefaultTimeout -> []
70−
7169getEndpoint (PauseContainerEndpoint cid) = encodeURL ["containers", cid, "pause"]
7270getEndpoint (UnpauseContainerEndpoint cid) = encodeURL ["containers", cid, "unpause"]
7371getEndpoint (ContainerLogsEndpoint cid (LogOpts follow stdout stderr since timestamps tail)) =
src/Docker/Types.hs+79−12
@@ -5,7 +5,7 @@ import Control.Monad.Except (ExceptT, runExceptT)
55import Control.Monad.Reader (ReaderT, runReaderT)
66import Data.Aeson (FromJSON, ToJSON, decode, encode,
77 genericParseJSON, genericToJSON, object,
8− parseJSON, toJSON, (.:), (.=))
8+ parseJSON, toJSON, (.:), (.:?), (.=))
99import qualified Data.Aeson as JSON
1010import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
1111import qualified Data.ByteString.Lazy as BL
@@ -97,8 +97,64 @@ instance FromJSON DockerVersion where
9797 parseJSON = genericParseJSON defaultOptions {
9898 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
9999
100+
101+data ContainerPortInfo = ContainerPortInfo {
102+ ipAddressInfo :: Maybe Text
103+ , privatePortInfo :: Port
104+ , publicPortInfo :: Maybe Port
105+ , portTypeInfo :: Maybe PortType
106+ } deriving (Eq, Show)
107+
108+instance FromJSON ContainerPortInfo where
109+ parseJSON (JSON.Object v) =
110+ ContainerPortInfo <$> (v .:? "IP")
111+ <*> (v .: "PrivatePort")
112+ <*> (v .:? "PublicPort")
113+ <*> (v .:? "Type")
114+
115+-- data NetworkOptions = NetworkOptions {
116+-- ipamConfig :: Maybe Text
117+-- , links :: Maybe Text
118+-- , aliases :: Maybe Text
119+-- , networkId :: Text
120+-- , endpointId :: Text
121+-- , gateway :: Text
122+-- , ipAddress :: Text
123+-- , ipPrefixLen :: Text
124+-- , ipV6Gateway :: Maybe Text
125+-- , globalIPv6Address :: Maybe Text
126+-- , globalIPv6PrefixLen :: Maybe Text
127+-- , macAddress :: Text
128+-- } deriving (Eq, Show)
129+
130+-- data Network = Network (M.Map NetworkMode NetworkOptions) deriving (Eq, Show)
131+
132+-- data NetworkSettings = NetworkSettings {
133+-- bridge
134+-- , sandboxId
135+-- , hairpinMode
136+-- , linkLocalIPv6Address
137+-- , linkLocalIPv6PrefixLen
138+-- , ports
139+-- , sandboxKey
140+-- , secondaryIPAddresses
141+-- , secondaryIPv6Addresses
142+-- , endpointID
143+-- , gateway
144+-- , globalIPv6Address
145+-- , globalIPv6PrefixLen
146+-- , ipAddress
147+-- , ipPrefixLen
148+-- , ipv6Gateway
149+-- , macAddress
150+-- , networks :: [Network]
151+-- }
152+
153+-- data NetworkSettings = NetworkSettings (M.Map Text Text) deriving (Eq, Show, Generic)
154+
155+-- instance FromJSON NetworkSettings
156+
100157-- TODO: Add NetworkSettings
101−-- TODO: Add PortBindings
102158data Container = Container
103159 { containerId :: ContainerID
104160 , containerNames :: [Text]
@@ -107,9 +163,9 @@ data Container = Container
107163 , containerCommand :: Text
108164 , containerCreatedAt :: Int
109165 , containerStatus :: Text
110− -- , containerPorts :: Text
166+ , containerPorts :: [ContainerPortInfo]
111167 , containerLabels :: Labels
112− -- , containerNetworkSettings :: Text
168+ -- , containerNetworkSettings :: NetworkSettings
113169 } deriving (Show, Eq)
114170
115171instance FromJSON Container where
@@ -121,12 +177,10 @@ instance FromJSON Container where
121177 <*> (v .: "Command")
122178 <*> (v .: "Created")
123179 <*> (v .: "Status")
124− -- <*> (v .: "Ports")
180+ <*> (v .: "Ports")
125181 <*> (v .: "Labels")
126182 -- <*> (v .: "NetworkSettings")
127183
128−
129−
130184data Status = Created | Restarting | Running | Paused | Exited | Dead deriving (Eq, Show, Generic)
131185
132186instance FromJSON Status
@@ -160,7 +214,11 @@ instance FromJSON Image where
160214 parseJSON = genericParseJSON defaultOptions {
161215 fieldLabelModifier = dropImagePrefix}
162216
163−data CreateOpts = CreateOpts
217+data CreateOpts = CreateOpts {
218+ containerConfig :: ContainerConfig
219+ , hostConfig :: HostConfig
220+ , containerResources :: ContainerResources
221+ } deriving (Eq, Show)
164222
165223-- detachKeys – Override the key sequence for detaching a container.
166224-- Format is a single character [a-Z] or ctrl-<value> where <value> is one of: a-z, @, ^, [, , or _.
@@ -224,8 +282,8 @@ data Link = Link Text (Maybe Text) deriving (Eq, Show)
224282
225283instance ToJSON Link where
226284 toJSON (Link n1 n2) = toJSON $ case n2 of
227− Nothing -> T.concat[n1, ":", n1]
228− Just n -> T.concat[n1, ":", n]
285+ Nothing -> T.concat[n1, ":", n1] -- use same name in container
286+ Just n -> T.concat[n1, ":", n] -- used specified name in container
229287
230288-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }
231289data LogDriverType = JsonFile | Syslog | Journald | Gelf | AwsLogs | Splunk | LoggingDisabled deriving (Eq, Show)
@@ -237,13 +295,22 @@ data LogDriverConfig = LogDriverConfig LogDriverType (Maybe LogDriverOptions) de
237295-- TODO: Add container:<name|id> mode
238296data NetworkMode = Bridge | Host | NetworkDisabled deriving (Eq, Show)
239297
240−data PortType = TCP | UDP deriving (Eq, Show)
298+data PortType = TCP | UDP deriving (Eq, Show, Generic)
299+
300+instance ToJSON PortType where
301+ toJSON TCP = "tcp"
302+ toJSON UDP = "udp"
303+
304+instance FromJSON PortType where
305+ parseJSON val = return $ case val of
306+ "tcp" -> TCP
307+ "udp" -> UDP
241308
242309newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
243310
244311-- { <port>/<protocol>: [{ "HostPort": "<port>" }] }
245312data PortBinding = PortBinding {
246− containerPort :: Integer
313+ containerPort :: Port
247314 , portType :: PortType
248315 , hostPort :: [HostPort]
249316 } deriving (Eq, Show)