cb0e5d8 · docker-hs · git.iko.soy

git.iko.soy/docker-hs

on master help sign in

WIP

cb0e5d8Deni Bertovic11 years ago

Network/Docker.hs+33−25

compare with master

unifiedsplit

@@ -5,25 +5,13 @@

5module Network.Docker where

7import Control.Applicative ((<$>), (<*>))

8−import Control.Lens

9import Control.Monad.Free

8import Control.Monad.Free

10import Data.Aeson (FromJSON, ToJSON, Value, decode,

9import Data.Aeson (FromJSON, ToJSON, Value, decode,

11 eitherDecode, toJSON)

10 eitherDecode, toJSON)

12import Data.Aeson.Lens (key, _String)

11import Data.Aeson.Lens (key, _String)

13−import Data.Aeson.TH

14import qualified Data.ByteString.Lazy as L

12import qualified Data.ByteString.Lazy as L

15import Data.Char

13import Data.Char

16import qualified Data.Text as T

14import qualified Data.Text as T

17−import qualified Data.Text as T

18−import Network.Docker.Options

19−import Network.Wreq

20−-- import Pipes

21−-- import qualified Pipes.ByteString as PB

22−-- import qualified Pipes.HTTP as PH

23−

24−

25−import Network.Docker.Internal

26−import Network.Docker.Types

27import Network.HTTP.Client.OpenSSL

15import Network.HTTP.Client.OpenSSL

28import Network.Wreq

16import Network.Wreq

29import OpenSSL (withOpenSSL)

17import OpenSSL (withOpenSSL)

@@ -34,6 +22,10 @@ import qualified Pipes.ByteString as PB

34import qualified Pipes.HTTP as PH

22import qualified Pipes.HTTP as PH

35import Text.Printf (printf)

23import Text.Printf (printf)

25+import Network.Docker.Internal

26+import Network.Docker.Options

27+import Network.Docker.Types

28+

37emptyPost = "" :: String

29emptyPost = "" :: String

39defaultClientOpts :: DockerClientOpts

31defaultClientOpts :: DockerClientOpts

@@ -98,38 +90,47 @@ _dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint = Free (

98_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint = Free (PostSSL sslOpts (fullUrl clientOpts endpoint) (toJSON emptyPost))

90_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint = Free (PostSSL sslOpts (fullUrl clientOpts endpoint) (toJSON emptyPost))

100

93+_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)

94+

101_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)

95_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)

102

103getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion)

97getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion)

104−getDockerVersion clientOpts = decodeResponse <$> run (getDockerVersionM clientOpts SVersionEndpoint)

98+getDockerVersion clientOpts = decodeResponse <$> runDocker (getDockerVersionM clientOpts SVersionEndpoint)

105

106listContainers :: DockerClientOpts -> IO (Maybe [DockerContainer])

100listContainers :: DockerClientOpts -> IO (Maybe [DockerContainer])

107−listContainers clientOpts = decodeResponse <$> run (listContainersM clientOpts SListContainersEndpoint)

101+listContainers clientOpts = decodeResponse <$> runDocker (listContainersM clientOpts SListContainersEndpoint)

108

102

109listImages :: DockerClientOpts -> IO (Maybe [DockerImage])

103listImages :: DockerClientOpts -> IO (Maybe [DockerImage])

110−listImages clientOpts = decodeResponse <$> run (listImagesM clientOpts SListImagesEndpoint)

104+listImages clientOpts = decodeResponse <$> runDocker (listImagesM clientOpts SListImagesEndpoint)

111

105

112createContainer :: DockerClientOpts -> CreateContainerOpts -> IO(Maybe T.Text)

106createContainer :: DockerClientOpts -> CreateContainerOpts -> IO(Maybe T.Text)

113−createContainer clientOpts createOpts = getElemFromResponse "Id" <$> run (createContainerM clientOpts (SCreateContainerEndpoint) createOpts)

107+createContainer clientOpts createOpts = getElemFromResponse "Id" <$> runDocker (createContainerM clientOpts (SCreateContainerEndpoint) createOpts)

114

108

115startContainer :: DockerClientOpts -> String -> StartContainerOpts -> IO(Status)

109startContainer :: DockerClientOpts -> String -> StartContainerOpts -> IO(Status)

116−startContainer clientOpts cid startOpts = (^. responseStatus) <$> run (startContainerM clientOpts (SStartContainerEndpoint cid) startOpts)

110+startContainer clientOpts cid startOpts = (^. responseStatus) <$> runDocker (startContainerM clientOpts (SStartContainerEndpoint cid) startOpts)

117

111

118stopContainer :: DockerClientOpts -> String -> IO (Status)

112stopContainer :: DockerClientOpts -> String -> IO (Status)

119−stopContainer clientOpts cid = (^. responseStatus) <$> run (stopContainerM clientOpts (SStopContainerEndpoint cid))

113+stopContainer clientOpts cid = (^. responseStatus) <$> runDocker (stopContainerM clientOpts (SStopContainerEndpoint cid))

120

114

121killContainer :: DockerClientOpts -> String -> IO (Status)

115killContainer :: DockerClientOpts -> String -> IO (Status)

122−killContainer clientOpts cid = (^. responseStatus) <$> run (killContainerM clientOpts (SKillContainerEndpoint cid))

116+killContainer clientOpts cid = (^. responseStatus) <$> runDocker (killContainerM clientOpts (SKillContainerEndpoint cid))

123

117

124restartContainer :: DockerClientOpts -> String -> IO (Status)

118restartContainer :: DockerClientOpts -> String -> IO (Status)

125−restartContainer clientOpts cid = (^. responseStatus) <$> run (restartContainerM clientOpts (SRestartContainerEndpoint cid))

119+restartContainer clientOpts cid = (^. responseStatus) <$> runDocker (restartContainerM clientOpts (SRestartContainerEndpoint cid))

126

120

127pauseContainer :: DockerClientOpts -> String -> IO (Status)

121pauseContainer :: DockerClientOpts -> String -> IO (Status)

128−pauseContainer clientOpts cid = (^. responseStatus) <$> run (pauseContainerM clientOpts (SPauseContainerEndpoint cid))

122+pauseContainer clientOpts cid = (^. responseStatus) <$> runDocker (pauseContainerM clientOpts (SPauseContainerEndpoint cid))

129

123

130unpauseContainer :: DockerClientOpts -> String -> IO (Status)

124unpauseContainer :: DockerClientOpts -> String -> IO (Status)

131−unpauseContainer clientOpts cid = (^. responseStatus) <$> run (unpauseContainerM clientOpts (SUnpauseContainerEndpoint cid))

125+unpauseContainer clientOpts cid = (^. responseStatus) <$> runDocker (unpauseContainerM clientOpts (SUnpauseContainerEndpoint cid))

126+

132

127

128+-- deleteContainer :: DockerClientOpts -> String -> IO (Status)

129+-- deleteContainer = deleteContainerWithOpts defaultDeleteOpts

130+

131+-- deleteContainerWithOpts :: DeleteOpts -> DockerClientOpts -> String -> IO (Status)

132+-- deleteContainerWithOpts (DeleteOpts removeVolumes force) clientOpts containerId = (^. responseStatus) <$> _dockerEmptyDeleteQuery req clientOpts

133+-- where req = printf "/containers/%s?v=%s;force=%s" containerId (show removeVolumes) (show force)

133

134

134-- getContainerLogsStream :: DockerClientOpts -> String -> IO ()

135-- getContainerLogsStream :: DockerClientOpts -> String -> IO ()

135-- getContainerLogsStream clientOpts containerId = do

136-- getContainerLogsStream clientOpts containerId = do

@@ -138,7 +139,14 @@ unpauseContainer clientOpts cid = (^. responseStatus) <$> run (unpauseContainerM

138-- PH.withManager PH.defaultManagerSettings $ \m -> PH.withHTTP req' m $ \resp -> runEffect $ PH.responseBody resp >-> PB.stdout

139-- PH.withManager PH.defaultManagerSettings $ \m -> PH.withHTTP req' m $ \resp -> runEffect $ PH.responseBody resp >-> PB.stdout

139-- where url = (printf "/containers/%s/logs?stdout=1&stderr=1&follow=1" containerId)

140-- where url = (printf "/containers/%s/logs?stdout=1&stderr=1&follow=1" containerId)

140

141

141−-- getContainerLogs :: DockerClientOpts -> String -> IO (L.ByteString)

142+-- getContainerLogs :: DockerClientOpts -> String -> Bool -> IO (L.ByteString)

142−-- getContainerLogs clientOpts containerId = (^. responseBody) <$> _dockerGetQuery url clientOpts

143+-- getContainerLogs clientOpts cid follow = (^. responseBody) <$> runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid) follow)

143−-- where url = (printf "/containers/%s/logs?stdout=1&stderr=1" containerId)

144+

145+

146+ -- False -> (^. responseBody) <$> runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid "0"))

147+ -- True -> error "dinamo"

148+ -- req <- PH.parseUrl (SContainerLogsEndpoint cid "1")

149+ -- let req' = req {PH.method = "GET"}

150+ -- PH.withManager PH.defaultManagerSettings $ \m -> PH.withHTTP req' m $ \resp -> runEffect $ PH.responseBody resp >-> PB.stdout

151+

144

152

Network/Docker/Internal.hs+15−4

@@ -11,14 +11,18 @@ import Data.Aeson.Lens (key, _String)

11import qualified Data.ByteString.Lazy as L

12import Network.Docker.Types

13import Network.Wreq

14+import Pipes

15+import qualified Pipes.ByteString as PB

16+import qualified Pipes.HTTP as PH

14import Text.Printf (printf)

17import Text.Printf (printf)

19+

16emptyPost = "" :: String

20emptyPost = "" :: String

19−run :: HttpRequestM r -> IO (Response L.ByteString)

23+runDocker :: HttpRequestM r -> IO (Response L.ByteString)

20−run (Free (Get url)) = get url

24+runDocker (Free (Get url)) = get url

21−run (Free (Post url body)) = post url body

25+runDocker (Free (Post url body)) = post url body

23constructUrl :: URL -> ApiVersion -> String -> URL

27constructUrl :: URL -> ApiVersion -> String -> URL

24constructUrl url apiVersion endpoint = printf "%s%s%s" url apiVersion endpoint

28constructUrl url apiVersion endpoint = printf "%s%s%s" url apiVersion endpoint

@@ -41,7 +45,7 @@ getEndpoint (SKillContainerEndpoint cid) = printf "/containers/%s/kill" cid

41getEndpoint (SRestartContainerEndpoint cid) = printf "/containers/%s/restart" cid

45getEndpoint (SRestartContainerEndpoint cid) = printf "/containers/%s/restart" cid

42getEndpoint (SPauseContainerEndpoint cid) = printf "/containers/%s/pause" cid

46getEndpoint (SPauseContainerEndpoint cid) = printf "/containers/%s/pause" cid

43getEndpoint (SUnpauseContainerEndpoint cid) = printf "/containers/%s/unpause" cid

47getEndpoint (SUnpauseContainerEndpoint cid) = printf "/containers/%s/unpause" cid

44−getEndpoint (SContainerLogsEndpoint cid) = printf "/containers/%s/logs" cid

48+getEndpoint (SContainerLogsEndpoint cid) = printf "/containers/%s/logs?stdout=1&stderr=1" cid

46fullUrl :: DockerClientOpts -> SEndpoint a -> URL

50fullUrl :: DockerClientOpts -> SEndpoint a -> URL

47fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) (getEndpoint endpoint)

51fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) (getEndpoint endpoint)

@@ -85,4 +89,11 @@ createContainerM clientOpts e c = _dockerPostQuery clientOpts e c

85startContainerM :: DockerClientOpts -> SEndpoint StartContainerEndpoint -> StartContainerOpts -> HttpRequestM (SEndpoint StartContainerEndpoint)

89startContainerM :: DockerClientOpts -> SEndpoint StartContainerEndpoint -> StartContainerOpts -> HttpRequestM (SEndpoint StartContainerEndpoint)

86startContainerM clientOpts e c = _dockerPostQuery clientOpts e c

90startContainerM clientOpts e c = _dockerPostQuery clientOpts e c

92+-- getContainerLogsM :: DockerClientOpts -> SEndpoint ContainerLogsEndpoint -> Bool -> HttpRequestM (SEndpoint ContainerLogsEndpoint)

93+-- getContainerLogsM clientOpts e f = case f of

94+-- False -> _dockerGetQuery clientOpts e

95+-- True -> do

96+-- req <- PH.parseUrl ((fullUrl clientOpts e) ++ "&follow=1")

97+-- let req' = req {PH.method = "GET"}

98+-- PH.withManager PH.defaultManagerSettings $ \m -> PH.withHTTP req' m $ \resp -> runEffect $ PH.responseBody resp >-> PB.stdout

Network/Docker/Types.hs+3−4

@@ -14,7 +14,6 @@ import Control.Monad.Free

14import Data.Aeson

15import Data.Aeson.Types

16import Data.Bool

17−import qualified Data.ByteString.Lazy as BS

18import qualified Data.ByteString.Lazy as L

17import qualified Data.ByteString.Lazy as L

19import Data.Default

18import Data.Default

20import qualified Data.Map as Map

19import qualified Data.Map as Map

@@ -70,8 +69,8 @@ data SEndpoint (a :: Endpoint) where

71defaultClientOpts :: DockerClientOpts

70defaultClientOpts :: DockerClientOpts

72defaultClientOpts = DockerClientOpts

71defaultClientOpts = DockerClientOpts

73− { apiVersion = "v1.12"

72+ { apiVersion = "v1.20"

74− , baseUrl = "http://127.0.0.1:3128/"

73+ , baseUrl = "http://127.0.0.1:2375/"

75 }

74 }

@@ -161,7 +160,7 @@ data CreateContainerOpts = CreateContainerOpts

161 } deriving (Show)

160 } deriving (Show)

162

161

163defaultCreateOpts = CreateContainerOpts {

162defaultCreateOpts = CreateContainerOpts {

164− _hostname = ""

163+ _hostname = ""

165 , _user = ""

164 , _user = ""

166 , _memory = 0

165 , _memory = 0

167 , _memorySwap = 0

166 , _memorySwap = 0