git.iko.soy/docker-hs
on master help sign in
Fixes Volumes to/from json instances

and adds tests and documentation.

commite17d8e425325a8097782083676b5d5590475bccf authorDeni Bertovic <deni@denibertovic.com> dateSun 14 Aug 2016, 00:12 (10 years ago) parent1c8b74c
2 files changed+25−11
compare with master
unifiedsplit
src/Docker/Client/Types.hs+15−6 tests/tests.hs+10−5
src/Docker/Client/Types.hs+15−6
@@ -41,6 +41,7 @@ module Docker.Client.Types (
4141 , defaultLogOpts
4242 , VolumePermission(..)
4343 , Volume(..)
44+ , Volumes(..)
4445 , Device(..)
4546 , ContainerName
4647 , VolumeFrom(..)
@@ -651,17 +652,25 @@ data VolumePermission = Rw | Ro deriving (Eq, Show, Generic)
651652-- instance FromJSON VolumePermission where
652653-- parseJSON = error "TODO"
653654
654−-- Note: Note really sure what this should be (1.24).
655−-- This is not the same as [Volume] in HostConfig.
656−newtype Volumes = Volumes [Text] -- [Volume]
657− deriving (Eq, Show)
655+-- | Used for marking a directory in the container as "exposed" hence
656+-- taking it outside of the COW filesystem and making it mountable
657+-- in other containers using "VolumesFrom".
658+-- The CLI example is:
659+--
660+-- @
661+-- docker run --name app -v \/opt\/data -it myapp:latest
662+-- docker run --name app2 --volumes-from app \/bin\/bash -c "ls -l \/opt\/data"
663+-- @
664+newtype Volumes = Volumes [FilePath] deriving (Eq, Show)
658665
659666instance FromJSON Volumes where
660− parseJSON (JSON.Object o) = return $ Volumes $ HM.keys o
667+ parseJSON (JSON.Object o) = return $ Volumes $ map T.unpack $ HM.keys o
661668 parseJSON _ = fail "Volumes is not an object"
662669
663670instance ToJSON Volumes where
664− toJSON (Volumes vs) = toJSON vs
671+ toJSON (Volumes []) = JSON.Object HM.empty
672+ toJSON (Volumes (v:vs)) = JSON.Object $ foldl f HM.empty (v:vs)
673+ where f acc k = HM.insert (T.pack k) (JSON.Object HM.empty) acc
665674
666675data Volume = Volume { hostSrc :: Text
667676 , containerDest :: Text
tests/tests.hs+10−5
@@ -71,14 +71,19 @@ testRunAndReadLog = runDocker $ do
7171 lift $ assert $ status3 == Right ()
7272
7373
74−sampleEP = ExposedPorts $ M.fromList [(80, TCP), (1337, UDP)]
75−
76−testExposedPorts :: TestTree
77−testExposedPorts = testGroup "Testing ExposedPorts JSON" [ testTCP, testUDP ]
74+testExposedPortsJson :: TestTree
75+testExposedPortsJson = testGroup "Testing ExposedPorts JSON" [ testTCP, testUDP ]
7876 where
7977 testTCP = testCase "tcp port" $ assert $ JSON.toJSON sampleEP ^. key "80/tcp" . _Object == HM.empty
8078 testUDP = testCase "udp port" $ assert $ JSON.toJSON sampleEP ^. key "1337/tcp" . _Object == HM.empty
79+ sampleEP = ExposedPorts $ M.fromList [(80, TCP), (1337, UDP)]
8180
81+testVolumesJson :: TestTree
82+testVolumesJson = testGroup "Testing Volumes JSON" [ testSample1, testSample2 ]
83+ where
84+ testSample1 = testCase "Test exposing volume: /tmp" $ assert $ JSON.toJSON sampleVolumes ^. key "/tmp" . _Object == HM.empty
85+ testSample2 = testCase "Test exposing volume: /opt" $ assert $ JSON.toJSON sampleVolumes ^. key "/opt" . _Object == HM.empty
86+ sampleVolumes = Volumes ["/tmp", "/opt"]
8287
8388integrationTests :: TestTree
8489integrationTests = testGroup "Integration Tests" [
@@ -87,7 +92,7 @@ integrationTests = testGroup "Integration Tests" [
8792 testCase "Run a dummy container and read its log" testRunAndReadLog]
8893
8994jsonTests :: TestTree
90−jsonTests = testGroup "JSON Tests" [testExposedPorts]
95+jsonTests = testGroup "JSON Tests" [testExposedPortsJson, testVolumesJson]
9196
9297setup :: IO ()
9398setup = system ("docker build -t "++unpack testImageName++" tests") >> return ()