@@ -1,7 +1,7 @@
11{-# LANGUAGE RecordWildCards #-}
22{-# LANGUAGE ScopedTypeVariables #-}
33
4−module Docker.Types (
4+module Docker.Client.Types (
55 Endpoint(..)
66 , URL
77 , ApiVersion
@@ -34,6 +34,7 @@ module Docker.Types (
3434 , StartOpts(..)
3535 , defaultStartOpts
3636 , DeleteOpts(..)
37+ , defaultDeleteOpts
3738 , Timestamp
3839 , TailLogOpt(..)
3940 , LogOpts(..)
@@ -49,7 +50,7 @@ module Docker.Types (
4950 , LogDriverConfig(..)
5051 , NetworkMode(..)
5152 , PortType(..)
52− , NetworkInterface(..)
53+-- , NetworkInterface(..)
5354 , Networks(..)
5455 , NetworkSettings(..)
5556 , NetworkOptions(..)
@@ -73,6 +74,8 @@ module Docker.Types (
7374 , ContainerConfig(..)
7475 , defaultContainerConfig
7576 , ExposedPorts(..)
77+ , DeviceWeight(..)
78+ , DeviceRate(..)
7679 ) where
7780
7881import Data.Aeson (FromJSON, ToJSON, genericParseJSON,
@@ -102,7 +105,8 @@ data Endpoint =
102105 | RestartContainerEndpoint Timeout ContainerID
103106 | PauseContainerEndpoint ContainerID
104107 | UnpauseContainerEndpoint ContainerID
105− | ContainerLogsEndpoint LogOpts Bool ContainerID -- Second argument (Bool) is whether to follow.
108+ | ContainerLogsEndpoint LogOpts Bool ContainerID -- ^ Second argument (Bool) is whether to follow which is currently hardcoded to False.
109+ -- See note in 'Docker.Client.Api.getContainerLogs' for explanation why.
106110 | DeleteContainerEndpoint DeleteOpts ContainerID
107111 | InspectContainerEndpoint ContainerID
108112 deriving (Eq, Show)
@@ -253,7 +257,7 @@ data DockerClientOpts = DockerClientOpts {
253257
254258defaultClientOpts :: DockerClientOpts
255259defaultClientOpts = DockerClientOpts {
256− apiVer = "v1.23"
260+ apiVer = "v1.24"
257261 , baseUrl = "http://127.0.0.1:2375"
258262 }
259263
@@ -282,11 +286,8 @@ instance FromJSON DockerVersion where
282286 parseJSON = genericParseJSON defaultOptions {
283287 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
284288
285−-- instance ToJSON ContainerDetails where
286−-- toJSON = error "TODO"
287−
288289instance FromJSON ContainerDetails where
289− parseJSON (JSON.Object o) = do
290+ parseJSON v@(JSON.Object o) = do
290291 appArmor <- o .: "AppArmorProfile"
291292 args <- o .: "Args"
292293 config <- o .: "Config"
@@ -296,7 +297,7 @@ instance FromJSON ContainerDetails where
296297 hostnamePath <- o .: "HostnamePath"
297298 hostsPath <- o .: "HostsPath"
298299 logPath <- o .: "LogPath"
299− id <- o .: "Id"
300+ id <- parseJSON v
300301 image <- o .: "Image"
301302 mountLabel <- o .: "MountLabel"
302303 name <- o .: "Name"
@@ -396,24 +397,24 @@ instance FromJSON Networks where
396397 parseJSON _ = fail "Networks is not an object"
397398
398399data NetworkSettings = NetworkSettings {
399− networkSettingsBridge :: Text
400− , networkSettingsSandboxId :: Text
401− , networkSettingsHairpinMode :: Bool
402− , networkSettingsLinkLocalIPv6Address :: Text
400+ networkSettingsBridge :: Text
401+ , networkSettingsSandboxId :: Text
402+ , networkSettingsHairpinMode :: Bool
403+ , networkSettingsLinkLocalIPv6Address :: Text
403404 , networkSettingsLinkLocalIPv6PrefixLen :: Int
404− , networkSettingsPorts :: [Port] -- TODO: 1.24 spec is unclear
405− , networkSettingsSandboxKey :: Text
406− , networkSettingsSecondaryIPAddresses :: Maybe [Text] -- TODO: 1.24 spec is unclear
405+ , networkSettingsPorts :: PortBindings
406+ , networkSettingsSandboxKey :: Text
407+ , networkSettingsSecondaryIPAddresses :: Maybe [Text] -- TODO: 1.24 spec is unclear
407408 , 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
409+ , networkSettingsEndpointID :: Text
410+ , networkSettingsGateway :: Text
411+ , networkSettingsGlobalIPv6Address :: Text
412+ , networkSettingsGlobalIPv6PrefixLen :: Int
413+ , networkSettingsIpAddress :: Text
414+ , networkSettingsIpPrefixLen :: Int
415+ , networkSettingsIpv6Gateway :: Text
416+ , networkSettingsMacAddress :: Text
417+ , networkSettingsNetworks :: Networks
417418 }
418419 deriving (Eq, Show)
419420
@@ -424,7 +425,7 @@ instance FromJSON NetworkSettings where
424425 hairpin <- o .: "HairpinMode"
425426 localIP6 <- o .: "LinkLocalIPv6Address"
426427 localIP6Len <- o .: "LinkLocalIPv6PrefixLen"
427− ports <- o .:? "Ports" .!= []
428+ ports <- o .: "Ports" -- .!= []
428429 sandboxKey <- o .: "SandboxKey"
429430 secondaryIP <- o .: "SecondaryIPAddresses"
430431 secondayIP6 <- o .: "SecondaryIPv6Addresses"
@@ -438,7 +439,7 @@ instance FromJSON NetworkSettings where
438439 mac <- o .: "MacAddress"
439440 networks <- o .: "Networks"
440441 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+ parseJSON _ = fail "NetworkSettings is not an object."
442443
443444data Container = Container
444445 { containerId :: ContainerID
@@ -539,7 +540,7 @@ defaultContainerConfig imageName = ContainerConfig {
539540 , attachStdout=False
540541 , image=imageName
541542 , attachStderr=False
542− , exposedPorts=ExposedPorts M.empty
543+ , exposedPorts=Nothing -- ExposedPorts M.empty
543544 , tty=False
544545 , openStdin=False
545546 , stdinOnce=False
@@ -548,7 +549,7 @@ defaultContainerConfig imageName = ContainerConfig {
548549 , volumes=Nothing
549550 , workingDir=Nothing
550551 , entrypoint=Nothing
551− , networkDisabled=False
552+ , networkDisabled=Nothing
552553 , macAddress=Nothing
553554 , labels=Nothing
554555 , stopSignal=SIGTERM
@@ -575,7 +576,7 @@ defaultHostConfig = HostConfig {
575576 , oomScoreAdj=Nothing
576577 , privileged=False
577578 , publishAllPorts=False
578− , readOnlyRootfs=False
579+ , readonlyRootfs=False
579580 , securityOpt=[]
580581 , shmSize=Nothing
581582 , resources=defaultContainerResources
@@ -616,10 +617,13 @@ defaultStartOpts :: StartOpts
616617defaultStartOpts = StartOpts { detachKeys = DefaultDetachKey }
617618
618619data DeleteOpts = DeleteOpts {
619− deleteVolumes :: Bool
620− , force :: Bool
620+ deleteVolumes :: Bool -- ^ Automatically cleanup volumes that the container created as well.
621+ , force :: Bool -- ^ If the container is still running force deletion anyway.
621622 } deriving (Eq, Show)
622623
624+defaultDeleteOpts :: DeleteOpts
625+defaultDeleteOpts = DeleteOpts { deleteVolumes = False, force = False }
626+
623627type Timestamp = Integer
624628data TailLogOpt = Tail Integer | All deriving (Eq, Show)
625629
@@ -804,14 +808,14 @@ instance FromJSON PortType where
804808 "udp" -> return UDP
805809 _ -> fail "PortType: Invalid port type."
806810
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
811+-- newtype NetworkInterface = NetworkInterface Text deriving (Eq, Show)
812+--
813+-- instance FromJSON NetworkInterface where
814+-- parseJSON (JSON.String v) = return $ NetworkInterface v
815+-- parseJSON _ = fail "Network interface is not a string."
816+--
817+-- instance ToJSON NetworkInterface where
818+-- toJSON (NetworkInterface i) = JSON.String i
815819
816820-- | This datastructure models mapping a Port from the container onto the
817821-- host system s that the service running in the container can be accessed from
@@ -824,7 +828,7 @@ newtype PortBindings = PortBindings [PortBinding]
824828data PortBinding = PortBinding {
825829 containerPort :: Port
826830 , portType :: PortType
827− , hostPorts :: HostPorts
831+ , hostPorts :: [HostPort]
828832 } deriving (Eq, Show)
829833
830834
@@ -854,37 +858,39 @@ instance ToJSON PortBindings where
854858 toJSON (PortBindings []) = JSON.Object HM.empty
855859 toJSON (PortBindings (p:ps)) = toJSON (p:ps)
856860
857−data HostPort = HostPort NetworkInterface Port
861+data HostPort = HostPort {
862+ hostIp :: Text
863+ , hostPost :: Port
864+ }
858865 deriving (Eq, Show)
859866
860867instance ToJSON HostPort where
861− toJSON (HostPort i p) = object ["HostPort" .= p, "HostIP" .= i]
868+ toJSON (HostPort i p) = object ["HostPort" .= show p, "HostIp" .= i]
862869
863870instance FromJSON HostPort where
864871 parseJSON (JSON.Object o) = do
865− p <- o .: "HostPort"
866− i <- o .: "HostIP"
872+ p <- o .: "HostPort" >>= parseIntegerText
873+ i <- o .: "HostIp"
867874 return $ HostPort i p
868875 parseJSON _ = fail "HostPort is not an object."
869876
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"
877+-- newtype HostPorts = HostPorts [HostPort]
878+-- deriving (Eq, Show)
879+--
880+-- instance ToJSON HostPorts where
881+-- toJSON (HostPorts hps) = toJSON hps
882+--
883+-- instance FromJSON HostPorts where
884+-- parseJSON (JSON.Object o) = do
885+-- HostPorts <$> HM.foldlWithKey' f (return []) o
886+--
887+-- where
888+-- f accM k v = do
889+-- acc <- accM
890+-- p' <- parseJSON v
891+-- p <- parseIntegerText p'
892+-- return $ (HostPort (NetworkInterface k) p):acc
893+-- parseJSON _ = fail $ "HostPorts is not an object"
888894
889895-- { "Name": "on-failure" , "MaximumRetryCount": 2}
890896type RetryCount = Integer
@@ -899,7 +905,7 @@ instance FromJSON RestartPolicy where
899905 "on-failure" -> do
900906 retry <- o .: "MaximumRetryCount"
901907 return $ RestartOnFailure retry
902− "" -> return RestartOff -- Note: Is this correct? 1.24 spec is unclear.
908+ "off" -> return RestartOff
903909 _ -> fail "Could not parse RestartPolicy"
904910 parseJSON _ = fail "RestartPolicy is not an object"
905911
@@ -938,7 +944,7 @@ data HostConfig = HostConfig
938944 -- , pidMode :: Text -- 1.24: Don't see pidMode, just pidsLimit
939945 , privileged :: Bool
940946 , publishAllPorts :: Bool
941− , readOnlyRootfs :: Bool
947+ , readonlyRootfs :: Bool
942948 , securityOpt :: [Text]
943949 -- , utsMode :: UTSMode -- 1.24: Don't see this
944950 , shmSize :: Maybe Integer
@@ -948,12 +954,84 @@ data HostConfig = HostConfig
948954 } deriving (Eq, Show, Generic)
949955
950956instance FromJSON HostConfig where
951− parseJSON = genericParseJSON defaultOptions {
952− fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
957+ parseJSON v@(JSON.Object o) = HostConfig
958+ <$> o .: "Binds"
959+ <*> o .: "ContainerIDFile"
960+ <*> o .: "LogConfig"
961+ <*> o .: "NetworkMode"
962+ <*> o .: "PortBindings"
963+ <*> o .: "RestartPolicy"
964+ <*> o .: "VolumeDriver"
965+ <*> o .: "VolumesFrom"
966+ <*> o .: "CapAdd"
967+ <*> o .: "CapDrop"
968+ <*> o .: "Dns"
969+ <*> o .: "DnsOptions"
970+ <*> o .: "DnsSearch"
971+ <*> o .: "ExtraHosts"
972+ <*> o .: "IpcMode"
973+ <*> o .:? "Links" .!= []
974+ <*> o .: "OomScoreAdj"
975+ <*> o .: "Privileged"
976+ <*> o .: "PublishAllPorts"
977+ <*> o .: "ReadonlyRootfs"
978+ <*> o .: "SecurityOpt"
979+ <*> o .: "ShmSize"
980+ <*> parseJSON v
981+ parseJSON _ = fail "HostConfig is not an object."
953982
954983instance ToJSON HostConfig where
955− toJSON = genericToJSON defaultOptions {
956− fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
984+ toJSON HostConfig{..} =
985+ let arr = [
986+ "Binds" .= binds
987+ , "ContainerIDFile" .= containerIDFile
988+ , "LogConfig" .= logConfig
989+ , "NetworkMode" .= networkMode
990+ , "PortBindings" .= portBindings
991+ , "RestartPolicy" .= restartPolicy
992+ , "VolumeDriver" .= volumeDriver
993+ , "VolumesFrom" .= volumesFrom
994+ , "CapAdd" .= capAdd
995+ , "CapDrop" .= capDrop
996+ , "Dns" .= dns
997+ , "DnsOptions" .= dnsOptions
998+ , "DnsSearch" .= dnsSearch
999+ , "ExtraHosts" .= extraHosts
1000+ , "IpcMode" .= ipcMode
1001+ , "Links" .= links
1002+ , "OomScoreAdj" .= oomScoreAdj
1003+ , "Privileged" .= privileged
1004+ , "PublishAllPorts" .= publishAllPorts
1005+ , "ReadonlyRootfs" .= readonlyRootfs
1006+ , "SecurityOpt" .= securityOpt
1007+ , "ShmSize" .= shmSize
1008+ ]
1009+ in
1010+ object $ arr <> ( resourcesArr resources)
1011+
1012+ where
1013+ -- JP: Not sure if this is better than a separate ToJSON instance with a bunch of `HM.insert`s.
1014+ resourcesArr ContainerResources{..} = [
1015+ "CpuShares" .= cpuShares
1016+ , "BlkioWeight" .= blkioWeight
1017+ , "BlkioWeightDevice" .= blkioWeightDevice
1018+ , "BlkioDeviceReadBps" .= blkioDeviceReadBps
1019+ , "BlkioDeviceWriteBps" .= blkioDeviceWriteBps
1020+ , "BlkioDeviceReadIOps" .= blkioDeviceReadIOps
1021+ , "BlkioDeviceWriteIOps" .= blkioDeviceWriteIOps
1022+ , "CpuPeriod" .= cpuPeriod
1023+ , "CpusetCpus" .= cpusetCpus
1024+ , "CpusetMems" .= cpusetMems
1025+ , "Devices" .= devices
1026+ , "KernelMemory" .= kernelMemory
1027+ , "Memory" .= memory
1028+ , "MemoryReservation" .= memoryReservation
1029+ , "MemorySwap" .= memorySwap
1030+ , "OomKillDisable" .= oomKillDisable
1031+ , "Ulimits" .= ulimits
1032+ ]
1033+
1034+
9571035
9581036
9591037-- { "Name": <name>, "Soft": <soft limit>, "Hard": <hard limit> }
@@ -972,18 +1050,54 @@ instance ToJSON Ulimit where
9721050 toJSON = genericToJSON defaultOptions {
9731051 fieldLabelModifier = drop 5}
9741052
1053+data DeviceWeight = DeviceWeight {
1054+ deviceWeightPath :: FilePath
1055+ , deviceWeightWeight :: Text
1056+ }
1057+ deriving (Show, Eq)
1058+
1059+instance FromJSON DeviceWeight where
1060+ parseJSON (JSON.Object o) = DeviceWeight
1061+ <$> o .: "Path"
1062+ <*> o .: "Weight"
1063+ parseJSON _ = fail "DeviceWeight is not an object."
1064+
1065+instance ToJSON DeviceWeight where
1066+ toJSON (DeviceWeight p w) = object [
1067+ "Path" .= p
1068+ , "Weight" .= w
1069+ ]
1070+
1071+data DeviceRate = DeviceRate {
1072+ deviceRatePath :: FilePath
1073+ , deviceRateRate :: Text
1074+ }
1075+ deriving (Show, Eq)
1076+
1077+instance FromJSON DeviceRate where
1078+ parseJSON (JSON.Object o) = DeviceRate
1079+ <$> o .: "Path"
1080+ <*> o .: "Rate"
1081+ parseJSON _ = fail "DeviceRate is not an object."
1082+
1083+instance ToJSON DeviceRate where
1084+ toJSON (DeviceRate p r) = object [
1085+ "Path" .= p
1086+ , "Rate" .= r
1087+ ]
1088+
9751089data ContainerResources = ContainerResources {
9761090 cpuShares :: Maybe Integer
9771091 -- , 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
1092+ , blkioWeight :: Maybe Integer
1093+ , blkioWeightDevice :: Maybe [DeviceWeight]
1094+ , blkioDeviceReadBps :: Maybe [DeviceRate] -- TODO: Not Text
1095+ , blkioDeviceWriteBps :: Maybe [DeviceRate] -- TODO: Not Text
1096+ , blkioDeviceReadIOps :: Maybe [DeviceRate] -- TODO: Not Text
1097+ , blkioDeviceWriteIOps :: Maybe [DeviceRate] -- TODO: Not Text
9841098 , cpuPeriod :: Maybe Integer
9851099 -- , cpuQuota :: Integer -- 1.24: Missing from inspecting container details... Going to omit for now.
986− , cpusetCpus :: Maybe Integer
1100+ , cpusetCpus :: Maybe Text
9871101 , cpusetMems :: Maybe Text
9881102 , devices :: [Device]
9891103 -- , diskQuota :: Integer -- Don't see this ins 1.24.
@@ -1006,13 +1120,13 @@ data ContainerResources = ContainerResources {
10061120 -- LxcConf :: [??] +
10071121 } deriving (Eq, Show, Generic)
10081122
1009−instance ToJSON ContainerResources where
1010− toJSON = genericToJSON defaultOptions {
1011− fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1123+-- instance ToJSON ContainerResources where
1124+-- toJSON = genericToJSON defaultOptions {
1125+-- fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
10121126
10131127instance FromJSON ContainerResources where
10141128 parseJSON = genericParseJSON defaultOptions {
1015− fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1129+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
10161130
10171131type Port = Integer
10181132
@@ -1074,7 +1188,7 @@ data ContainerConfig = ContainerConfig {
10741188 , attachStdin :: Bool
10751189 , attachStdout :: Bool
10761190 , attachStderr :: Bool
1077− , exposedPorts :: ExposedPorts
1191+ , exposedPorts :: Maybe ExposedPorts -- Note: Should we expand the JSON instance and take away the Maybe?
10781192 -- , publishService :: Text -- Don't see this in 1.24
10791193 , tty :: Bool
10801194 , openStdin :: Bool
@@ -1086,9 +1200,9 @@ data ContainerConfig = ContainerConfig {
10861200 , volumes :: Maybe Volumes
10871201 , workingDir :: Maybe FilePath
10881202 , entrypoint :: Maybe Text -- Can be null?
1089− , networkDisabled :: Bool
1203+ , networkDisabled :: Maybe Bool -- Note: Should we expand the JSON instance and take away the Maybe? Null is False?
10901204 , macAddress :: Maybe Text
1091− -- , onBuild :: Text -- For 1.24, only see this in the inspect response.
1205+ -- , onBuild :: Maybe Text -- For 1.24, only see this in the inspect response.
10921206 , labels :: Maybe Labels
10931207 , stopSignal :: Signal
10941208 } deriving (Eq, Show, Generic)
@@ -1101,7 +1215,7 @@ instance FromJSON ContainerConfig where
11011215 parseJSON = genericParseJSON defaultOptions {
11021216 fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
11031217
1104−parseIntegerText :: (Monad m) =>Text -> m Integer
1218+parseIntegerText :: (Monad m) => Text -> m Integer
11051219parseIntegerText t = case readMaybe $ T.unpack t of
11061220 Nothing ->
11071221 fail "Could not parse Integer"