git.iko.soy/docker-hs
on master help sign in
Refactor LogDriverOptons

Same as with Labels we are retiring the clunky newtype and just using [LogDriverOption].

commite48c402bd46d16aeedf420456000993f324ab3fb authorDeni Bertovic <deni@denibertovic.com> dateMon 5 Sep 2016, 16:44 (10 years ago) parent0c6ef15
2 files changed+30−19
compare with master
unifiedsplit
src/Docker/Client/Types.hs+17−17 tests/tests.hs+13−2
src/Docker/Client/Types.hs+17−17
@@ -47,7 +47,7 @@ module Docker.Client.Types (
4747 , VolumeFrom(..)
4848 , Link(..)
4949 , LogDriverType(..)
50− , LogDriverOptions(..)
50+ , LogDriverOption(..)
5151 , LogDriverConfig(..)
5252 , NetworkMode(..)
5353 , PortType(..)
@@ -638,7 +638,7 @@ defaultHostConfig :: HostConfig
638638defaultHostConfig = HostConfig {
639639 binds=[]
640640 , containerIDFile=Nothing
641− , logConfig=LogDriverConfig JsonFile Nothing
641+ , logConfig=LogDriverConfig JsonFile []
642642 , networkMode=Bridge
643643 , portBindings=[]
644644 , restartPolicy=RestartOff
@@ -863,27 +863,27 @@ instance ToJSON LogDriverType where
863863 toJSON Etwlogs = JSON.String "etwlogs"
864864 toJSON LoggingDisabled = JSON.String "none"
865865
866−newtype LogDriverOptions = LogDriverOptions (M.Map Text Text) deriving (Eq, Show)
866+data LogDriverOption = LogDriverOption Name Value deriving (Eq, Show)
867867
868−instance FromJSON LogDriverOptions where
869− parseJSON (JSON.Object o) = do
870− LogDriverOptions <$> HM.foldlWithKey' f (return M.empty) o
868+instance ToJSON [LogDriverOption] where
869+ toJSON [] = emptyJsonObject
870+ toJSON (o:os) = toJsonKeyVal (o:os) key val
871+ where key (LogDriverOption n _) = T.unpack n
872+ val (LogDriverOption _ v) = v
871873
872− where
873− f accM k (JSON.String v) = do
874+instance FromJSON [LogDriverOption] where
875+ parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
876+ where f accM k v = do
874877 acc <- accM
875− return $ M.insert k v acc
876− f _ _ _ = fail "Value of LogDriverOptions is not a string"
877−
878− parseJSON JSON.Null = return $ LogDriverOptions M.empty
879− parseJSON _ = fail "LogDriverOptions is not an object"
880−
881−instance ToJSON LogDriverOptions where
882− toJSON (LogDriverOptions mp) = toJSON mp
878+ value <- parseJSON v
879+ return $ (LogDriverOption k value):acc
880+ parseJSON JSON.Null = return []
881+ parseJSON _ = fail "Failed to parse LogDriverOptions"
883882
884−data LogDriverConfig = LogDriverConfig LogDriverType (Maybe LogDriverOptions) deriving (Eq, Show)
883+data LogDriverConfig = LogDriverConfig LogDriverType [LogDriverOption] deriving (Eq, Show)
885884
886885instance ToJSON LogDriverConfig where
886+ toJSON (LogDriverConfig driverType []) = object ["Type" .= driverType]
887887 toJSON (LogDriverConfig driverType driverOptions) = object ["Type" .= driverType, "Config" .= driverOptions]
888888
889889instance FromJSON LogDriverConfig where
tests/tests.hs+13−2
@@ -75,6 +75,18 @@ testRunAndReadLog = runDocker $ do
7575 status3 <- deleteContainer (DeleteOpts True True) c
7676 lift $ assert $ status3 == Right ()
7777
78+testLogDriverOptionsJson :: TestTree
79+testLogDriverOptionsJson = testGroup "Testing LogDriverOptions JSON" [ test1, test2, test3 ]
80+ where
81+ test1 = testCase "Driver option 1" $ assert $ JSON.toJSON sample ^. key key1 . _String == val1
82+ test2 = testCase "Driver option 2" $ assert $ JSON.toJSON sample ^. key key2 . _String == val2
83+ test3 = testCase "Test override" $ assert $ JSON.toJSON sample2 ^. key key1 . _String == "override"
84+ sample = [LogDriverOption key1 val1, LogDriverOption key2 val2]
85+ sample2 = [LogDriverOption key1 val1, LogDriverOption key1 "override"]
86+ key1 = "some-key"
87+ val1 = "some-val"
88+ key2 = "some-key2"
89+ val2 = "some-key2"
7890
7991testExposedPortsJson :: TestTree
8092testExposedPortsJson = testGroup "Testing ExposedPorts JSON" [ testTCP, testUDP ]
@@ -95,7 +107,6 @@ testLabelsJson = testGroup "Testing Labels JSON" [ testLS1, testLS2, testOverrid
95107 key2 = "something"
96108 val2 = "value"
97109
98−
99110testVolumesJson :: TestTree
100111testVolumesJson = testGroup "Testing Volumes JSON" [ testSample1, testSample2 ]
101112 where
@@ -110,7 +121,7 @@ integrationTests = testGroup "Integration Tests" [
110121 testCase "Run a dummy container and read its log" testRunAndReadLog]
111122
112123jsonTests :: TestTree
113−jsonTests = testGroup "JSON Tests" [testExposedPortsJson, testVolumesJson, testLabelsJson]
124+jsonTests = testGroup "JSON Tests" [testExposedPortsJson, testVolumesJson, testLabelsJson, testLogDriverOptionsJson]
114125
115126setup :: IO ()
116127setup = system ("docker build -t "++unpack testImageName++" tests") >> return ()