git.iko.soy/docker-hs
on master help sign in
Refactor LogDriverOptons
e48c402Deni Bertovic
src/Docker/Client/Types.hs+17−17
compare with master
unifiedsplit
@@ -47,7 +47,7 @@ module Docker.Client.Types (
47 , VolumeFrom(..)
47 , VolumeFrom(..)
48 , Link(..)
48 , Link(..)
49 , LogDriverType(..)
49 , LogDriverType(..)
50− , LogDriverOptions(..)
50+ , LogDriverOption(..)
51 , LogDriverConfig(..)
51 , LogDriverConfig(..)
52 , NetworkMode(..)
52 , NetworkMode(..)
53 , PortType(..)
53 , PortType(..)
@@ -638,7 +638,7 @@ defaultHostConfig :: HostConfig
638defaultHostConfig = HostConfig {
638defaultHostConfig = HostConfig {
639 binds=[]
639 binds=[]
640 , containerIDFile=Nothing
640 , containerIDFile=Nothing
641− , logConfig=LogDriverConfig JsonFile Nothing
641+ , logConfig=LogDriverConfig JsonFile []
642 , networkMode=Bridge
642 , networkMode=Bridge
643 , portBindings=[]
643 , portBindings=[]
644 , restartPolicy=RestartOff
644 , restartPolicy=RestartOff
@@ -863,27 +863,27 @@ instance ToJSON LogDriverType where
863 toJSON Etwlogs = JSON.String "etwlogs"
863 toJSON Etwlogs = JSON.String "etwlogs"
864 toJSON LoggingDisabled = JSON.String "none"
864 toJSON LoggingDisabled = JSON.String "none"
865
865
866−newtype LogDriverOptions = LogDriverOptions (M.Map Text Text) deriving (Eq, Show)
866+data LogDriverOption = LogDriverOption Name Value deriving (Eq, Show)
867
867
868−instance FromJSON LogDriverOptions where
868+instance ToJSON [LogDriverOption] where
869− parseJSON (JSON.Object o) = do
869+ toJSON [] = emptyJsonObject
870− LogDriverOptions <$> HM.foldlWithKey' f (return M.empty) o
870+ toJSON (o:os) = toJsonKeyVal (o:os) key val
871+ where key (LogDriverOption n _) = T.unpack n
872+ val (LogDriverOption _ v) = v
871
873
872− where
874+instance FromJSON [LogDriverOption] where
875+ parseJSON (JSON.Object o) = HM.foldlWithKey' f (return []) o
873− f accM k (JSON.String v) = do
876+ where f accM k v = do
874 acc <- accM
877 acc <- accM
875− return $ M.insert k v acc
878+ value <- parseJSON v
876− f _ _ _ = fail "Value of LogDriverOptions is not a string"
879+ return $ (LogDriverOption k value):acc
877−
878− parseJSON JSON.Null = return $ LogDriverOptions M.empty
880+ parseJSON JSON.Null = return []
879− parseJSON _ = fail "LogDriverOptions is not an object"
880−
881−instance ToJSON LogDriverOptions where
882− toJSON (LogDriverOptions mp) = toJSON mp
881+ parseJSON _ = fail "Failed to parse LogDriverOptions"
883
882
884−data LogDriverConfig = LogDriverConfig LogDriverType (Maybe LogDriverOptions) deriving (Eq, Show)
883+data LogDriverConfig = LogDriverConfig LogDriverType [LogDriverOption] deriving (Eq, Show)
885
884
886instance ToJSON LogDriverConfig where
885instance ToJSON LogDriverConfig where
886+ toJSON (LogDriverConfig driverType []) = object ["Type" .= driverType]
887 toJSON (LogDriverConfig driverType driverOptions) = object ["Type" .= driverType, "Config" .= driverOptions]
887 toJSON (LogDriverConfig driverType driverOptions) = object ["Type" .= driverType, "Config" .= driverOptions]
888
888
889instance FromJSON LogDriverConfig where
889instance FromJSON LogDriverConfig where
tests/tests.hs+13−2
@@ -75,6 +75,18 @@ testRunAndReadLog = runDocker $ do
75 status3 <- deleteContainer (DeleteOpts True True) c
75 status3 <- deleteContainer (DeleteOpts True True) c
76 lift $ assert $ status3 == Right ()
76 lift $ assert $ status3 == Right ()
77
77
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"
78
90
79testExposedPortsJson :: TestTree
91testExposedPortsJson :: TestTree
80testExposedPortsJson = testGroup "Testing ExposedPorts JSON" [ testTCP, testUDP ]
92testExposedPortsJson = testGroup "Testing ExposedPorts JSON" [ testTCP, testUDP ]
@@ -95,7 +107,6 @@ testLabelsJson = testGroup "Testing Labels JSON" [ testLS1, testLS2, testOverrid
95 key2 = "something"
107 key2 = "something"
96 val2 = "value"
108 val2 = "value"
97
109
98−
99testVolumesJson :: TestTree
110testVolumesJson :: TestTree
100testVolumesJson = testGroup "Testing Volumes JSON" [ testSample1, testSample2 ]
111testVolumesJson = testGroup "Testing Volumes JSON" [ testSample1, testSample2 ]
101 where
112 where
@@ -110,7 +121,7 @@ integrationTests = testGroup "Integration Tests" [
110 testCase "Run a dummy container and read its log" testRunAndReadLog]
121 testCase "Run a dummy container and read its log" testRunAndReadLog]
111
122
112jsonTests :: TestTree
123jsonTests :: TestTree
113−jsonTests = testGroup "JSON Tests" [testExposedPortsJson, testVolumesJson, testLabelsJson]
124+jsonTests = testGroup "JSON Tests" [testExposedPortsJson, testVolumesJson, testLabelsJson, testLogDriverOptionsJson]
114
125
115setup :: IO ()
126setup :: IO ()
116setup = system ("docker build -t "++unpack testImageName++" tests") >> return ()
127setup = system ("docker build -t "++unpack testImageName++" tests") >> return ()