git.iko.soy/docker-hs
on master help sign in
Add quick contianer info for listing
580f0deDeni Bertovic
src/Docker.hs+31−53
compare with master
unifiedsplit
@@ -13,7 +13,7 @@ import Network.HTTP.Types (StdMethod (..))
13import Docker.Internal
13import Docker.Internal
14import Docker.Types
14import Docker.Types
15
15
16−getDockerVersion :: DockerT IO (DockerVersion)
16+getDockerVersion :: DockerT IO DockerVersion
17getDockerVersion = do
17getDockerVersion = do
18 (opts, httpHandler) <- ask
18 (opts, httpHandler) <- ask
19 let request = fromJust $ mkHttpRequest GET VersionEndpoint opts
19 let request = fromJust $ mkHttpRequest GET VersionEndpoint opts
@@ -22,7 +22,7 @@ getDockerVersion = do
22 let res = decode body
22 let res = decode body
23 return $ fromJust res
23 return $ fromJust res
24
24
25−listContainers :: ListOpts -> DockerT IO ([Container])
25+listContainers :: ListOpts -> DockerT IO [Container]
26listContainers lopts = do
26listContainers lopts = do
27 (opts, httpHandler) <- ask
27 (opts, httpHandler) <- ask
28 let request = fromJust $ mkHttpRequest GET (ListContainersEndpoint lopts) opts
28 let request = fromJust $ mkHttpRequest GET (ListContainersEndpoint lopts) opts
@@ -31,8 +31,7 @@ listContainers lopts = do
31 let res = decode body
31 let res = decode body
32 return $ fromJust res
32 return $ fromJust res
33
33
34−
35−listImages :: ListOpts -> DockerT IO ([Image])
34+listImages :: ListOpts -> DockerT IO [Image]
36listImages lopts = do
35listImages lopts = do
37 (opts, httpHandler) <- ask
36 (opts, httpHandler) <- ask
38 let request = fromJust $ mkHttpRequest GET (ListImagesEndpoint lopts) opts
37 let request = fromJust $ mkHttpRequest GET (ListImagesEndpoint lopts) opts
@@ -41,78 +40,57 @@ listImages lopts = do
41 let res = decode body
40 let res = decode body
42 return $ fromJust res
41 return $ fromJust res
43
42
44−
45−createContainer :: CreateOpts -> DockerT IO (ContainerID)
43+createContainer :: CreateOpts -> DockerT IO ContainerID
46createContainer = undefined
44createContainer = undefined
47
45
48−startContainer :: StartOpts -> ContainerID -> DockerT IO (ContainerID)
46+startContainer :: StartOpts -> ContainerID -> DockerT IO ContainerID
49startContainer sopts cid = do
47startContainer sopts cid = do
50 (opts, httpHandler) <- ask
48 (opts, httpHandler) <- ask
51− let request = fromJust $ mkHttpRequest GET (StartContainerEndpoint sopts cid) opts
49+ let request = fromJust $ mkHttpRequest POST (StartContainerEndpoint sopts cid) opts
52− response <- liftIO $ httpHandler request
50+ _ <- liftIO $ httpHandler request
53− let body = responseBody response
54− let res = decode body
55− return $ fromJust res
51+ return cid
56−
57
52
58−stopContainer :: Timeout -> ContainerID ->DockerT IO ()
53+stopContainer :: Timeout -> ContainerID ->DockerT IO ContainerID
59stopContainer t cid = do
54stopContainer t cid = do
60 (opts, httpHandler) <- ask
55 (opts, httpHandler) <- ask
61− let request = fromJust $ mkHttpRequest GET (StopContainerEndpoint t cid) opts
56+ let request = fromJust $ mkHttpRequest POST (StopContainerEndpoint t cid) opts
62− response <- liftIO $ httpHandler request
57+ _ <- liftIO $ httpHandler request
63− let body = responseBody response
64− let res = decode body
65− return $ fromJust res
58+ return cid
66−
67
59
68−killContainer :: Signal -> ContainerID -> DockerT IO ()
60+killContainer :: Signal -> ContainerID -> DockerT IO ContainerID
69killContainer s cid = do
61killContainer s cid = do
70 (opts, httpHandler) <- ask
62 (opts, httpHandler) <- ask
71− let request = fromJust $ mkHttpRequest GET (KillContainerEndpoint s cid) opts
63+ let request = fromJust $ mkHttpRequest POST (KillContainerEndpoint s cid) opts
72− response <- liftIO $ httpHandler request
64+ _ <- liftIO $ httpHandler request
73− let body = responseBody response
74− let res = decode body
75− return $ fromJust res
65+ return cid
76
66
77−
78−restartContainer :: Timeout -> ContainerID -> DockerT IO ()
67+restartContainer :: Timeout -> ContainerID -> DockerT IO ContainerID
79restartContainer t cid = do
68restartContainer t cid = do
80 (opts, httpHandler) <- ask
69 (opts, httpHandler) <- ask
81− let request = fromJust $ mkHttpRequest GET (RestartContainerEndpoint t cid) opts
70+ let request = fromJust $ mkHttpRequest POST (RestartContainerEndpoint t cid) opts
82− response <- liftIO $ httpHandler request
71+ _ <- liftIO $ httpHandler request
83− let body = responseBody response
84− let res = decode body
85− return $ fromJust res
72+ return cid
86
73
87−
88−pauseContainer :: ContainerID -> DockerT IO ()
74+pauseContainer :: ContainerID -> DockerT IO ContainerID
89pauseContainer cid = do
75pauseContainer cid = do
90 (opts, httpHandler) <- ask
76 (opts, httpHandler) <- ask
91− let request = fromJust $ mkHttpRequest GET (PauseContainerEndpoint cid) opts
77+ let request = fromJust $ mkHttpRequest POST (PauseContainerEndpoint cid) opts
92− response <- liftIO $ httpHandler request
78+ _ <- liftIO $ httpHandler request
93− let body = responseBody response
94− let res = decode body
95− return $ fromJust res
79+ return cid
96−
97
80
98−unpauseContainer :: ContainerID -> DockerT IO ()
81+unpauseContainer :: ContainerID -> DockerT IO ContainerID
99unpauseContainer cid = do
82unpauseContainer cid = do
100 (opts, httpHandler) <- ask
83 (opts, httpHandler) <- ask
101 let request = fromJust $ mkHttpRequest GET (UnpauseContainerEndpoint cid) opts
84 let request = fromJust $ mkHttpRequest GET (UnpauseContainerEndpoint cid) opts
102− response <- liftIO $ httpHandler request
85+ _ <- liftIO $ httpHandler request
103− let body = responseBody response
104− let res = decode body
105− return $ fromJust res
86+ return cid
106−
107
87
108−deleteContainer :: DeleteOpts -> ContainerID -> DockerT IO ()
88+deleteContainer :: DeleteOpts -> ContainerID -> DockerT IO ContainerID
109deleteContainer dopts cid = do
89deleteContainer dopts cid = do
110 (opts, httpHandler) <- ask
90 (opts, httpHandler) <- ask
111− let request = fromJust $ mkHttpRequest GET (DeleteContainerEndpoint dopts cid) opts
91+ let request = fromJust $ mkHttpRequest DELETE (DeleteContainerEndpoint dopts cid) opts
112− response <- liftIO $ httpHandler request
92+ _ <- liftIO $ httpHandler request
113− let body = responseBody response
114− let res = decode body
115− return $ fromJust res
93+ return cid
116
94
117getContainerLogs :: LogOpts -> ContainerID -> DockerT IO ()
95getContainerLogs :: LogOpts -> ContainerID -> DockerT IO ()
118getContainerLogs = undefined
96getContainerLogs = undefined
src/Docker/Internal.hs+2−4
@@ -17,9 +17,8 @@ import Docker.Types
17
17
18-- The reason we return Maybe Request is because the parseURL function
18-- The reason we return Maybe Request is because the parseURL function
19-- might find out parameters are invalid and will fail to build a Request
19-- 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
20+-- Since we are the ones building the Requests this shouldn't happen, but would
21−-- benefit from testing that for instance all of our Endpoints are solid
21+-- benefit from testing that on all of our Endpoints
22−-- and so on.
23mkHttpRequest :: HttpVerb -> Endpoint -> DockerClientOpts -> Maybe Request
22mkHttpRequest :: HttpVerb -> Endpoint -> DockerClientOpts -> Maybe Request
24mkHttpRequest verb e opts = request
23mkHttpRequest verb e opts = request
25 where fullE = T.unpack (baseUrl opts) ++ T.unpack (getEndpoint e)
24 where fullE = T.unpack (baseUrl opts) ++ T.unpack (getEndpoint e)
@@ -67,7 +66,6 @@ getEndpoint (RestartContainerEndpoint t cid) = encodeURLWithQuery ["containers",
67 where query = case t of
66 where query = case t of
68 Timeout x -> [("t", Just (encodeQ $ show x))]
67 Timeout x -> [("t", Just (encodeQ $ show x))]
69 DefaultTimeout -> []
68 DefaultTimeout -> []
70−
71getEndpoint (PauseContainerEndpoint cid) = encodeURL ["containers", cid, "pause"]
69getEndpoint (PauseContainerEndpoint cid) = encodeURL ["containers", cid, "pause"]
72getEndpoint (UnpauseContainerEndpoint cid) = encodeURL ["containers", cid, "unpause"]
70getEndpoint (UnpauseContainerEndpoint cid) = encodeURL ["containers", cid, "unpause"]
73getEndpoint (ContainerLogsEndpoint cid (LogOpts follow stdout stderr since timestamps tail)) =
71getEndpoint (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)
5import Control.Monad.Reader (ReaderT, runReaderT)
5import Control.Monad.Reader (ReaderT, runReaderT)
6import Data.Aeson (FromJSON, ToJSON, decode, encode,
6import Data.Aeson (FromJSON, ToJSON, decode, encode,
7 genericParseJSON, genericToJSON, object,
7 genericParseJSON, genericToJSON, object,
8− parseJSON, toJSON, (.:), (.=))
8+ parseJSON, toJSON, (.:), (.:?), (.=))
9import qualified Data.Aeson as JSON
9import qualified Data.Aeson as JSON
10import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
10import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
11import qualified Data.ByteString.Lazy as BL
11import qualified Data.ByteString.Lazy as BL
@@ -97,8 +97,64 @@ instance FromJSON DockerVersion where
97 parseJSON = genericParseJSON defaultOptions {
97 parseJSON = genericParseJSON defaultOptions {
98 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
98 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
99
99
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+
100-- TODO: Add NetworkSettings
157-- TODO: Add NetworkSettings
101−-- TODO: Add PortBindings
102data Container = Container
158data Container = Container
103 { containerId :: ContainerID
159 { containerId :: ContainerID
104 , containerNames :: [Text]
160 , containerNames :: [Text]
@@ -107,9 +163,9 @@ data Container = Container
107 , containerCommand :: Text
163 , containerCommand :: Text
108 , containerCreatedAt :: Int
164 , containerCreatedAt :: Int
109 , containerStatus :: Text
165 , containerStatus :: Text
110− -- , containerPorts :: Text
166+ , containerPorts :: [ContainerPortInfo]
111 , containerLabels :: Labels
167 , containerLabels :: Labels
112− -- , containerNetworkSettings :: Text
168+ -- , containerNetworkSettings :: NetworkSettings
113 } deriving (Show, Eq)
169 } deriving (Show, Eq)
114
170
115instance FromJSON Container where
171instance FromJSON Container where
@@ -121,12 +177,10 @@ instance FromJSON Container where
121 <*> (v .: "Command")
177 <*> (v .: "Command")
122 <*> (v .: "Created")
178 <*> (v .: "Created")
123 <*> (v .: "Status")
179 <*> (v .: "Status")
124− -- <*> (v .: "Ports")
180+ <*> (v .: "Ports")
125 <*> (v .: "Labels")
181 <*> (v .: "Labels")
126 -- <*> (v .: "NetworkSettings")
182 -- <*> (v .: "NetworkSettings")
127
183
128−
129−
130data Status = Created | Restarting | Running | Paused | Exited | Dead deriving (Eq, Show, Generic)
184data Status = Created | Restarting | Running | Paused | Exited | Dead deriving (Eq, Show, Generic)
131
185
132instance FromJSON Status
186instance FromJSON Status
@@ -160,7 +214,11 @@ instance FromJSON Image where
160 parseJSON = genericParseJSON defaultOptions {
214 parseJSON = genericParseJSON defaultOptions {
161 fieldLabelModifier = dropImagePrefix}
215 fieldLabelModifier = dropImagePrefix}
162
216
163−data CreateOpts = CreateOpts
217+data CreateOpts = CreateOpts {
218+ containerConfig :: ContainerConfig
219+ , hostConfig :: HostConfig
220+ , containerResources :: ContainerResources
221+ } deriving (Eq, Show)
164
222
165-- detachKeys – Override the key sequence for detaching a container.
223-- detachKeys – Override the key sequence for detaching a container.
166-- Format is a single character [a-Z] or ctrl-<value> where <value> is one of: a-z, @, ^, [, , or _.
224-- 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)
224
282
225instance ToJSON Link where
283instance ToJSON Link where
226 toJSON (Link n1 n2) = toJSON $ case n2 of
284 toJSON (Link n1 n2) = toJSON $ case n2 of
227− Nothing -> T.concat[n1, ":", n1]
285+ Nothing -> T.concat[n1, ":", n1] -- use same name in container
228− Just n -> T.concat[n1, ":", n]
286+ Just n -> T.concat[n1, ":", n] -- used specified name in container
229
287
230-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }
288-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }
231data LogDriverType = JsonFile | Syslog | Journald | Gelf | AwsLogs | Splunk | LoggingDisabled deriving (Eq, Show)
289data LogDriverType = JsonFile | Syslog | Journald | Gelf | AwsLogs | Splunk | LoggingDisabled deriving (Eq, Show)
@@ -237,13 +295,22 @@ data LogDriverConfig = LogDriverConfig LogDriverType (Maybe LogDriverOptions) de
237-- TODO: Add container:<name|id> mode
295-- TODO: Add container:<name|id> mode
238data NetworkMode = Bridge | Host | NetworkDisabled deriving (Eq, Show)
296data NetworkMode = Bridge | Host | NetworkDisabled deriving (Eq, Show)
239
297
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
241
308
242newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
309newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
243
310
244-- { <port>/<protocol>: [{ "HostPort": "<port>" }] }
311-- { <port>/<protocol>: [{ "HostPort": "<port>" }] }
245data PortBinding = PortBinding {
312data PortBinding = PortBinding {
246− containerPort :: Integer
313+ containerPort :: Port
247 , portType :: PortType
314 , portType :: PortType
248 , hostPort :: [HostPort]
315 , hostPort :: [HostPort]
249 } deriving (Eq, Show)
316 } deriving (Eq, Show)