89beb36 · docker-hs · git.iko.soy

git.iko.soy/docker-hs

on master help sign in

separate stuff into an Internal module

89beb36Deni Bertovic12 years ago

Network/Docker.hs+3−25

compare with master

unifiedsplit

@@ -7,9 +7,9 @@ module Network.Docker where

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

8import Control.Lens

9import Control.Monad.Free

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

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

11− eitherDecode, toJSON)

11+ eitherDecode, toJSON)

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

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

13import Data.Aeson.TH

14import qualified Data.ByteString.Lazy as L

15import Data.Char

@@ -28,7 +28,6 @@ import Text.Printf (printf)

29emptyPost = "" :: String

31−<<<<<<< b865ecd79f55927c7265efcacc45692df148aa4a

32defaultClientOpts :: DockerClientOpts

31defaultClientOpts :: DockerClientOpts

33defaultClientOpts = DockerClientOpts

32defaultClientOpts = DockerClientOpts

34 { apiVersion = "v1.12"

33 { apiVersion = "v1.12"

@@ -51,21 +50,6 @@ getElemFromResponse k r = (^? responseBody . key k . _String) r

52getResponseStatusCode r = (^. responseStatus) r

51getResponseStatusCode r = (^. responseStatus) r

54−getEndpoint :: Endpoint -> String

55−getEndpoint VersionEndpoint = "/version"

56−getEndpoint ListContainersEndpoint = "/containers/json"

57−getEndpoint ListImagesEndpoint = "/images/json"

58−getEndpoint CreateContainerEndpoint = "/containers/create"

59−getEndpoint (StartContainerEndpoint cid) = printf "/containers/%s/start" cid

60−getEndpoint (StopContainerEndpoint cid) = printf "/containers/%s/stop" cid

61−getEndpoint (KillContainerEndpoint cid) = printf "/containers/%s/kill" cid

62−getEndpoint (RestartContainerEndpoint cid) = printf "/containers/%s/restart" cid

63−getEndpoint (PauseContainerEndpoint cid) = printf "/containers/%s/pause" cid

64−getEndpoint (UnpauseContainerEndpoint cid) = printf "/containers/%s/unpause" cid

65−getEndpoint (ContainerLogsEndpoint cid) = printf "/containers/%s/logs" cid

66−

67−fullUrl :: DockerClientOpts -> Endpoint -> URL

68−fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) (getEndpoint endpoint)

70setupSSLCtx :: SSLOptions -> IO SSLContext

54setupSSLCtx :: SSLOptions -> IO SSLContext

71setupSSLCtx (SSLOptions key cert) = do

55setupSSLCtx (SSLOptions key cert) = do

@@ -105,8 +89,6 @@ _dockerEmptyPostQuery :: DockerClientOpts -> Endpoint -> HttpRequestM Endpoint

105_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint = Free (Post (fullUrl clientOpts endpoint) (toJSON emptyPost))

89_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint = Free (Post (fullUrl clientOpts endpoint) (toJSON emptyPost))

106_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))

107

108−getDockerVersionM :: DockerClientOpts -> HttpRequestM Endpoint

109−getDockerVersionM clientOpts = _dockerGetQuery clientOpts VersionEndpoint

110

111_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)

93_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)

112

@@ -125,10 +107,6 @@ getDockerVersion clientOpts = decodeResponse <$> run (getDockerVersionM clientOp

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

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

126-- startContainer clientOpts containerId startOpts = (^. responseStatus) <$> _dockerPostQuery (printf "/containers/%s/start" containerId) clientOpts startOpts

108-- startContainer clientOpts containerId startOpts = (^. responseStatus) <$> _dockerPostQuery (printf "/containers/%s/start" containerId) clientOpts startOpts

127

109

128−stopContainerM :: DockerClientOpts -> Endpoint -> HttpRequestM Endpoint

129−stopContainerM clientOpts e = _dockerEmptyPostQuery clientOpts e

130−

131−

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

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

133stopContainer clientOpts cid = (^. responseStatus) <$> run (stopContainerM clientOpts (StopContainerEndpoint cid))

111stopContainer clientOpts cid = (^. responseStatus) <$> run (stopContainerM clientOpts (StopContainerEndpoint cid))

134

112

Network/Docker/Internal.hsnew file+61

@@ -0,0 +1,61 @@

1+module Network.Docker.Internal where

3+import Control.Lens

4+import Control.Monad.Free

5+import Data.Aeson (FromJSON, ToJSON, Value, decode,

6+ eitherDecode, toJSON)

7+import Data.Aeson.Lens (key, _String)

8+import qualified Data.ByteString.Lazy as L

9+import Network.Docker.Types

10+import Network.Wreq

11+import Text.Printf (printf)

12+

13+emptyPost = "" :: String

14+

15+

16+run :: HttpRequestM r -> IO (Response L.ByteString)

17+run (Free (Get url)) = get url

18+run (Free (Post url body)) = post url body

19+

20+constructUrl :: URL -> ApiVersion -> String -> URL

21+constructUrl url apiVersion endpoint = printf "%s%s%s" url apiVersion endpoint

22+

23+-- decodeResponse :: Response L.ByteString -> a

24+decodeResponse r = decode (r ^. responseBody)

25+

26+getElemFromResponse k r = (^? responseBody . key k . _String) r

27+

28+getResponseStatusCode r = (^. responseStatus) r

29+

30+getEndpoint :: Endpoint -> String

31+getEndpoint VersionEndpoint = "/version"

32+getEndpoint ListContainersEndpoint = "/containers/json"

33+getEndpoint ListImagesEndpoint = "/images/json"

34+getEndpoint CreateContainerEndpoint = "/containers/create"

35+getEndpoint (StartContainerEndpoint cid) = printf "/containers/%s/start" cid

36+getEndpoint (StopContainerEndpoint cid) = printf "/containers/%s/stop" cid

37+getEndpoint (KillContainerEndpoint cid) = printf "/containers/%s/kill" cid

38+getEndpoint (RestartContainerEndpoint cid) = printf "/containers/%s/restart" cid

39+getEndpoint (PauseContainerEndpoint cid) = printf "/containers/%s/pause" cid

40+getEndpoint (UnpauseContainerEndpoint cid) = printf "/containers/%s/unpause" cid

41+getEndpoint (ContainerLogsEndpoint cid) = printf "/containers/%s/logs" cid

42+

43+fullUrl :: DockerClientOpts -> Endpoint -> URL

44+fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) (getEndpoint endpoint)

45+

46+_dockerGetQuery :: DockerClientOpts -> Endpoint -> HttpRequestM Endpoint

47+_dockerGetQuery clientOpts endpoint = Free (Get (fullUrl clientOpts endpoint))

48+

49+_dockerPostQuery :: ToJSON a => DockerClientOpts -> Endpoint -> a -> HttpRequestM Endpoint

50+_dockerPostQuery clientOpts endpoint postObject = Free (Post (fullUrl clientOpts endpoint) (toJSON postObject))

51+

52+_dockerEmptyPostQuery :: DockerClientOpts -> Endpoint -> HttpRequestM Endpoint

53+_dockerEmptyPostQuery clientOpts endpoint = Free (Post (fullUrl clientOpts endpoint) (toJSON emptyPost))

54+

55+getDockerVersionM :: DockerClientOpts -> HttpRequestM Endpoint

56+getDockerVersionM clientOpts = _dockerGetQuery clientOpts VersionEndpoint

57+

58+stopContainerM :: DockerClientOpts -> Endpoint -> HttpRequestM Endpoint

59+stopContainerM clientOpts e = _dockerEmptyPostQuery clientOpts e

60+

61+