cb0e5d8 · docker-hs · git.iko.soy

git.iko.soy/docker-hs

WIP

commitcb0e5d8bec91b27364628a7b40175c453fa5296b authorDeni Bertovic <deni@denibertovic.com> dateThu 11 Feb 2016, 17:42 (11 years ago) parent5840c84

3 files changed+51−33

compare with master

unifiedsplit

Network/Docker.hs+33−25 Network/Docker/Internal.hs+15−4 Network/Docker/Types.hs+3−4

Network/Docker.hs+33−25

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

55module Network.Docker where

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

8−import Control.Lens

98import Control.Monad.Free

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

1110 eitherDecode, toJSON)

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

13−import Data.Aeson.TH

1412import qualified Data.ByteString.Lazy as L

1513import Data.Char

1614import 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

2715import Network.HTTP.Client.OpenSSL

2816import Network.Wreq

2917import OpenSSL (withOpenSSL)

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

3422import qualified Pipes.HTTP as PH

3523import Text.Printf (printf)

3624

25+import Network.Docker.Internal

26+import Network.Docker.Options

27+import Network.Docker.Types

28+

3729emptyPost = "" :: String

3830

3931defaultClientOpts :: DockerClientOpts

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

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

9991

10092

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

94+

10195_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)

10296

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

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

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

10599

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

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

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

108102

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

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

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

111105

112106createContainer :: 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)

114108

115109startContainer :: 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)

117111

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

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

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

120114

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

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

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

123117

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

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

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

126120

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

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

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

129123

130124unpauseContainer :: 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+

132127

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)

133134

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

135136-- getContainerLogsStream clientOpts containerId = do

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

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

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

140141

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

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

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

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

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

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+

144152

Network/Docker/Internal.hs+15−4

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

1111import qualified Data.ByteString.Lazy as L

1212import Network.Docker.Types

1313import Network.Wreq

14+import Pipes

15+import qualified Pipes.ByteString as PB

16+import qualified Pipes.HTTP as PH

1417import Text.Printf (printf)

1518

19+

1620emptyPost = "" :: String

1721

1822

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

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

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

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

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

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

2226

2327constructUrl :: URL -> ApiVersion -> String -> URL

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

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

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

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

4347getEndpoint (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

4549

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

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

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

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

8690startContainerM clientOpts e c = _dockerPostQuery clientOpts e c

8791

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

8899

Network/Docker/Types.hs+3−4

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

1414import Data.Aeson

1515import Data.Aeson.Types

1616import Data.Bool

17−import qualified Data.ByteString.Lazy as BS

1817import qualified Data.ByteString.Lazy as L

1918import Data.Default

2019import qualified Data.Map as Map

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

7069

7170defaultClientOpts :: DockerClientOpts

7271defaultClientOpts = DockerClientOpts

73− { apiVersion = "v1.12"

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

72+ { apiVersion = "v1.20"

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

7574 }

7675

7776

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

161160 } deriving (Show)

162161

163162defaultCreateOpts = CreateContainerOpts {

164− _hostname = ""

163+ _hostname = ""

165164 , _user = ""

166165 , _memory = 0

167166 , _memorySwap = 0