git.iko.soy/docker-hs
on master help sign in
Stop using Maybe for NetworkingConfig in CreateOpts; add alias for EndpointName
c3c22feDaQuirm
src/Docker/Client/Types.hs+9−8
compare with master
unifiedsplit
@@ -624,9 +624,12 @@ instance ToJSON EndpointConfig where
624 [ "Aliases" .= aliases
624 [ "Aliases" .= aliases
625 ]
625 ]
626
626
627+-- | Alias for endpoint name
628+type EndpointName = Text
629+
627-- | Data type for the NetworkingConfig section of the container settings
630-- | Data type for the NetworkingConfig section of the container settings
628newtype NetworkingConfig = NetworkingConfig
631newtype NetworkingConfig = NetworkingConfig
629− { endpointsConfig :: HM.HashMap Text EndpointConfig
632+ { endpointsConfig :: HM.HashMap EndpointName EndpointConfig
630 } deriving (Eq, Show)
633 } deriving (Eq, Show)
631
634
632instance ToJSON NetworkingConfig where
635instance ToJSON NetworkingConfig where
@@ -636,9 +639,9 @@ instance ToJSON NetworkingConfig where
636
639
637-- | Options used for creating a Container.
640-- | Options used for creating a Container.
638data CreateOpts = CreateOpts {
641data CreateOpts = CreateOpts {
639− containerConfig :: ContainerConfig
642+ containerConfig :: ContainerConfig
640− , hostConfig :: HostConfig
643+ , hostConfig :: HostConfig
641− , networkingConfig :: Maybe NetworkingConfig
644+ , networkingConfig :: NetworkingConfig
642 } deriving (Eq, Show)
645 } deriving (Eq, Show)
643
646
644instance ToJSON CreateOpts where
647instance ToJSON CreateOpts where
@@ -648,9 +651,7 @@ instance ToJSON CreateOpts where
648 case ccJSON of
651 case ccJSON of
649 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do
652 JSON.Object (o :: HM.HashMap T.Text JSON.Value) -> do
650 let o1 = HM.insert "HostConfig" hcJSON o
653 let o1 = HM.insert "HostConfig" hcJSON o
651− let o2 = case nc of
652− Nothing -> o1
653− Just _ -> HM.insert "NetworkingConfig" (toJSON nc) o1
654+ let o2 = HM.insert "NetworkingConfig" (toJSON nc) o1
654 JSON.Object o2
655 JSON.Object o2
655 _ -> error "ContainerConfig is not an object." -- This should never happen.
656 _ -> error "ContainerConfig is not an object." -- This should never happen.
656
657
@@ -736,7 +737,7 @@ defaultCreateOpts :: T.Text -> CreateOpts
736defaultCreateOpts imageName = CreateOpts
737defaultCreateOpts imageName = CreateOpts
737 { containerConfig = defaultContainerConfig imageName
738 { containerConfig = defaultContainerConfig imageName
738 , hostConfig = defaultHostConfig
739 , hostConfig = defaultHostConfig
739− , networkingConfig = Nothing
740+ , networkingConfig = NetworkingConfig HM.empty
740 }
741 }
741
742
742-- | Override the key sequence for detaching a container.
743-- | Override the key sequence for detaching a container.
tests/tests.hs+1−1
@@ -94,7 +94,7 @@ testRunAndReadLog =
94 runDocker $
94 runDocker $
95 do let containerConfig = (defaultContainerConfig (testImageName <> ":latest")) {env = [EnvVar "TEST" "123"]}
95 do let containerConfig = (defaultContainerConfig (testImageName <> ":latest")) {env = [EnvVar "TEST" "123"]}
96 networkingConfig = NetworkingConfig $ HM.fromList [("test-network", EndpointConfig ["cellar-door"])]
96 networkingConfig = NetworkingConfig $ HM.fromList [("test-network", EndpointConfig ["cellar-door"])]
97− containerId <- createContainer (CreateOpts containerConfig defaultHostConfig (Just networkingConfig)) Nothing
97+ containerId <- createContainer (CreateOpts containerConfig defaultHostConfig networkingConfig) Nothing
98 c <- fromRight containerId
98 c <- fromRight containerId
99 status1 <- startContainer defaultStartOpts c
99 status1 <- startContainer defaultStartOpts c
100 _ <- inspectContainer c >>= fromRight
100 _ <- inspectContainer c >>= fromRight