on b2b575e help sign in
docker-hs/src/Docker/Types.hs
1159 lines 45 kB history raw
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE ScopedTypeVariables #-}
4module Docker.Types (
5 Endpoint(..)
6 , URL
7 , ApiVersion
8 , ContainerID
9 , fromContainerID
10 , toContainerID
11 , ImageID
12 , fromImageID
13 , toImageID
14 , Timeout(..)
15 , Signal(..)
16 , ContainerDetails(..)
17 , DockerClientOpts(..)
18 , defaultClientOpts
19 , ListOpts(..)
20 , defaultListOpts
21 , DockerVersion(..)
22 , ContainerPortInfo(..)
23 , Container(..)
24 , ContainerState(..)
25 , Status(..)
26 , Digest
27 , Labels(..)
28 , Tag
29 , Image(..)
30 , dropImagePrefix
31 , CreateOpts(..)
32 , defaultCreateOpts
33 , DetachKeys(..)
34 , StartOpts(..)
35 , defaultStartOpts
36 , DeleteOpts(..)
37 , Timestamp
38 , TailLogOpt(..)
39 , LogOpts(..)
40 , defaultLogOpts
41 , VolumePermission(..)
42 , Volume(..)
43 , Device(..)
44 , ContainerName
45 , VolumeFrom(..)
46 , Link(..)
47 , LogDriverType(..)
48 , LogDriverOptions(..)
49 , LogDriverConfig(..)
50 , NetworkMode(..)
51 , PortType(..)
52 , NetworkInterface(..)
53 , Networks(..)
54 , NetworkSettings(..)
55 , NetworkOptions(..)
56 , Mount(..)
57 , PortBinding(..)
58 , PortBindings(..)
59 , HostPort(..)
60 , RetryCount
61 , RestartPolicy(..)
62 , Isolation(..)
63 , UTSMode(..)
64 , HostConfig(..)
65 , defaultHostConfig
66 , Ulimit(..)
67 , ContainerResources(..)
68 , defaultContainerResources
69 , Port
70 , Name
71 , Value
72 , EnvVar(..)
73 , ContainerConfig(..)
74 , defaultContainerConfig
75 , ExposedPorts(..)
76 ) where
78import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
79 genericToJSON, object, parseJSON, toJSON,
80 (.!=), (.:), (.:?), (.=))
81import qualified Data.Aeson as JSON
82import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
83import Data.Char (isAlphaNum, toUpper)
84import qualified Data.HashMap.Strict as HM
85import qualified Data.Map as M
86import Data.Monoid ((<>))
87import Data.Text (Text)
88import qualified Data.Text as T
89import Data.Time.Clock (UTCTime)
90import GHC.Generics (Generic)
91import Prelude hiding (all, tail)
92import Text.Read (readMaybe)
94data Endpoint =
95 VersionEndpoint
96 | ListContainersEndpoint ListOpts
97 | ListImagesEndpoint ListOpts
98 | CreateContainerEndpoint CreateOpts
99 | StartContainerEndpoint StartOpts ContainerID
100 | StopContainerEndpoint Timeout ContainerID
101 | KillContainerEndpoint Signal ContainerID
102 | RestartContainerEndpoint Timeout ContainerID
103 | PauseContainerEndpoint ContainerID
104 | UnpauseContainerEndpoint ContainerID
105 | ContainerLogsEndpoint LogOpts Bool ContainerID -- Second argument (Bool) is whether to follow.
106 | DeleteContainerEndpoint DeleteOpts ContainerID
107 | InspectContainerEndpoint ContainerID
108 deriving (Eq, Show)
110type URL = Text
111type ApiVersion = Text
112newtype ContainerID = ContainerID Text
113 deriving (Eq, Show)
115fromContainerID :: ContainerID -> Text
116fromContainerID (ContainerID t) = t
118toContainerID :: Text -> Maybe ContainerID
119toContainerID t =
120 if T.all (\c -> isAlphaNum c || c == ':') t then -- Note: Can we improve this whitelist?
121 Just $ ContainerID t
122 else
123 Nothing
125newtype ImageID = ImageID Text
126 deriving (Eq, Show)
128fromImageID :: ImageID -> Text
129fromImageID (ImageID t) = t
131toImageID :: Text -> Maybe ImageID
132toImageID t =
133 if T.all (\c -> isAlphaNum c || c == ':') t then -- Note: Can we improve this whitelist?
134 Just $ ImageID t
135 else
136 Nothing
138data Timeout = Timeout Integer | DefaultTimeout deriving (Eq, Show)
140-- TODO: Add more Signals or use an existing lib
141data Signal = SIGHUP
142 | SIGINT
143 | SIGQUIT
144 | SIGSTOP
145 | SIGTERM
146 | SIGUSR1
147 | SIG Integer
148 | SIGKILL deriving (Eq, Show)
150instance FromJSON Signal where
151 parseJSON (JSON.String "SIGTERM") = return SIGTERM
152 parseJSON (JSON.String "SIGHUP") = return SIGHUP -- Note: Guessing on the string values for these.
153 parseJSON (JSON.String "SIGINT") = return SIGINT
154 parseJSON (JSON.String "SIGQUIT") = return SIGQUIT
155 parseJSON (JSON.String "SIGSTOP") = return SIGSTOP
156 parseJSON (JSON.String "SIGUSR1") = return SIGUSR1
157 parseJSON _ = fail "Unknown Signal"
159instance ToJSON Signal where
160 toJSON SIGHUP = "SIGHUP"
161 toJSON SIGINT = "SIGINT"
162 toJSON SIGQUIT = "SIGQUIT"
163 toJSON SIGSTOP = "SIGSTOP"
164 toJSON SIGTERM = "SIGTERM"
165 toJSON SIGUSR1 = "SIGUSR1"
166 toJSON (SIG i) = toJSON i
167 toJSON SIGKILL = "SIGKILL"
169data ContainerDetails = ContainerDetails {
170 appArmorProfile :: Text
171 , args :: [Text]
172 , containerDetailsConfig :: ContainerConfig
173 , created :: UTCTime
174 , driver :: Text
175 -- , execIDs -- Not sure what this is in 1.24 spec.
176 , containerDetailsHostConfig :: HostConfig
177 , hostnamePath :: FilePath
178 , hostsPath :: FilePath
179 , logPath :: FilePath
180 , containerDetailsId :: ContainerID
181 , containerDetailsImage :: ImageID
182 , mountLabel :: Text
183 , name :: Text
184 , networkSettings :: NetworkSettings
185 , path :: FilePath
186 , processLabel :: Text
187 , resolveConfPath :: FilePath
188 , restartCount :: Int
189 , state :: ContainerState
190 , mounts :: [Mount]
191 }
192 deriving (Eq, Show, Generic)
194data Mount = Mount {
195 mountName :: Text
196 , mountSource :: FilePath
197 , mountDestination :: FilePath
198 , mountDriver :: Text
199 , mountMode :: Text -- Note: Improve this?
200 , mountRW :: Bool
201 , mountPropogation :: Text
202 }
203 deriving (Eq, Show, Generic)
205instance FromJSON Mount where
206 parseJSON (JSON.Object o) = do
207 name <- o .: "Name"
208 src <- o .: "Source"
209 dest <- o .: "Destination"
210 driver <- o .: "Driver"
211 mode <- o .: "Mode"
212 rw <- o .: "RW"
213 prop <- o .: "Propagation"
214 return $ Mount name src dest driver mode rw prop
215 parseJSON _ = fail "Mount is not an object"
217data ContainerState = ContainerState {
218 containerError :: Text
219 , exitCode :: Int
220 , finishedAt :: Maybe UTCTime -- Note: Is this a maybe?
221 , oomKilled :: Bool
222 , dead :: Bool
223 , paused :: Bool
224 , pid :: Int
225 , restarting :: Bool
226 , running :: Bool
227 , startedAt :: UTCTime
228 , status :: Status
229 }
230 deriving (Eq, Show, Generic)
232instance FromJSON ContainerState where
233 parseJSON (JSON.Object o) = do
234 err <- o .: "Error"
235 exit <- o .: "ExitCode"
236 finished <- o .:? "FinishedAt"
237 oomKilled <- o .: "OOMKilled"
238 dead <- o .: "Dead"
239 paused <- o .: "Paused"
240 pid <- o .: "Pid"
241 restarting <- o .: "Restarting"
242 running <- o .: "Running"
243 started <- o .: "StartedAt"
244 st <- o .: "Status"
245 return $ ContainerState err exit finished oomKilled dead paused pid restarting running started st
246 parseJSON _ = fail "ContainerState is not an object"
248data DockerClientOpts = DockerClientOpts {
249 apiVer :: ApiVersion
250 , baseUrl :: URL
251 }
252 deriving (Eq, Show)
254defaultClientOpts :: DockerClientOpts
255defaultClientOpts = DockerClientOpts {
256 apiVer = "v1.23"
257 , baseUrl = "http://127.0.0.1:2375"
258 }
260data ListOpts = ListOpts { all :: Bool } deriving (Eq, Show)
262defaultListOpts :: ListOpts
263defaultListOpts = ListOpts { all=False }
265data DockerVersion = DockerVersion {
266 version :: Text
267 , apiVersion :: ApiVersion
268 , gitCommit :: Text
269 , goVersion :: Text
270 , os :: Text
271 , arch :: Text
272 , kernelVersion :: Text
273 , buildTime :: Text
274 } deriving (Show, Eq, Generic)
277instance ToJSON DockerVersion where
278 toJSON = genericToJSON defaultOptions {
279 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
281instance FromJSON DockerVersion where
282 parseJSON = genericParseJSON defaultOptions {
283 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
285-- instance ToJSON ContainerDetails where
286-- toJSON = error "TODO"
288instance FromJSON ContainerDetails where
289 parseJSON (JSON.Object o) = do
290 appArmor <- o .: "AppArmorProfile"
291 args <- o .: "Args"
292 config <- o .: "Config"
293 created <- o .: "Created"
294 driver <- o .: "Driver"
295 hostConfig <- o .: "HostConfig"
296 hostnamePath <- o .: "HostnamePath"
297 hostsPath <- o .: "HostsPath"
298 logPath <- o .: "LogPath"
299 id <- o .: "Id"
300 image <- o .: "Image"
301 mountLabel <- o .: "MountLabel"
302 name <- o .: "Name"
303 networkSettings <- o .: "NetworkSettings"
304 path <- o .: "Path"
305 processLabel <- o .: "ProcessLabel"
306 resolveConfPath <- o .: "ResolvConfPath"
307 restartCount <- o .: "RestartCount"
308 state <- o .: "State"
309 mounts <- o .: "Mounts"
310 return $ ContainerDetails appArmor args config created driver hostConfig hostnamePath hostsPath logPath id image mountLabel name networkSettings path processLabel resolveConfPath restartCount state mounts
311 parseJSON _ = fail "ContainerDetails is not an object"
313instance ToJSON ContainerID where
314 toJSON (ContainerID cid) = object ["Id" .= cid]
316instance FromJSON ContainerID where
317 parseJSON (JSON.Object o) = do
318 cid <- o .: "Id"
319 case toContainerID cid of
320 Nothing ->
321 fail "Invalid ContainerID"
322 Just cid ->
323 return cid
324 parseJSON _ = fail "ContainerID is not an object."
326instance ToJSON ImageID where
327 toJSON (ImageID iid) = JSON.String iid
329instance FromJSON ImageID where
330 parseJSON (JSON.String t) = case toImageID t of
331 Nothing ->
332 fail "Invalid ImageID"
333 Just iid ->
334 return iid
335 parseJSON _ = fail "ImageID is not an object."
337data ContainerPortInfo = ContainerPortInfo {
338 ipAddressInfo :: Maybe Text
339 , privatePortInfo :: Port
340 , publicPortInfo :: Maybe Port
341 , portTypeInfo :: Maybe PortType
342 } deriving (Eq, Show)
344instance FromJSON ContainerPortInfo where
345 parseJSON (JSON.Object v) =
346 ContainerPortInfo <$> (v .:? "IP")
347 <*> (v .: "PrivatePort")
348 <*> (v .:? "PublicPort")
349 <*> (v .:? "Type")
350 parseJSON _ = fail "ContainerPortInfo: Not a JSON object."
352-- For inspecting container details.
353data NetworkOptions = NetworkOptions {
354-- ipamConfig :: Maybe Text -- Don't see in 1.24
355-- , links :: Maybe Text -- Don't see in 1.24
356-- , aliases :: Maybe Text -- Don't see in 1.24
357 networkOptionsId :: Text
358 , networkOptionsEndpointId :: Text
359 , networkOptionsGateway :: Text
360 , networkOptionsIpAddress :: Text -- Note: Parse this?
361 , networkOptionsIpPrefixLen :: Int
362 , networkOptionsIpV6Gateway :: Maybe Text
363 , networkOptionsGlobalIPv6Address :: Maybe Text
364 , networkOptionsGlobalIPv6PrefixLen :: Maybe Int
365 , networkOptionsMacAddress :: Text
366 } deriving (Eq, Show)
368instance FromJSON NetworkOptions where
369 parseJSON (JSON.Object o) = do
370 networkId <- o .: "NetworkID"
371 endpointId <- o .: "EndpointID"
372 gateway <- o .: "Gateway"
373 ip <- o .: "IPAddress"
374 ipLen <- o .: "IPPrefixLen"
375 ip6Gateway <- o .:? "IPv6Gateway"
376 globalIP6 <- o .:? "GlobalIPv6Address"
377 globalIP6Len <- o .:? "GlobalIPv6PrefixLen"
378 mac <- o .: "MacAddress"
379 return $ NetworkOptions networkId endpointId gateway ip ipLen ip6Gateway globalIP6 globalIP6Len mac
380 parseJSON _ = fail "NetworkOptions is not an object"
382newtype Networks = Networks (M.Map NetworkMode NetworkOptions) -- Note: Is it ever possible that there will be duplicates of network modes?
383 deriving (Eq, Show)
385instance FromJSON Networks where
386 parseJSON (JSON.Object o) = do
387 Networks <$> HM.foldlWithKey' f (return M.empty) o
389 where
390 f accM k' v' = do
391 acc <- accM
392 k <- parseJSON $ JSON.String k'
393 v <- parseJSON v'
394 return $ M.insert k v acc
396 parseJSON _ = fail "Networks is not an object"
398data NetworkSettings = NetworkSettings {
399 networkSettingsBridge :: Text
400 , networkSettingsSandboxId :: Text
401 , networkSettingsHairpinMode :: Bool
402 , networkSettingsLinkLocalIPv6Address :: Text
403 , networkSettingsLinkLocalIPv6PrefixLen :: Int
404 , networkSettingsPorts :: [Port] -- TODO: 1.24 spec is unclear
405 , networkSettingsSandboxKey :: Text
406 , networkSettingsSecondaryIPAddresses :: Maybe [Text] -- TODO: 1.24 spec is unclear
407 , networkSettingsSecondaryIPv6Addresses :: Maybe [Text] -- TODO: 1.24 spec is unclear
408 , networkSettingsEndpointID :: Text
409 , networkSettingsGateway :: Text
410 , networkSettingsGlobalIPv6Address :: Text
411 , networkSettingsGlobalIPv6PrefixLen :: Int
412 , networkSettingsIpAddress :: Text
413 , networkSettingsIpPrefixLen :: Int
414 , networkSettingsIpv6Gateway
415 , networkSettingsMacAddress
416 , networkSettingsNetworks :: Networks
417 }
418 deriving (Eq, Show)
420instance FromJSON NetworkSettings where
421 parseJSON (JSON.Object o) = do
422 bridge <- o .: "Bridge"
423 sandbox <- o .: "SandboxID"
424 hairpin <- o .: "HairpinMode"
425 localIP6 <- o .: "LinkLocalIPv6Address"
426 localIP6Len <- o .: "LinkLocalIPv6PrefixLen"
427 ports <- o .:? "Ports" .!= []
428 sandboxKey <- o .: "SandboxKey"
429 secondaryIP <- o .: "SecondaryIPAddresses"
430 secondayIP6 <- o .: "SecondaryIPv6Addresses"
431 endpointID <- o .: "EndpointID"
432 gateway <- o .: "Gateway"
433 globalIP6 <- o .: "GlobalIPv6Address"
434 globalIP6Len <- o .: "GlobalIPv6PrefixLen"
435 ip <- o .: "IPAddress"
436 ipLen <- o .: "IPPrefixLen"
437 ip6Gateway <- o .: "IPv6Gateway"
438 mac <- o .: "MacAddress"
439 networks <- o .: "Networks"
440 return $ NetworkSettings bridge sandbox hairpin localIP6 localIP6Len ports sandboxKey secondaryIP secondayIP6 endpointID gateway globalIP6 globalIP6Len ip ipLen ip6Gateway mac networks
441 parseJSON _ = fail "NetworkSettings is not an Object"
443data Container = Container
444 { containerId :: ContainerID
445 , containerNames :: [Text]
446 , containerImageName :: Text
447 , containerImageId :: ImageID
448 , containerCommand :: Text
449 , containerCreatedAt :: Int
450 , containerStatus :: Status
451 , containerPorts :: [ContainerPortInfo]
452 , containerLabels :: Labels
453 , containerNetworks :: Networks
454 , containerMounts :: [Mount]
455 } deriving (Show, Eq)
457instance FromJSON Container where
458 parseJSON (JSON.Object v) =
459 Container <$> (v .: "Id")
460 <*> (v .: "Names")
461 <*> (v .: "Image")
462 <*> (v .: "ImageID")
463 <*> (v .: "Command")
464 <*> (v .: "Created")
465 <*> (v .: "Status")
466 <*> (v .: "Ports")
467 <*> (v .: "Labels")
468 <*> (v .: "NetworkSettings" >>= parseNetworks)
469 <*> (v .: "Mounts")
470 where
471 parseNetworks (JSON.Object v) =
472 (v .: "Networks") >>= parseJSON
473 parseNetworks _ = fail "Container NetworkSettings: Not a JSON object."
475 parseJSON _ = fail "Container: Not a JSON object."
477data Status = Created | Restarting | Running | Paused | Exited | Dead
478 deriving (Eq, Show, Generic)
480instance FromJSON Status where
481 parseJSON (JSON.String "running") = return Running
482 parseJSON (JSON.String "created") = return Created -- Note: Guessing on the string values of these.
483 parseJSON (JSON.String "restarting") = return Restarting
484 parseJSON (JSON.String "paused") = return Paused
485 parseJSON (JSON.String "exited") = return Exited
486 parseJSON (JSON.String "dead") = return Dead
487 parseJSON _ = fail "Unknown Status"
489type Digest = Text
491newtype Labels = Labels (M.Map Name Value) deriving (Eq, Show)
493instance FromJSON Labels where
494 parseJSON val = Labels <$> parseJSON val
496instance ToJSON Labels where
497 toJSON (Labels kvs) = object [k .= v | (k,v) <- (M.toList kvs)]
499type Tag = Text
501data Image = DockerImage {
502 imageId :: ImageID
503 , imageCreated :: Integer
504 , imageParentId :: Maybe ImageID
505 , imageRepoTags :: [Tag]
506 , imageRepoDigests :: Maybe [Digest]
507 , imageSize :: Integer
508 , imageVirtualSize :: Integer
509 , imageLabels :: Maybe Labels
510 } deriving (Show, Eq, Generic)
512dropImagePrefix :: [a] -> [a]
513dropImagePrefix = drop 5
515instance FromJSON Image where
516 parseJSON = genericParseJSON defaultOptions {
517 fieldLabelModifier = dropImagePrefix}
519data CreateOpts = CreateOpts {
520 containerConfig :: ContainerConfig
521 , hostConfig :: HostConfig
522 } deriving (Eq, Show)
524instance ToJSON CreateOpts where
525 toJSON (CreateOpts cc hc) = do
526 let ccJSON = toJSON cc
527 let hcJSON = toJSON hc
528 case ccJSON of
529 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do
530 JSON.Object $ HM.insert "HostConfig" hcJSON o
531 _ -> error "ContainerConfig is not an object." -- This should never happen.
533defaultContainerConfig :: Text -> ContainerConfig
534defaultContainerConfig imageName = ContainerConfig {
535 hostname=Nothing
536 , domainname=Nothing
537 , user=Nothing
538 , attachStdin=False
539 , attachStdout=False
540 , image=imageName
541 , attachStderr=False
542 , exposedPorts=ExposedPorts M.empty
543 , tty=False
544 , openStdin=False
545 , stdinOnce=False
546 , env=[]
547 , cmd=[]
548 , volumes=Nothing
549 , workingDir=Nothing
550 , entrypoint=Nothing
551 , networkDisabled=Nothing
552 , macAddress=Nothing
553 , labels=Nothing
554 , stopSignal=SIGTERM
555 }
557defaultHostConfig :: HostConfig
558defaultHostConfig = HostConfig {
559 binds=[]
560 , containerIDFile=Nothing
561 , logConfig=LogDriverConfig JsonFile Nothing
562 , networkMode=Bridge
563 , portBindings=PortBindings []
564 , restartPolicy=RestartOff
565 , volumeDriver=Nothing
566 , volumesFrom=[]
567 , capAdd=[]
568 , capDrop=[]
569 , dns=[]
570 , dnsOptions=[]
571 , dnsSearch=[]
572 , extraHosts=[]
573 , ipcMode=Nothing
574 , links=Nothing
575 , oomScoreAdj=Nothing
576 , privileged=False
577 , publishAllPorts=False
578 , readonlyRootfs=False
579 , securityOpt=[]
580 , shmSize=Nothing
581 , resources=defaultContainerResources
582 }
584defaultContainerResources :: ContainerResources
585defaultContainerResources = ContainerResources {
586 cpuShares=Nothing
587 , blkioWeight=Nothing
588 , blkioWeightDevice=Nothing
589 , blkioDeviceReadBps=Nothing
590 , blkioDeviceWriteBps=Nothing
591 , blkioDeviceReadIOps=Nothing
592 , blkioDeviceWriteIOps=Nothing
593 , cpuPeriod=Nothing
594 , cpusetCpus=Nothing
595 , cpusetMems=Nothing
596 , devices=[]
597 , kernelMemory=Nothing
598 , memory=Nothing
599 , memoryReservation=Nothing
600 , memorySwap=Nothing
601 , oomKillDisable=False
602 , ulimits=[]
603 }
606defaultCreateOpts :: T.Text -> CreateOpts
607defaultCreateOpts imageName = CreateOpts { containerConfig = defaultContainerConfig imageName, hostConfig = defaultHostConfig }
609-- detachKeys – Override the key sequence for detaching a container.
610-- Format is a single character [a-Z] or ctrl-<value> where <value> is one of: a-z, @, ^, [, , or _.
611data DetachKeys = WithCtrl Char | WithoutCtrl Char | DefaultDetachKey deriving (Eq, Show)
613data StartOpts = StartOpts { detachKeys :: DetachKeys } deriving (Eq, Show)
615defaultStartOpts :: StartOpts
616defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }
618data DeleteOpts = DeleteOpts {
619 deleteVolumes :: Bool
620 , force :: Bool
621 } deriving (Eq, Show)
623type Timestamp = Integer
624data TailLogOpt = Tail Integer | All deriving (Eq, Show)
626data LogOpts = LogOpts {
627 stdout :: Bool
628 , stderr :: Bool
629 , since :: Maybe Timestamp
630 , timestamps :: Bool
631 , tail :: TailLogOpt
632 } deriving (Eq, Show)
634defaultLogOpts :: LogOpts
635defaultLogOpts = LogOpts { stdout = True
636 , stderr = True
637 , since = Nothing
638 , timestamps = True
639 , tail = All
640 }
642data VolumePermission = Rw | Ro deriving (Eq, Show, Generic)
644-- instance ToJSON VolumePermission where
645-- toJSON = error "TODO"
646-- instance FromJSON VolumePermission where
647-- parseJSON = error "TODO"
649-- Note: Note really sure what this should be (1.24).
650-- This is not the same as [Volume] in HostConfig.
651newtype Volumes = Volumes [Text] -- [Volume]
652 deriving (Eq, Show)
654instance FromJSON Volumes where
655 parseJSON (JSON.Object o) = return $ Volumes $ HM.keys o
656 parseJSON _ = fail "Volumes is not an object"
658instance ToJSON Volumes where
659 toJSON (Volumes vs) = toJSON vs
661data Volume = Volume { hostSrc :: Text
662 , containerDest :: Text
663 , volumePermission :: Maybe VolumePermission
664 } deriving (Eq, Show)
666instance FromJSON Volume where
667 parseJSON (JSON.String t) = case T.split (== ':') t of
668 [src, dest] -> return $ Volume src dest Nothing
669 [src, dest, "rw"] -> return $ Volume src dest $ Just Rw
670 [src, dest, "ro"] -> return $ Volume src dest $ Just Ro
671 _ -> fail "Could not parse Volume"
672 parseJSON _ = fail "Volume is not a string"
674data Device = Device {
675 pathOnHost :: FilePath
676 , pathInContainer :: FilePath
677 , cgroupPermissions :: Text
678 } deriving (Eq, Show, Generic)
680instance ToJSON Device where
681 toJSON = genericToJSON defaultOptions {
682 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
684instance FromJSON Device where
685 parseJSON = genericParseJSON defaultOptions {
686 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
688type ContainerName = Text
690data VolumeFrom = VolumeFrom ContainerName (Maybe VolumePermission) deriving (Eq, Show)
692instance FromJSON VolumeFrom where
693 parseJSON (JSON.String t) = case T.split (== ':') t of
694 [vol] -> return $ VolumeFrom vol Nothing
695 [vol, "rw"] -> return $ VolumeFrom vol $ Just Rw
696 [vol, "ro"] -> return $ VolumeFrom vol $ Just Ro
697 _ -> fail "Could not parse VolumeFrom"
698 parseJSON _ = fail "VolumeFrom is not a string"
700instance ToJSON VolumeFrom where
701 toJSON (VolumeFrom n p) = case p of
702 Nothing -> toJSON $ n <> ":" <> "rw"
703 Just per -> toJSON $ n <> ":" <> (T.pack $ show per)
705instance ToJSON Volume where
706 toJSON (Volume src dest mode) = toJSON $ case mode of
707 Nothing -> T.concat[src, ":", dest]
708 Just m -> T.concat[src, ":", dest, ":", (T.pack $ show m)]
710data Link = Link Text (Maybe Text) deriving (Eq, Show)
712instance FromJSON Link where
713 parseJSON (JSON.String t) = case T.split (== ':') t of
714 [f] -> return $ Link f Nothing
715 [f,s] -> return $ Link f $ Just s
716 _ -> fail "Could not parse Link"
717 parseJSON _ = fail "Link is not a string"
719instance ToJSON Link where
720 toJSON (Link n1 n2) = toJSON $ case n2 of
721 Nothing -> T.concat[n1, ":", n1] -- use same name in container
722 Just n -> T.concat[n1, ":", n] -- used specified name in container
724-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }
725data LogDriverType = JsonFile | Syslog | Journald | Gelf | Fluentd | AwsLogs | Splunk | Etwlogs | LoggingDisabled deriving (Eq, Show)
727instance FromJSON LogDriverType where
728 parseJSON (JSON.String "json-file") = return JsonFile
729 parseJSON (JSON.String "syslog") = return Syslog
730 parseJSON (JSON.String "journald") = return Journald
731 parseJSON (JSON.String "gelf") = return Gelf
732 parseJSON (JSON.String "fluentd") = return Fluentd
733 parseJSON (JSON.String "awslogs") = return AwsLogs
734 parseJSON (JSON.String "splunk") = return Splunk
735 parseJSON (JSON.String "etwlogs") = return Etwlogs
736 parseJSON (JSON.String "none") = return LoggingDisabled
737 parseJSON _ = fail "Unknown LogDriverType"
739instance ToJSON LogDriverType where
740 toJSON JsonFile = JSON.String "json-file"
741 toJSON Syslog = JSON.String "syslog"
742 toJSON Journald = JSON.String "journald"
743 toJSON Gelf = JSON.String "gelf"
744 toJSON Fluentd = JSON.String "fluentd"
745 toJSON AwsLogs = JSON.String "awslogs"
746 toJSON Splunk = JSON.String "splunk"
747 toJSON Etwlogs = JSON.String "etwlogs"
748 toJSON LoggingDisabled = JSON.String "none"
750newtype LogDriverOptions = LogDriverOptions (M.Map Text Text) deriving (Eq, Show)
752instance FromJSON LogDriverOptions where
753 parseJSON (JSON.Object o) = do
754 LogDriverOptions <$> HM.foldlWithKey' f (return M.empty) o
756 where
757 f accM k (JSON.String v) = do
758 acc <- accM
759 return $ M.insert k v acc
760 f _ _ _ = fail "Value of LogDriverOptions is not a string"
762 parseJSON JSON.Null = return $ LogDriverOptions M.empty
763 parseJSON _ = fail "LogDriverOptions is not an object"
765instance ToJSON LogDriverOptions where
766 toJSON (LogDriverOptions mp) = toJSON mp
768data LogDriverConfig = LogDriverConfig LogDriverType (Maybe LogDriverOptions) deriving (Eq, Show)
770instance ToJSON LogDriverConfig where
771 toJSON (LogDriverConfig driverType driverOptions) = object ["Type" .= driverType, "Config" .= driverOptions]
773instance FromJSON LogDriverConfig where
774 parseJSON (JSON.Object o) = do
775 typ <- o .: "Type"
776 opts <- o .: "Config"
777 return $ LogDriverConfig typ opts
778 parseJSON _ = fail "LogDriverConfig is not an object"
780-- TODO: Add container:<name|id> mode
781data NetworkMode = Bridge | Host | NetworkDisabled
782 deriving (Eq, Show, Ord)
784instance FromJSON NetworkMode where
785 parseJSON (JSON.String "bridge") = return Bridge
786 parseJSON (JSON.String "host") = return Host -- Note: Guessing on these.
787 parseJSON (JSON.String "none") = return NetworkDisabled
788 parseJSON _ = fail "Unknown NetworkMode"
790instance ToJSON NetworkMode where
791 toJSON Bridge = JSON.String "bridge"
792 toJSON Host = JSON.String "host"
793 toJSON NetworkDisabled = JSON.String "none"
795data PortType = TCP | UDP deriving (Eq, Show, Generic, Read, Ord)
797instance ToJSON PortType where
798 toJSON TCP = "tcp"
799 toJSON UDP = "udp"
801instance FromJSON PortType where
802 parseJSON val = case val of
803 "tcp" -> return TCP
804 "udp" -> return UDP
805 _ -> fail "PortType: Invalid port type."
807newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
809instance FromJSON NetworkInterface where
810 parseJSON (JSON.String v) = return $ NetworkInterface v
811 parseJSON _ = fail "Network interface is not a string."
813instance ToJSON NetworkInterface where
814 toJSON (NetworkInterface i) = JSON.String i
816-- | This datastructure models mapping a Port from the container onto the
817-- host system s that the service running in the container can be accessed from
818-- the outside world. We either map a port onto all interfaces (default) or onto a specific
819-- interface like `127.0.0.1`.
820newtype PortBindings = PortBindings [PortBinding]
821 deriving (Eq, Show)
823-- { <port>/<protocol>: [{ "HostPort": "<port>" }] }
824data PortBinding = PortBinding {
825 containerPort :: Port
826 , portType :: PortType
827 , hostPorts :: HostPorts
828 } deriving (Eq, Show)
831portAndType2Text :: Port -> PortType -> Text
832portAndType2Text p t = (T.pack $ show p) <> "/" <> (T.pack $ show t)
834instance ToJSON PortBinding where
835 toJSON (PortBinding {..}) = object [portAndType2Text containerPort portType .= hostPorts]
837instance FromJSON PortBindings where
838 parseJSON (JSON.Object o) = do
839 PortBindings <$> HM.foldlWithKey' f (return []) o
841 where
842 f accM k v = case T.split (== '/') k of
843 [port', portType'] -> do
844 port <- parseIntegerText port'
845 portType <- parseJSON $ JSON.String portType'
846 acc <- accM
847 hps <- parseJSON v
848 return $ (PortBinding port portType hps):acc
849 _ ->
850 fail "Could not parse PortBindings"
851 parseJSON _ = fail "PortBindings is not an object"
853instance ToJSON PortBindings where
854 toJSON (PortBindings []) = JSON.Object HM.empty
855 toJSON (PortBindings (p:ps)) = toJSON (p:ps)
857data HostPort = HostPort NetworkInterface Port
858 deriving (Eq, Show)
860instance ToJSON HostPort where
861 toJSON (HostPort i p) = object ["HostPort" .= p, "HostIP" .= i]
863instance FromJSON HostPort where
864 parseJSON (JSON.Object o) = do
865 p <- o .: "HostPort"
866 i <- o .: "HostIP"
867 return $ HostPort i p
868 parseJSON _ = fail "HostPort is not an object."
870newtype HostPorts = HostPorts [HostPort]
871 deriving (Eq, Show)
874instance ToJSON HostPorts where
875 toJSON (HostPorts hps) = toJSON hps
877instance FromJSON HostPorts where
878 parseJSON (JSON.Object o) = do
879 HostPorts <$> HM.foldlWithKey' f (return []) o
881 where
882 f accM k v = do
883 acc <- accM
884 p' <- parseJSON v
885 p <- parseIntegerText p'
886 return $ (HostPort (NetworkInterface k) p):acc
887 parseJSON _ = fail "HostPorts is not an object"
889-- { "Name": "on-failure" , "MaximumRetryCount": 2}
890type RetryCount = Integer
891data RestartPolicy = RestartAlways | RestartUnlessStopped | RestartOnFailure RetryCount | RestartOff deriving (Eq, Show)
893instance FromJSON RestartPolicy where
894 parseJSON (JSON.Object o) = do
895 (name :: Text) <- o .: "Name"
896 case name of
897 "always" -> return RestartAlways
898 "unless-stopped" -> return RestartUnlessStopped
899 "on-failure" -> do
900 retry <- o .: "MaximumRetryCount"
901 return $ RestartOnFailure retry
902 "off" -> return RestartOff
903 _ -> fail "Could not parse RestartPolicy"
904 parseJSON _ = fail "RestartPolicy is not an object"
906instance ToJSON RestartPolicy where
907 toJSON RestartAlways = object ["Name" .= JSON.String "always"]
908 toJSON RestartUnlessStopped = object ["Name" .= JSON.String "unless-stopped"]
909 toJSON (RestartOnFailure c) = object ["Name" .= JSON.String "on-failure", "MaximumRetryCount" .= c]
910 toJSON RestartOff = object ["Name" .= JSON.String "off"]
912data Isolation = Default | Process | Hyperv deriving (Eq, Show)
914newtype UTSMode = UTSMode Text deriving (Eq, Show)
916-- TODO: Add Tmpfs : List of tmpfs (mounts) used for the container
917-- TODO: Add UTSMode : UTS namespace to use for the container
918-- TODO: Sysctls map[string]string `json:",omitempty"` // List of Namespaced sysctls used for the container
919data HostConfig = HostConfig
920 { binds :: [Volume]
921 , containerIDFile :: Maybe FilePath -- 1.24: Only in responses, not create
922 , logConfig :: LogDriverConfig
923 , networkMode :: NetworkMode
924 , portBindings :: PortBindings
925 , restartPolicy :: RestartPolicy
926 , volumeDriver :: Maybe Text
927 , volumesFrom :: [VolumeFrom]
928 , capAdd :: [Text]
929 , capDrop :: [Text]
930 , dns :: [Text]
931 , dnsOptions :: [Text]
932 , dnsSearch :: [Text]
933 , extraHosts :: [Text]
934 -- , groupAdd :: [Integer] -- 1.24: Missing from inspecting container details... Going to omit for now.
935 , ipcMode :: Maybe Text -- 1.24: Only in inspect, not create
936 , links :: Maybe [Link] -- Note: Expand JSON instances? Null is []?
937 , oomScoreAdj :: Maybe Integer
938 -- , pidMode :: Text -- 1.24: Don't see pidMode, just pidsLimit
939 , privileged :: Bool
940 , publishAllPorts :: Bool
941 , readonlyRootfs :: Bool
942 , securityOpt :: [Text]
943 -- , utsMode :: UTSMode -- 1.24: Don't see this
944 , shmSize :: Maybe Integer
945 -- , consoleSize :: Integer -- 1.24: Don't see this
946 -- , isolation :: Isolation -- 1.24: Don't see this
947 , resources :: ContainerResources
948 } deriving (Eq, Show, Generic)
950instance FromJSON HostConfig where
951 parseJSON v@(JSON.Object o) = HostConfig <$>
952 <*>
953 <*> parseJSON v
955instance ToJSON HostConfig where
956 toJSON HostConfig{..} =
957 let arr = [
958 "binds" .= binds
959 , "containerIDFile" .= containerIDFile
960 , "logConfig" .= logConfig
961 , "networkMode" .= networkMode
962 , "portBindings" .= portBindings
963 , "restartPolicy" .= restartPolicy
964 , "volumeDriver" .= volumeDriver
965 , "volumesFrom" .= volumesFrom
966 , "capAdd" .= capAdd
967 , "capDrop" .= capDrop
968 , "dns" .= dns
969 , "dnsOptions" .= dnsOptions
970 , "dnsSearch" .= dnsSearch
971 , "extraHosts" .= extraHosts
972 , "ipcMode" .= ipcMode
973 , "links" .= links
974 , "oomScoreAdj" .= oomScoreAdj
975 , "privileged" .= privileged
976 , "publishAllPorts" .= publishAllPorts
977 , "readonlyRootfs" .= readonlyRootfs
978 , "securityOpt" .= securityOpt
979 , "shmSize" .= shmSize
980 ]
981 in
982 object $ arr <> ( resourcesArr resources)
984 where
985 -- JP: Not sure if this is better than a separate ToJSON instance with a bunch of `HM.insert`s.
986 resourcesArr ContainerResources{..} = [
987 "CpuShares" .= cpuShares
988 , "BlkioWeight" .= blkioWeight
989 , "BlkioWeightDevice" .= blkioWeightDevice
990 , "BlkioDeviceReadBps" .= blkioDeviceReadBps
991 , "BlkioDeviceWriteBps" .= blkioDeviceWriteBps
992 , "BlkioDeviceReadIOps" .= blkioDeviceReadIOps
993 , "BlkioDeviceWriteIOps" .= blkioDeviceWriteIOps
994 , "CpuPeriod" .= cpuPeriod
995 , "CpusetCpus" .= cpusetCpus
996 , "CpusetMems" .= cpusetMems
997 , "Devices" .= devices
998 , "KernelMemory" .= kernelMemory
999 , "Memory" .= memory
1000 , "MemoryReservation" .= memoryReservation
1001 , "MemorySwap" .= memorySwap
1002 , "OomKillDisable" .= oomKillDisable
1003 , "Ulimits" .= ulimits
1009-- { "Name": <name>, "Soft": <soft limit>, "Hard": <hard limit> }
1010-- { "Name": "nofile", "Soft": 1024, "Hard": 2048 }
1011data Ulimit = Ulimit {
1012 ulimitName :: Text
1013 , ulimitSoft :: Integer
1014 , ulimitHard :: Integer
1015 } deriving (Eq, Show, Generic)
1017instance FromJSON Ulimit where
1018 parseJSON = genericParseJSON defaultOptions {
1019 fieldLabelModifier = drop 5}
1021instance ToJSON Ulimit where
1022 toJSON = genericToJSON defaultOptions {
1023 fieldLabelModifier = drop 5}
1025data ContainerResources = ContainerResources {
1026 cpuShares :: Maybe Integer
1027 -- , cgroupParent :: Text -- 1.24: Missing from inspecting container details... Going to omit for now.
1028 , blkioWeight :: Maybe Text
1029 , blkioWeightDevice :: Maybe Text
1030 , blkioDeviceReadBps :: Maybe Text
1031 , blkioDeviceWriteBps :: Maybe Text
1032 , blkioDeviceReadIOps :: Maybe Text
1033 , blkioDeviceWriteIOps :: Maybe Text
1034 , cpuPeriod :: Maybe Integer
1035 -- , cpuQuota :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1036 , cpusetCpus :: Maybe Integer
1037 , cpusetMems :: Maybe Text
1038 , devices :: [Device]
1039 -- , diskQuota :: Integer -- Don't see this ins 1.24.
1040 , kernelMemory :: Maybe Integer
1041 , memory :: Maybe Integer
1042 , memoryReservation :: Maybe Integer
1043 , memorySwap :: Maybe Integer
1044 -- , memorySwappiness :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1045 , oomKillDisable :: Bool
1046 -- , pidsLimit :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
1047 , ulimits :: [Ulimit]
1048 -- TODO: Missing from 1.24
1049 -- StorageOpt :: [(Text, Text)]
1050 -- VolumeDriver :: ??
1051 -- EndpointsConfig :: ??
1052 -- TODO: Only in inspect container in 1.24
1053 -- CpuPercent :: Int +
1054 -- MaximumIOps :: Int +
1055 -- MaximumIOBps :: Int +
1056 -- LxcConf :: [??] +
1057 } deriving (Eq, Show, Generic)
1059-- instance ToJSON ContainerResources where
1060-- toJSON = genericToJSON defaultOptions {
1061-- fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1063instance FromJSON ContainerResources where
1064 parseJSON = genericParseJSON defaultOptions {
1065 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1067type Port = Integer
1069type Name = Text
1070type Value = Text
1072data EnvVar = EnvVar Name Value
1073 deriving (Eq, Show)
1075instance FromJSON EnvVar where
1076 parseJSON (JSON.String env) =
1077 let (n, v') = T.break (== '=') env in
1078 let v = T.drop 1 v' in
1079 return $ EnvVar n v
1080 parseJSON _ = fail "EnvVar is not a string"
1082instance ToJSON EnvVar where
1083 toJSON (EnvVar n v) = object [n .= v]
1085-- | ExposedPorts represent a enumeraton of all the ports (and their type)
1086-- that a container should expose to other containers or the host system.
1087-- `NOTE`: This does not automatically expose the ports onto the host
1088-- system but rather it just tags them. It's best to be used with
1089-- the PublishAllPorts flag. It is also useful for
1090-- the daemon to know which Environment variables to
1091-- inject into a container linking to our container.
1092-- Example linking a Postgres container named db would inject the following
1093-- environment variables automatically if we set the corresponding
1094-- ExposedPorts:
1095-- DB_PORT_5432_TCP_PORT="5432"
1096-- DB_PORT_5432_TCP_PROTO="tcp"
1097-- DB_PORT_5432_TCP="tcp://172.17.0.1:5432"
1098newtype ExposedPorts = ExposedPorts (M.Map Port PortType) deriving (Eq, Show)
1099-- JP: Should this be ExposedPorts [(Port, PortType)]?
1101instance FromJSON ExposedPorts where
1102 parseJSON (JSON.Object o) = do
1103 ExposedPorts <$> HM.foldlWithKey' f (return M.empty) o
1105 where
1106 f accM k _ = case T.split (== '/') k of
1107 [port', portType'] -> do
1108 port <- parseIntegerText port'
1109 portType <- parseJSON $ JSON.String portType'
1110 acc <- accM
1111 return $ M.insert port portType acc
1112 _ ->
1113 fail "Could not parse ExposedPorts"
1114 parseJSON _ = fail "ExposedPorts is not an object."
1116instance ToJSON ExposedPorts where
1117 toJSON (ExposedPorts kvs) = object [((T.pack $ show p) <> "/" <> (T.pack $ show t)) .= JSON.Object HM.empty | (p,t) <- (M.toList kvs)]
1120data ContainerConfig = ContainerConfig {
1121 hostname :: Maybe Text
1122 , domainname :: Maybe Text
1123 , user :: Maybe Text
1124 , attachStdin :: Bool
1125 , attachStdout :: Bool
1126 , attachStderr :: Bool
1127 , exposedPorts :: ExposedPorts
1128 -- , publishService :: Text -- Don't see this in 1.24
1129 , tty :: Bool
1130 , openStdin :: Bool
1131 , stdinOnce :: Bool
1132 , env :: [EnvVar]
1133 , cmd :: [Text]
1134 -- , argsEscaped :: Bool -- Don't see this in 1.24
1135 , image :: Text
1136 , volumes :: Maybe Volumes
1137 , workingDir :: Maybe FilePath
1138 , entrypoint :: Maybe Text -- Can be null?
1139 , networkDisabled :: Maybe Bool -- Note: Should we expand the JSON instance and take away the Maybe? Null is False?
1140 , macAddress :: Maybe Text
1141 -- , onBuild :: Text -- For 1.24, only see this in the inspect response.
1142 , labels :: Maybe Labels
1143 , stopSignal :: Signal
1144 } deriving (Eq, Show, Generic)
1146instance ToJSON ContainerConfig where
1147 toJSON = genericToJSON defaultOptions {
1148 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1150instance FromJSON ContainerConfig where
1151 parseJSON = genericParseJSON defaultOptions {
1152 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1154parseIntegerText :: (Monad m) =>Text -> m Integer
1155parseIntegerText t = case readMaybe $ T.unpack t of
1156 Nothing ->
1157 fail "Could not parse Integer"
1158 Just i ->
1159 return i