0943a5a · docker-hs · git.iko.soy

git.iko.soy/docker-hs

Adds delete endpoint

0943a5aDeni Bertovic11 years ago

Network/Docker.hs+7−10

@@ -90,8 +90,6 @@ _dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint = Free (

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

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

94−

95_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)

93_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)

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

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

@@ -124,13 +122,12 @@ pauseContainer clientOpts cid = (^. responseStatus) <$> runDocker (pauseContaine

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

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

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

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

126

124

125+deleteContainer :: DockerClientOpts -> DeleteOpts -> String -> IO (Status)

126+deleteContainer c d cid = deleteContainerWithOpts c d cid

127

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

128+deleteContainerWithOpts :: DockerClientOpts -> DeleteOpts -> 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

129+deleteContainerWithOpts clientOpts deleteOpts cid = (^. responseStatus) <$>

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

130+ runDocker (deleteContainerM clientOpts (SDeleteContainerEndpoint cid deleteOpts))

134

131

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

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

136-- getContainerLogsStream clientOpts containerId = do

133-- getContainerLogsStream clientOpts containerId = do

@@ -140,10 +137,10 @@ unpauseContainer clientOpts cid = (^. responseStatus) <$> runDocker (unpauseCont

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

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

141

138

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

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

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

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

144

141

145

142

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

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

147 -- True -> error "dinamo"

144 -- True -> error "dinamo"

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

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

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

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

Network/Docker/Internal.hs+8

@@ -23,6 +23,7 @@ emptyPost = "" :: String

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

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

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

26+runDocker (Free (Delete url)) = delete url

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

28constructUrl :: URL -> ApiVersion -> String -> URL

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

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

@@ -46,6 +47,7 @@ getEndpoint (SRestartContainerEndpoint cid) = printf "/containers/%s/restart" ci

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

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

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

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

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

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

50+getEndpoint (SDeleteContainerEndpoint cid (DeleteOpts removeVolumes force)) = printf "/containers/%s?v=%s;force=%s" cid (show removeVolumes) (show force)

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

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

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

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

@@ -59,6 +61,9 @@ _dockerPostQuery clientOpts endpoint postObject = Free (Post (fullUrl clientOpts

59_dockerEmptyPostQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)

61_dockerEmptyPostQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)

60_dockerEmptyPostQuery clientOpts endpoint = Free (Post (fullUrl clientOpts endpoint) (toJSON emptyPost))

62_dockerEmptyPostQuery clientOpts endpoint = Free (Post (fullUrl clientOpts endpoint) (toJSON emptyPost))

64+_dockerDeleteQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)

65+_dockerDeleteQuery clientOpts endpoint = Free $ Delete $ fullUrl clientOpts endpoint

66+

62getDockerVersionM :: DockerClientOpts -> SEndpoint VersionEndpoint -> HttpRequestM (SEndpoint VersionEndpoint)

67getDockerVersionM :: DockerClientOpts -> SEndpoint VersionEndpoint -> HttpRequestM (SEndpoint VersionEndpoint)

63getDockerVersionM clientOpts e = _dockerGetQuery clientOpts e

68getDockerVersionM clientOpts e = _dockerGetQuery clientOpts e

@@ -89,6 +94,9 @@ createContainerM clientOpts e c = _dockerPostQuery clientOpts e c

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

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

90startContainerM clientOpts e c = _dockerPostQuery clientOpts e c

95startContainerM clientOpts e c = _dockerPostQuery clientOpts e c

97+deleteContainerM :: DockerClientOpts -> SEndpoint DeleteContainerEndpoint -> HttpRequestM (SEndpoint DeleteContainerEndpoint)

98+deleteContainerM clientOpts e = _dockerDeleteQuery clientOpts e

99+

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

100-- getContainerLogsM :: DockerClientOpts -> SEndpoint ContainerLogsEndpoint -> Bool -> HttpRequestM (SEndpoint ContainerLogsEndpoint)

93-- getContainerLogsM clientOpts e f = case f of

101-- getContainerLogsM clientOpts e f = case f of

94-- False -> _dockerGetQuery clientOpts e

102-- False -> _dockerGetQuery clientOpts e

Network/Docker/Types.hs+3

@@ -52,6 +52,7 @@ data Endpoint =

52 | PauseContainerEndpoint

53 | UnpauseContainerEndpoint

54 | ContainerLogsEndpoint

55+ | DeleteContainerEndpoint

57data SEndpoint (a :: Endpoint) where

58data SEndpoint (a :: Endpoint) where

@@ -66,6 +67,7 @@ data SEndpoint (a :: Endpoint) where

66 SPauseContainerEndpoint :: String -> SEndpoint PauseContainerEndpoint

67 SPauseContainerEndpoint :: String -> SEndpoint PauseContainerEndpoint

67 SUnpauseContainerEndpoint :: String -> SEndpoint UnpauseContainerEndpoint

68 SUnpauseContainerEndpoint :: String -> SEndpoint UnpauseContainerEndpoint

68 SContainerLogsEndpoint :: String -> SEndpoint ContainerLogsEndpoint

69 SContainerLogsEndpoint :: String -> SEndpoint ContainerLogsEndpoint

70+ SDeleteContainerEndpoint :: String -> DeleteOpts -> SEndpoint DeleteContainerEndpoint

70defaultClientOpts :: DockerClientOpts

72defaultClientOpts :: DockerClientOpts

71defaultClientOpts = DockerClientOpts

73defaultClientOpts = DockerClientOpts

@@ -77,6 +79,7 @@ defaultClientOpts = DockerClientOpts

77data HttpRequestF a =

79data HttpRequestF a =

78 Get URL

80 Get URL

79 | Post URL Value

81 | Post URL Value

82+ | Delete URL

80 deriving ( Functor, Show )

83 deriving ( Functor, Show )