aeaf4c5 · docker-hs · git.iko.soy

git.iko.soy/docker-hs

on master help sign in

Adds Binds example and helper functions.

aeaf4c5Deni Bertovic10 years ago

examples/Example.hs+11

compare with master

unifiedsplit

@@ -18,3 +18,14 @@ stopNginxContainer cid = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

18 Left err -> error "I failed to stop the container"

19 Right _ -> return ()

21+runPostgresContainer :: IO ContainerID

22+runPostgresContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

23+ let pb = PortBinding 5432 TCP [HostPort "0.0.0.0" 5432]

24+ let myCreateOpts = addBinds [Bind "/tmp" "/tmp" Nothing] $ addPortBinding (defaultCreateOpts "postgres:9.5") pb

25+ cid <- createContainer myCreateOpts

26+ case cid of

27+ Left err -> error $ show err

28+ Right i -> do

29+ _ <- startContainer defaultStartOpts i

30+ return i

31+

src/Docker/Client.hs+19−2

@@ -51,6 +51,23 @@ stopNginxContainer cid = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

52>>> stopNginxContainer cid

54+Let's start a Postgres container by mapping the /tmp directory from within the container to the

55+/tmp directory on the host. That way we make sure that the data we write to /tmp in the container will

56+persist on the host file system.

57+

58+@

59+runPostgresContainer :: IO ContainerID

60+runPostgresContainer = runDockerT (defaultClientOpts, defaultHttpHandler) $ do

61+ let pb = PortBinding 5432 TCP [HostPort "0.0.0.0" 5432]

62+ let myCreateOpts = addBinds [Bind "\/tmp" "\/tmp" Nothing] $ addPortBinding (defaultCreateOpts "postgres:9.5") pb

63+ cid <- createContainer myCreateOpts

64+ case cid of

65+ Left err -> error $ show err

66+ Right i -> do

67+ _ <- startContainer defaultStartOpts i

68+ return i

69+@

70+

54= Get Docker API Version

71= Get Docker API Version

56>>> runDockerT (defaultClientOpts, defaultHttpHandler) $ getDockerVersion

73>>> runDockerT (defaultClientOpts, defaultHttpHandler) $ getDockerVersion

@@ -58,9 +75,9 @@ Right (DockerVersion {version = "1.12.0", apiVersion = "1.24", gitCommit = "8eab

59= Setup SSL Authentication

76= Setup SSL Authentication

61−Let's create a custom 'HttpHandler' that uses a client's certificate and private key for SSL authentication.

78+Let's create a custom 'HttpHandler' that uses a client's certificate and private key for SSL authentication.

62It also accepts a self-signed CA certificate which is specified via 'clientParamsSetCA'.

79It also accepts a self-signed CA certificate which is specified via 'clientParamsSetCA'.

63−This handler can replace 'defaultHttpHandler' in the arguments to 'runDockerT'.

80+This handler can replace 'defaultHttpHandler' in the arguments to 'runDockerT'.

65@

82@

66let host = "domain.name"

83let host = "domain.name"

src/Docker/Client/Types.hs+20−14

@@ -40,7 +40,7 @@ module Docker.Client.Types (

40 , LogOpts(..)

41 , defaultLogOpts

42 , VolumePermission(..)

43− , Volume(..)

43+ , Bind(..)

44 , Volumes(..)

45 , Device(..)

46 , ContainerName

@@ -78,6 +78,7 @@ module Docker.Client.Types (

78 , DeviceWeight(..)

79 , DeviceRate(..)

80 , addPortBinding

81+ , addBinds

81 ) where

82 ) where

83import Data.Aeson (FromJSON, ToJSON, genericParseJSON,

84import Data.Aeson (FromJSON, ToJSON, genericParseJSON,

@@ -742,18 +743,18 @@ instance ToJSON Volumes where

742 toJSON (Volumes (v:vs)) = JSON.Object $ foldl f HM.empty (v:vs)

743 toJSON (Volumes (v:vs)) = JSON.Object $ foldl f HM.empty (v:vs)

743 where f acc k = HM.insert (T.pack k) (JSON.Object HM.empty) acc

744 where f acc k = HM.insert (T.pack k) (JSON.Object HM.empty) acc

744

745

745−data Volume = Volume { hostSrc :: Text

746+data Bind = Bind { hostSrc :: Text

746− , containerDest :: Text

747+ , containerDest :: Text

747− , volumePermission :: Maybe VolumePermission

748+ , volumePermission :: Maybe VolumePermission

748− } deriving (Eq, Show)

749+ } deriving (Eq, Show)

749

750

750−instance FromJSON Volume where

751+instance FromJSON Bind where

751 parseJSON (JSON.String t) = case T.split (== ':') t of

752 parseJSON (JSON.String t) = case T.split (== ':') t of

752− [src, dest] -> return $ Volume src dest Nothing

753+ [src, dest] -> return $ Bind src dest Nothing

753− [src, dest, "rw"] -> return $ Volume src dest $ Just ReadWrite

754+ [src, dest, "rw"] -> return $ Bind src dest $ Just ReadWrite

754− [src, dest, "ro"] -> return $ Volume src dest $ Just ReadOnly

755+ [src, dest, "ro"] -> return $ Bind src dest $ Just ReadOnly

755− _ -> fail "Could not parse Volume"

756+ _ -> fail "Could not parse Bind"

756− parseJSON _ = fail "Volume is not a string"

757+ parseJSON _ = fail "Bind is not a string"

757

758

758data Device = Device {

759data Device = Device {

759 pathOnHost :: FilePath

760 pathOnHost :: FilePath

@@ -786,8 +787,8 @@ instance ToJSON VolumeFrom where

786 Nothing -> toJSON $ n <> ":" <> "rw"

787 Nothing -> toJSON $ n <> ":" <> "rw"

787 Just per -> toJSON $ n <> ":" <> (T.pack $ show per)

788 Just per -> toJSON $ n <> ":" <> (T.pack $ show per)

788

789

789−instance ToJSON Volume where

790+instance ToJSON Bind where

790− toJSON (Volume src dest mode) = toJSON $ case mode of

791+ toJSON (Bind src dest mode) = toJSON $ case mode of

791 Nothing -> T.concat[src, ":", dest]

792 Nothing -> T.concat[src, ":", dest]

792 Just m -> T.concat[src, ":", dest, ":", (T.pack $ show m)]

793 Just m -> T.concat[src, ":", dest, ":", (T.pack $ show m)]

793

794

@@ -924,6 +925,11 @@ data PortBinding = PortBinding {

924portAndType2Text :: Port -> PortType -> Text

925portAndType2Text :: Port -> PortType -> Text

925portAndType2Text p t = (T.pack $ show p) <> "/" <> (T.pack $ show t)

926portAndType2Text p t = (T.pack $ show p) <> "/" <> (T.pack $ show t)

926

927

928+

929+addBinds :: [Bind] -> CreateOpts -> CreateOpts

930+addBinds bs c = c{hostConfig=hc{binds=bs}}

931+ where hc = hostConfig c

932+

927-- | A convenience function that adds PortBindings to and exiting

933-- | A convenience function that adds PortBindings to and exiting

928-- "CreateOpts" record. Useful with 'defaultCreateOpts'

934-- "CreateOpts" record. Useful with 'defaultCreateOpts'

929-- Example:

935-- Example:

@@ -1008,7 +1014,7 @@ newtype UTSMode = UTSMode Text deriving (Eq, Show)

1008-- TODO: Add UTSMode : UTS namespace to use for the container

1014-- TODO: Add UTSMode : UTS namespace to use for the container

1009-- TODO: Sysctls map[string]string `json:",omitempty"` // List of Namespaced sysctls used for the container

1015-- TODO: Sysctls map[string]string `json:",omitempty"` // List of Namespaced sysctls used for the container

1010data HostConfig = HostConfig

1016data HostConfig = HostConfig

1011− { binds :: [Volume]

1017+ { binds :: [Bind]

1012 , containerIDFile :: Maybe FilePath -- 1.24: Only in responses, not create

1018 , containerIDFile :: Maybe FilePath -- 1.24: Only in responses, not create

1013 , logConfig :: LogDriverConfig

1019 , logConfig :: LogDriverConfig

1014 , networkMode :: NetworkMode

1020 , networkMode :: NetworkMode