on master help sign in
work in progress of fixing json parsing
commitb2b575e9f9a7f615caa2bf2929cbecaf3d2518b8 authorjprider63 <jp@jamesparker.me> dateWed 27 Jul 2016, 16:29 (10 years ago) parent5241d7a
1 file changed+65−15
src/Docker/Types.hs+65−15
src/Docker/Types.hs+65−15
@@ -548,7 +548,7 @@ defaultContainerConfig imageName = ContainerConfig {
548548 , volumes=Nothing
549549 , workingDir=Nothing
550550 , entrypoint=Nothing
551− , networkDisabled=False
551+ , networkDisabled=Nothing
552552 , macAddress=Nothing
553553 , labels=Nothing
554554 , stopSignal=SIGTERM
@@ -571,11 +571,11 @@ defaultHostConfig = HostConfig {
571571 , dnsSearch=[]
572572 , extraHosts=[]
573573 , ipcMode=Nothing
574− , links=[]
574+ , links=Nothing
575575 , oomScoreAdj=Nothing
576576 , privileged=False
577577 , publishAllPorts=False
578− , readOnlyRootfs=False
578+ , readonlyRootfs=False
579579 , securityOpt=[]
580580 , shmSize=Nothing
581581 , resources=defaultContainerResources
@@ -899,7 +899,7 @@ instance FromJSON RestartPolicy where
899899 "on-failure" -> do
900900 retry <- o .: "MaximumRetryCount"
901901 return $ RestartOnFailure retry
902− "" -> return RestartOff -- Note: Is this correct? 1.24 spec is unclear.
902+ "off" -> return RestartOff
903903 _ -> fail "Could not parse RestartPolicy"
904904 parseJSON _ = fail "RestartPolicy is not an object"
905905
@@ -933,12 +933,12 @@ data HostConfig = HostConfig
933933 , extraHosts :: [Text]
934934 -- , groupAdd :: [Integer] -- 1.24: Missing from inspecting container details... Going to omit for now.
935935 , ipcMode :: Maybe Text -- 1.24: Only in inspect, not create
936− , links :: [Link]
936+ , links :: Maybe [Link] -- Note: Expand JSON instances? Null is []?
937937 , oomScoreAdj :: Maybe Integer
938938 -- , pidMode :: Text -- 1.24: Don't see pidMode, just pidsLimit
939939 , privileged :: Bool
940940 , publishAllPorts :: Bool
941− , readOnlyRootfs :: Bool
941+ , readonlyRootfs :: Bool
942942 , securityOpt :: [Text]
943943 -- , utsMode :: UTSMode -- 1.24: Don't see this
944944 , shmSize :: Maybe Integer
@@ -948,12 +948,62 @@ data HostConfig = HostConfig
948948 } deriving (Eq, Show, Generic)
949949
950950instance FromJSON HostConfig where
951− parseJSON = genericParseJSON defaultOptions {
952− fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
951+ parseJSON v@(JSON.Object o) = HostConfig <$>
952+ <*>
953+ <*> parseJSON v
953954
954955instance ToJSON HostConfig where
955− toJSON = genericToJSON defaultOptions {
956− fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
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)
983+
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
1004+ ]
1005+
1006+
9571007
9581008
9591009-- { "Name": <name>, "Soft": <soft limit>, "Hard": <hard limit> }
@@ -1006,13 +1056,13 @@ data ContainerResources = ContainerResources {
10061056 -- LxcConf :: [??] +
10071057 } deriving (Eq, Show, Generic)
10081058
1009−instance ToJSON ContainerResources where
1010− toJSON = genericToJSON defaultOptions {
1011− fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1059+-- instance ToJSON ContainerResources where
1060+-- toJSON = genericToJSON defaultOptions {
1061+-- fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
10121062
10131063instance FromJSON ContainerResources where
10141064 parseJSON = genericParseJSON defaultOptions {
1015− fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
1065+ fieldLabelModifier = (\(x:xs) -> toUpper x : xs)}
10161066
10171067type Port = Integer
10181068
@@ -1086,7 +1136,7 @@ data ContainerConfig = ContainerConfig {
10861136 , volumes :: Maybe Volumes
10871137 , workingDir :: Maybe FilePath
10881138 , entrypoint :: Maybe Text -- Can be null?
1089− , networkDisabled :: Bool
1139+ , networkDisabled :: Maybe Bool -- Note: Should we expand the JSON instance and take away the Maybe? Null is False?
10901140 , macAddress :: Maybe Text
10911141 -- , onBuild :: Text -- For 1.24, only see this in the inspect response.
10921142 , labels :: Maybe Labels