docker 0.1.0.1 → 0.2.0.1

raw patch · 5 files changed

+139/−12 lines, 5 filesdep +QuickCheckdep +dockerdep +http-typesdep ~aesondep ~bytestringdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, docker, http-types, lens-aeson, process, tasty, tasty-hunit, tasty-quickcheck

Dependency ranges changed: aeson, bytestring, containers, lens, text, wreq

API changes (from Hackage documentation)

Files

• Network/Docker.hs +12/−3
• Network/Docker/Options.hs +1/−5
• Network/Docker/Types.hs +23/−2
• docker.cabal +41/−2
• tests/tests.hs +62/−0

@@ -5,7 +5,7 @@ import           Control.Applicative    ((<$>), (<*>)) import           Control.Lens import           Data.Aeson             (FromJSON, ToJSON, decode, eitherDecode,-                                         encode)+                                         toJSON) import           Data.Aeson.Lens        (key, _String) import           Data.Aeson.TH import qualified Data.ByteString.Lazy   as L@@ -44,11 +44,13 @@ _dockerGetQuery endpoint clientOpts = get (fullUrl clientOpts endpoint)  _dockerPostQuery :: ToJSON a => Endpoint -> DockerClientOpts -> a -> IO (Response L.ByteString)-_dockerPostQuery endpoint clientOpts postObject = post (fullUrl clientOpts endpoint) (encode postObject)+_dockerPostQuery endpoint clientOpts postObject = post (fullUrl clientOpts endpoint) (toJSON postObject)  emptyPost = "" :: String-_dockerEmptyPostQuery endpoint clientOpts = post (fullUrl clientOpts endpoint) (encode emptyPost)+_dockerEmptyPostQuery endpoint clientOpts = post (fullUrl clientOpts endpoint) (toJSON emptyPost) +_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)+ getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion) getDockerVersion = decodeResponse . _dockerGetQuery "/version" @@ -78,6 +80,13 @@  unpauseContainer :: DockerClientOpts -> String -> IO (Status) unpauseContainer  clientOpts containerId = (^. responseStatus) <$> _dockerEmptyPostQuery (printf "/containers/%s/unpause" containerId) clientOpts++deleteContainer :: DockerClientOpts -> String -> IO (Status)+deleteContainer = deleteContainerWithOpts defaultDeleteOpts++deleteContainerWithOpts :: DeleteOpts -> DockerClientOpts -> String -> IO (Status)+deleteContainerWithOpts (DeleteOpts removeVolumes force) clientOpts containerId = (^. responseStatus) <$> _dockerEmptyDeleteQuery req clientOpts+  where req = printf "/containers/%s?v=%s;force=%s" containerId (show removeVolumes) (show force)  getContainerLogsStream :: DockerClientOpts -> String -> IO () getContainerLogsStream  clientOpts containerId = do

@@ -4,12 +4,8 @@ import           Network.Docker.Utils  dopts :: Options-dopts = Options {+dopts = defaultOptions {       fieldLabelModifier = strip_underscore-    , constructorTagModifier = id-    , allNullaryToStringTag = True-    , omitNothingFields = True-    , sumEncoding = defaultTaggedObject     }  

@@ -6,6 +6,7 @@  module Network.Docker.Types where +import           Prelude                hiding(id) import           Control.Applicative import           Control.Lens.TH import           Control.Lens.TH@@ -68,7 +69,14 @@             , _type        :: PortType             } deriving (Show, Eq) +data DeleteOpts = DeleteOpts+            { removeVolumes :: Bool+            , force         :: Bool+            } +defaultDeleteOpts = DeleteOpts False False++ data DockerContainer = DockerContainer                     { _containerId        :: ResourceId                     , _containerImageId   :: ResourceId@@ -156,11 +164,12 @@                         { _Binds           :: [T.Text]                         , _Links           :: [T.Text]                         , _LxcConf         :: [(T.Text, T.Text)]-                        , _PortBindings    :: [(T.Text, [(T.Text, T.Text)])]+                        , _PortBindings    :: [((Int,T.Text),Int)]                         , _PublishAllPorts :: Bool                         , _Privileged      :: Bool                         , _Dns             :: [T.Text]                         , _VolumesFrom     :: [T.Text]+			, _RestartPolicy   :: RestartPolicy                         } deriving (Show)  defaultStartOpts = StartContainerOpts@@ -172,6 +181,7 @@                 , _Privileged = False                 , _Dns = []                 , _VolumesFrom = []+                , _RestartPolicy = RestartNever                 }  instance ToJSON StartContainerOpts where@@ -179,12 +189,23 @@             [ "Binds" .= _Binds             , "Links" .= _Links             , "LxcConf" .= _LxcConf-            , "PortBindings" .= _PortBindings+            , "PortBindings" .= object (map (\((h,p),c)->T.concat [T.pack (show h),"/",p] .= [object ["HostPort" .= show c]]) _PortBindings)             , "PublishAllPorts" .= _PublishAllPorts             , "Privileged" .= _Privileged             , "Dns" .= _Dns             , "VolumesFrom" .= _VolumesFrom+	    , "RestartPolicy" .= _RestartPolicy             ]++data RestartPolicy = RestartNever+                   | RestartAlways+                   | RestartOnFailure Int+                   deriving (Show)++instance ToJSON RestartPolicy where+  toJSON RestartNever = object ["Name" .= (""::String), "MaximumRetryCount" .= (0::Int) ]+  toJSON RestartAlways = object ["Name" .= ("always"::String), "MaximumRetryCount" .= (0::Int) ]+  toJSON (RestartOnFailure n) = object ["Name" .= ("on-failure"::String), "MaximumRetryCount" .= n ]  makeClassy ''ResourceId 

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                docker-version:             0.1.0.1+version:             0.2.0.1 synopsis:            Haskell wrapper for Docker Remote API -- description: homepage:            https://github.com/denibertovic/docker-hs@@ -21,6 +21,45 @@   exposed-modules:     Network.Docker, Network.Docker.Options, Network.Docker.Types, Network.Docker.Utils   -- other-modules:   other-extensions:    OverloadedStrings, DeriveFunctor, FlexibleContexts, TemplateHaskell-  build-depends:       base >=4.7 && <4.8, lens >=4.2 && <4.3, aeson >=0.7 && <0.8, bytestring >=0.10 && <0.11, text >=1.1 && <1.2, wreq >=0.1 && <0.2, containers >=0.5 && <0.6, data-default >= 0.5.3, network-uri >= 2.6.0.1, pipes-http >= 1.0.0, pipes >= 4.1.2, pipes-text >= 0.0.0.12, pipes-bytestring >= 2.1.0+  build-depends:       base >= 4.7 && < 4.8+                     , lens >= 4.2+                     , aeson >= 0.7+                     , lens-aeson+                     , bytestring >= 0.10+                     , text >= 1.1+                     , wreq >= 0.3+                     , containers >= 0.5+                     , data-default >= 0.5.3+                     , network-uri >= 2.6.0.1+                     , pipes-http >= 1.0.0+                     , pipes >= 4.1.2+                     , pipes-text >= 0.0.0.12+                     , pipes-bytestring >= 2.1.0   -- hs-source-dirs:   default-language:    Haskell2010++test-suite tests+    build-depends:       base >= 4.7 && < 4.8+                       , docker+                       , lens >= 4.2+                       , aeson >= 0.7+                       , lens-aeson+                       , bytestring >= 0.10+                       , text >= 1.1+                       , wreq >= 0.3+                       , containers >= 0.5+                       , data-default >= 0.5.3+                       , pipes >= 4.1.2+                       , pipes-http >= 1.0.0+                       , pipes-text >= 0.0.0.12+                       , pipes-bytestring >= 2.1.0+                       , tasty >= 0.10.1+                       , tasty-quickcheck >= 0.8.2+                       , QuickCheck >= 2.7+                       , tasty-hunit >= 0.8+                       , process+                       , http-types+    type:                exitcode-stdio-1.0+    main-is:             tests.hs+    hs-source-dirs:      tests+    default-language:    Haskell2010

@@ -0,0 +1,62 @@+module Main where++import Network.Docker+import Network.Docker.Types++import Test.Tasty+import Test.Tasty.HUnit+import qualified Test.Tasty.QuickCheck as QC+import qualified Test.QuickCheck.Monadic as QCM++import Data.Maybe (isJust, fromJust)+import System.Process (system)+import Data.Text (unpack)+import Control.Concurrent (threadDelay)+import Network.HTTP.Types.Status+import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString       as B+import qualified Data.ByteString.Lazy  as BL++opts = defaultClientOpts { baseUrl = "http://127.0.0.1:2375/" }++test_image_name = "docker-hs-test"++toStrict1 = B.concat . BL.toChunks++checkDockerVersion :: IO ()+checkDockerVersion =  do v <- getDockerVersion opts+                         assert $ isJust v++findTestImage :: IO ()+findTestImage = do images <- getDockerImages opts+                   let x = fmap (filter ((== [test_image_name++":latest"]) . _repoTags)) images+                   assert $ fmap length x == Just 1++runAndReadLog :: IO ()+runAndReadLog = do containerId <- createContainer opts (defaultCreateOpts {_image = test_image_name++":latest"})+                   assert $ isJust containerId+                   let c = unpack $ fromJust containerId+                   status1 <- startContainer opts c defaultStartOpts+                   threadDelay 300000 -- give 300ms for the application to finish+                   assert $ status1 == status204+                   status2 <- killContainer opts c+                   logs <- getContainerLogs opts c+                   assert $ status2 == status204+                   assert $ (C.pack "123") `C.isInfixOf` (toStrict1 logs)+                   status3 <- deleteContainer opts c+                   assert $ status3 == status204+++tests :: TestTree+tests = testGroup "Metrics tests" [+    testCase "Get docker version" checkDockerVersion,+    testCase "Find image by name" findTestImage,+    testCase "Run a dummy container and read its log" runAndReadLog]++setup :: IO()+setup =  system ("docker build -t "++test_image_name++" tests") >> return ()++main :: IO()+main = do+  setup+  defaultMain tests