@@ -0,0 +1,1109 @@
1+{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+
4+module 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
77+
78+import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
79+ genericToJSON, object, parseJSON, toJSON,
80+ (.!=), (.:), (.:?), (.=))
81+import qualified Data.Aeson as JSON
82+import Data.Aeson.Types (defaultOptions, fieldLabelModifier)
83+import Data.Char (isAlphaNum, toUpper)
84+import qualified Data.HashMap.Strict as HM
85+import qualified Data.Map as M
86+import Data.Monoid ((<>))
87+import Data.Text (Text)
88+import qualified Data.Text as T
89+import Data.Time.Clock (UTCTime)
90+import GHC.Generics (Generic)
91+import Prelude hiding (all, tail)
92+import Text.Read (readMaybe)
93+
94+data 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)
109+
110+type URL = Text
111+type ApiVersion = Text
112+newtype ContainerID = ContainerID Text
113+ deriving (Eq, Show)
114+
115+fromContainerID :: ContainerID -> Text
116+fromContainerID (ContainerID t) = t
117+
118+toContainerID :: Text -> Maybe ContainerID
119+toContainerID 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
124+
125+newtype ImageID = ImageID Text
126+ deriving (Eq, Show)
127+
128+fromImageID :: ImageID -> Text
129+fromImageID (ImageID t) = t
130+
131+toImageID :: Text -> Maybe ImageID
132+toImageID 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
137+
138+data Timeout = Timeout Integer | DefaultTimeout deriving (Eq, Show)
139+
140+-- TODO: Add more Signals or use an existing lib
141+data Signal = SIGHUP
142+ | SIGINT
143+ | SIGQUIT
144+ | SIGSTOP
145+ | SIGTERM
146+ | SIGUSR1
147+ | SIG Integer
148+ | SIGKILL deriving (Eq, Show)
149+
150+instance 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"
158+
159+instance 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"
168+
169+data 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)
193+
194+data 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)
204+
205+instance 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"
216+
217+data 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)
231+
232+instance 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"
247+
248+data DockerClientOpts = DockerClientOpts {
249+ apiVer :: ApiVersion
250+ , baseUrl :: URL
251+ }
252+ deriving (Eq, Show)
253+
254+defaultClientOpts :: DockerClientOpts
255+defaultClientOpts = DockerClientOpts {
256+ apiVer = "v1.23"
257+ , baseUrl = "http://127.0.0.1:2375"
258+ }
259+
260+data ListOpts = ListOpts { all :: Bool } deriving (Eq, Show)
261+
262+defaultListOpts :: ListOpts
263+defaultListOpts = ListOpts { all=False }
264+
265+data 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)
275+
276+
277+instance ToJSON DockerVersion where
278+ toJSON = genericToJSON defaultOptions {
279+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
280+
281+instance FromJSON DockerVersion where
282+ parseJSON = genericParseJSON defaultOptions {
283+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
284+
285+-- instance ToJSON ContainerDetails where
286+-- toJSON = error "TODO"
287+
288+instance 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"
312+
313+instance ToJSON ContainerID where
314+ toJSON (ContainerID cid) = object ["Id" .= cid]
315+
316+instance 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."
325+
326+instance ToJSON ImageID where
327+ toJSON (ImageID iid) = JSON.String iid
328+
329+instance 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."
336+
337+data ContainerPortInfo = ContainerPortInfo {
338+ ipAddressInfo :: Maybe Text
339+ , privatePortInfo :: Port
340+ , publicPortInfo :: Maybe Port
341+ , portTypeInfo :: Maybe PortType
342+ } deriving (Eq, Show)
343+
344+instance 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."
351+
352+-- For inspecting container details.
353+data 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)
367+
368+instance 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"
381+
382+newtype Networks = Networks (M.Map NetworkMode NetworkOptions) -- Note: Is it ever possible that there will be duplicates of network modes?
383+ deriving (Eq, Show)
384+
385+instance FromJSON Networks where
386+ parseJSON (JSON.Object o) = do
387+ Networks <$> HM.foldlWithKey' f (return M.empty) o
388+
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
395+
396+ parseJSON _ = fail "Networks is not an object"
397+
398+data 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)
419+
420+instance 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"
442+
443+data 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)
456+
457+instance 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."
474+
475+ parseJSON _ = fail "Container: Not a JSON object."
476+
477+data Status = Created | Restarting | Running | Paused | Exited | Dead
478+ deriving (Eq, Show, Generic)
479+
480+instance 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"
488+
489+type Digest = Text
490+
491+newtype Labels = Labels (M.Map Name Value) deriving (Eq, Show)
492+
493+instance FromJSON Labels where
494+ parseJSON val = Labels <$> parseJSON val
495+
496+instance ToJSON Labels where
497+ toJSON (Labels kvs) = object [k .= v | (k,v) <- (M.toList kvs)]
498+
499+type Tag = Text
500+
501+data 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)
511+
512+dropImagePrefix :: [a] -> [a]
513+dropImagePrefix = drop 5
514+
515+instance FromJSON Image where
516+ parseJSON = genericParseJSON defaultOptions {
517+ fieldLabelModifier = dropImagePrefix}
518+
519+data CreateOpts = CreateOpts {
520+ containerConfig :: ContainerConfig
521+ , hostConfig :: HostConfig
522+ } deriving (Eq, Show)
523+
524+instance 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.
532+
533+defaultContainerConfig :: Text -> ContainerConfig
534+defaultContainerConfig 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=False
552+ , macAddress=Nothing
553+ , labels=Nothing
554+ , stopSignal=SIGTERM
555+ }
556+
557+defaultHostConfig :: HostConfig
558+defaultHostConfig = 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=[]
575+ , oomScoreAdj=Nothing
576+ , privileged=False
577+ , publishAllPorts=False
578+ , readOnlyRootfs=False
579+ , securityOpt=[]
580+ , shmSize=Nothing
581+ , resources=defaultContainerResources
582+ }
583+
584+defaultContainerResources :: ContainerResources
585+defaultContainerResources = 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+ }
604+
605+
606+defaultCreateOpts :: T.Text -> CreateOpts
607+defaultCreateOpts imageName = CreateOpts { containerConfig = defaultContainerConfig imageName, hostConfig = defaultHostConfig }
608+
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 _.
611+data DetachKeys = WithCtrl Char | WithoutCtrl Char | DefaultDetachKey deriving (Eq, Show)
612+
613+data StartOpts = StartOpts { detachKeys :: DetachKeys } deriving (Eq, Show)
614+
615+defaultStartOpts :: StartOpts
616+defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }
617+
618+data DeleteOpts = DeleteOpts {
619+ deleteVolumes :: Bool
620+ , force :: Bool
621+ } deriving (Eq, Show)
622+
623+type Timestamp = Integer
624+data TailLogOpt = Tail Integer | All deriving (Eq, Show)
625+
626+data LogOpts = LogOpts {
627+ stdout :: Bool
628+ , stderr :: Bool
629+ , since :: Maybe Timestamp
630+ , timestamps :: Bool
631+ , tail :: TailLogOpt
632+ } deriving (Eq, Show)
633+
634+defaultLogOpts :: LogOpts
635+defaultLogOpts = LogOpts { stdout = True
636+ , stderr = True
637+ , since = Nothing
638+ , timestamps = True
639+ , tail = All
640+ }
641+
642+data VolumePermission = Rw | Ro deriving (Eq, Show, Generic)
643+
644+-- instance ToJSON VolumePermission where
645+-- toJSON = error "TODO"
646+-- instance FromJSON VolumePermission where
647+-- parseJSON = error "TODO"
648+
649+-- Note: Note really sure what this should be (1.24).
650+-- This is not the same as [Volume] in HostConfig.
651+newtype Volumes = Volumes [Text] -- [Volume]
652+ deriving (Eq, Show)
653+
654+instance FromJSON Volumes where
655+ parseJSON (JSON.Object o) = return $ Volumes $ HM.keys o
656+ parseJSON _ = fail "Volumes is not an object"
657+
658+instance ToJSON Volumes where
659+ toJSON (Volumes vs) = toJSON vs
660+
661+data Volume = Volume { hostSrc :: Text
662+ , containerDest :: Text
663+ , volumePermission :: Maybe VolumePermission
664+ } deriving (Eq, Show)
665+
666+instance 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"
673+
674+data Device = Device {
675+ pathOnHost :: FilePath
676+ , pathInContainer :: FilePath
677+ , cgroupPermissions :: Text
678+ } deriving (Eq, Show, Generic)
679+
680+instance ToJSON Device where
681+ toJSON = genericToJSON defaultOptions {
682+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
683+
684+instance FromJSON Device where
685+ parseJSON = genericParseJSON defaultOptions {
686+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
687+
688+type ContainerName = Text
689+
690+data VolumeFrom = VolumeFrom ContainerName (Maybe VolumePermission) deriving (Eq, Show)
691+
692+instance 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"
699+
700+instance 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)
704+
705+instance 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)]
709+
710+data Link = Link Text (Maybe Text) deriving (Eq, Show)
711+
712+instance 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"
718+
719+instance 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
723+
724+-- { "Type": "<driver_name>", "Config": {"key1": "val1"} }
725+data LogDriverType = JsonFile | Syslog | Journald | Gelf | Fluentd | AwsLogs | Splunk | Etwlogs | LoggingDisabled deriving (Eq, Show)
726+
727+instance 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"
738+
739+instance 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"
749+
750+newtype LogDriverOptions = LogDriverOptions (M.Map Text Text) deriving (Eq, Show)
751+
752+instance FromJSON LogDriverOptions where
753+ parseJSON (JSON.Object o) = do
754+ LogDriverOptions <$> HM.foldlWithKey' f (return M.empty) o
755+
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"
761+
762+ parseJSON JSON.Null = return $ LogDriverOptions M.empty
763+ parseJSON _ = fail "LogDriverOptions is not an object"
764+
765+instance ToJSON LogDriverOptions where
766+ toJSON (LogDriverOptions mp) = toJSON mp
767+
768+data LogDriverConfig = LogDriverConfig LogDriverType (Maybe LogDriverOptions) deriving (Eq, Show)
769+
770+instance ToJSON LogDriverConfig where
771+ toJSON (LogDriverConfig driverType driverOptions) = object ["Type" .= driverType, "Config" .= driverOptions]
772+
773+instance 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"
779+
780+-- TODO: Add container:<name|id> mode
781+data NetworkMode = Bridge | Host | NetworkDisabled
782+ deriving (Eq, Show, Ord)
783+
784+instance 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"
789+
790+instance ToJSON NetworkMode where
791+ toJSON Bridge = JSON.String "bridge"
792+ toJSON Host = JSON.String "host"
793+ toJSON NetworkDisabled = JSON.String "none"
794+
795+data PortType = TCP | UDP deriving (Eq, Show, Generic, Read, Ord)
796+
797+instance ToJSON PortType where
798+ toJSON TCP = "tcp"
799+ toJSON UDP = "udp"
800+
801+instance FromJSON PortType where
802+ parseJSON val = case val of
803+ "tcp" -> return TCP
804+ "udp" -> return UDP
805+ _ -> fail "PortType: Invalid port type."
806+
807+newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
808+
809+instance FromJSON NetworkInterface where
810+ parseJSON (JSON.String v) = return $ NetworkInterface v
811+ parseJSON _ = fail "Network interface is not a string."
812+
813+instance ToJSON NetworkInterface where
814+ toJSON (NetworkInterface i) = JSON.String i
815+
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`.
820+newtype PortBindings = PortBindings [PortBinding]
821+ deriving (Eq, Show)
822+
823+-- { <port>/<protocol>: [{ "HostPort": "<port>" }] }
824+data PortBinding = PortBinding {
825+ containerPort :: Port
826+ , portType :: PortType
827+ , hostPorts :: HostPorts
828+ } deriving (Eq, Show)
829+
830+
831+portAndType2Text :: Port -> PortType -> Text
832+portAndType2Text p t = (T.pack $ show p) <> "/" <> (T.pack $ show t)
833+
834+instance ToJSON PortBinding where
835+ toJSON (PortBinding {..}) = object [portAndType2Text containerPort portType .= hostPorts]
836+
837+instance FromJSON PortBindings where
838+ parseJSON (JSON.Object o) = do
839+ PortBindings <$> HM.foldlWithKey' f (return []) o
840+
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"
852+
853+instance ToJSON PortBindings where
854+ toJSON (PortBindings []) = JSON.Object HM.empty
855+ toJSON (PortBindings (p:ps)) = toJSON (p:ps)
856+
857+data HostPort = HostPort NetworkInterface Port
858+ deriving (Eq, Show)
859+
860+instance ToJSON HostPort where
861+ toJSON (HostPort i p) = object ["HostPort" .= p, "HostIP" .= i]
862+
863+instance 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."
869+
870+newtype HostPorts = HostPorts [HostPort]
871+ deriving (Eq, Show)
872+
873+
874+instance ToJSON HostPorts where
875+ toJSON (HostPorts hps) = toJSON hps
876+
877+instance FromJSON HostPorts where
878+ parseJSON (JSON.Object o) = do
879+ HostPorts <$> HM.foldlWithKey' f (return []) o
880+
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"
888+
889+-- { "Name": "on-failure" , "MaximumRetryCount": 2}
890+type RetryCount = Integer
891+data RestartPolicy = RestartAlways | RestartUnlessStopped | RestartOnFailure RetryCount | RestartOff deriving (Eq, Show)
892+
893+instance 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+ "" -> return RestartOff -- Note: Is this correct? 1.24 spec is unclear.
903+ _ -> fail "Could not parse RestartPolicy"
904+ parseJSON _ = fail "RestartPolicy is not an object"
905+
906+instance 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"]
911+
912+data Isolation = Default | Process | Hyperv deriving (Eq, Show)
913+
914+newtype UTSMode = UTSMode Text deriving (Eq, Show)
915+
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
919+data 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 :: [Link]
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)
949+
950+instance FromJSON HostConfig where
951+ parseJSON = genericParseJSON defaultOptions {
952+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
953+
954+instance ToJSON HostConfig where
955+ toJSON = genericToJSON defaultOptions {
956+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
957+
958+
959+-- { "Name": <name>, "Soft": <soft limit>, "Hard": <hard limit> }
960+-- { "Name": "nofile", "Soft": 1024, "Hard": 2048 }
961+data Ulimit = Ulimit {
962+ ulimitName :: Text
963+ , ulimitSoft :: Integer
964+ , ulimitHard :: Integer
965+ } deriving (Eq, Show, Generic)
966+
967+instance FromJSON Ulimit where
968+ parseJSON = genericParseJSON defaultOptions {
969+ fieldLabelModifier = drop 5}
970+
971+instance ToJSON Ulimit where
972+ toJSON = genericToJSON defaultOptions {
973+ fieldLabelModifier = drop 5}
974+
975+data ContainerResources = ContainerResources {
976+ cpuShares :: Maybe Integer
977+ -- , cgroupParent :: Text -- 1.24: Missing from inspecting container details... Going to omit for now.
978+ , blkioWeight :: Maybe Text
979+ , blkioWeightDevice :: Maybe Text
980+ , blkioDeviceReadBps :: Maybe Text
981+ , blkioDeviceWriteBps :: Maybe Text
982+ , blkioDeviceReadIOps :: Maybe Text
983+ , blkioDeviceWriteIOps :: Maybe Text
984+ , cpuPeriod :: Maybe Integer
985+ -- , cpuQuota :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
986+ , cpusetCpus :: Maybe Integer
987+ , cpusetMems :: Maybe Text
988+ , devices :: [Device]
989+ -- , diskQuota :: Integer -- Don't see this ins 1.24.
990+ , kernelMemory :: Maybe Integer
991+ , memory :: Maybe Integer
992+ , memoryReservation :: Maybe Integer
993+ , memorySwap :: Maybe Integer
994+ -- , memorySwappiness :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
995+ , oomKillDisable :: Bool
996+ -- , pidsLimit :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
997+ , ulimits :: [Ulimit]
998+ -- TODO: Missing from 1.24
999+ -- StorageOpt :: [(Text, Text)]
1000+ -- VolumeDriver :: ??
1001+ -- EndpointsConfig :: ??
1002+ -- TODO: Only in inspect container in 1.24
1003+ -- CpuPercent :: Int +
1004+ -- MaximumIOps :: Int +
1005+ -- MaximumIOBps :: Int +
1006+ -- LxcConf :: [??] +
1007+ } deriving (Eq, Show, Generic)
1008+
1009+instance ToJSON ContainerResources where
1010+ toJSON = genericToJSON defaultOptions {
1011+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1012+
1013+instance FromJSON ContainerResources where
1014+ parseJSON = genericParseJSON defaultOptions {
1015+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1016+
1017+type Port = Integer
1018+
1019+type Name = Text
1020+type Value = Text
1021+
1022+data EnvVar = EnvVar Name Value
1023+ deriving (Eq, Show)
1024+
1025+instance FromJSON EnvVar where
1026+ parseJSON (JSON.String env) =
1027+ let (n, v') = T.break (== '=') env in
1028+ let v = T.drop 1 v' in
1029+ return $ EnvVar n v
1030+ parseJSON _ = fail "EnvVar is not a string"
1031+
1032+instance ToJSON EnvVar where
1033+ toJSON (EnvVar n v) = object [n .= v]
1034+
1035+-- | ExposedPorts represent a enumeraton of all the ports (and their type)
1036+-- that a container should expose to other containers or the host system.
1037+-- `NOTE`: This does not automatically expose the ports onto the host
1038+-- system but rather it just tags them. It's best to be used with
1039+-- the PublishAllPorts flag. It is also useful for
1040+-- the daemon to know which Environment variables to
1041+-- inject into a container linking to our container.
1042+-- Example linking a Postgres container named db would inject the following
1043+-- environment variables automatically if we set the corresponding
1044+-- ExposedPorts:
1045+-- DB_PORT_5432_TCP_PORT="5432"
1046+-- DB_PORT_5432_TCP_PROTO="tcp"
1047+-- DB_PORT_5432_TCP="tcp://172.17.0.1:5432"
1048+newtype ExposedPorts = ExposedPorts (M.Map Port PortType) deriving (Eq, Show)
1049+-- JP: Should this be ExposedPorts [(Port, PortType)]?
1050+
1051+instance FromJSON ExposedPorts where
1052+ parseJSON (JSON.Object o) = do
1053+ ExposedPorts <$> HM.foldlWithKey' f (return M.empty) o
1054+
1055+ where
1056+ f accM k _ = case T.split (== '/') k of
1057+ [port', portType'] -> do
1058+ port <- parseIntegerText port'
1059+ portType <- parseJSON $ JSON.String portType'
1060+ acc <- accM
1061+ return $ M.insert port portType acc
1062+ _ ->
1063+ fail "Could not parse ExposedPorts"
1064+ parseJSON _ = fail "ExposedPorts is not an object."
1065+
1066+instance ToJSON ExposedPorts where
1067+ toJSON (ExposedPorts kvs) = object [((T.pack $ show p) <> "/" <> (T.pack $ show t)) .= JSON.Object HM.empty | (p,t) <- (M.toList kvs)]
1068+
1069+
1070+data ContainerConfig = ContainerConfig {
1071+ hostname :: Maybe Text
1072+ , domainname :: Maybe Text
1073+ , user :: Maybe Text
1074+ , attachStdin :: Bool
1075+ , attachStdout :: Bool
1076+ , attachStderr :: Bool
1077+ , exposedPorts :: ExposedPorts
1078+ -- , publishService :: Text -- Don't see this in 1.24
1079+ , tty :: Bool
1080+ , openStdin :: Bool
1081+ , stdinOnce :: Bool
1082+ , env :: [EnvVar]
1083+ , cmd :: [Text]
1084+ -- , argsEscaped :: Bool -- Don't see this in 1.24
1085+ , image :: Text
1086+ , volumes :: Maybe Volumes
1087+ , workingDir :: Maybe FilePath
1088+ , entrypoint :: Maybe Text -- Can be null?
1089+ , networkDisabled :: Bool
1090+ , macAddress :: Maybe Text
1091+ -- , onBuild :: Text -- For 1.24, only see this in the inspect response.
1092+ , labels :: Maybe Labels
1093+ , stopSignal :: Signal
1094+ } deriving (Eq, Show, Generic)
1095+
1096+instance ToJSON ContainerConfig where
1097+ toJSON = genericToJSON defaultOptions {
1098+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1099+
1100+instance FromJSON ContainerConfig where
1101+ parseJSON = genericParseJSON defaultOptions {
1102+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1103+
1104+parseIntegerText :: (Monad m) =>Text -> m Integer
1105+parseIntegerText t = case readMaybe $ T.unpack t of
1106+ Nothing ->
1107+ fail "Could not parse Integer"
1108+ Just i ->
1109+ return i