git.iko.soy/docker-hs
on master help sign in
separate stuff into an Internal module
commit89beb36d6af879e5d7d2f3c7dc989d08189b3bdd authorDeni Bertovic <deni@denibertovic.com> dateSun 11 Jan 2015, 19:12 (12 years ago) parentfada835
2 files changed+64−25
compare with master
unifiedsplit
Network/Docker.hs+3−25 Network/Docker/Internal.hs+61
Network/Docker.hs+3−25
@@ -7,9 +7,9 @@ module Network.Docker where
77import Control.Applicative ((<$>), (<*>))
88import Control.Lens
99import Control.Monad.Free
10−import Data.Aeson (FromJSON, ToJSON, Value, decode,
11− eitherDecode, toJSON)
12−import Data.Aeson.Lens (key, _String)
10+import Data.Aeson (FromJSON, ToJSON, Value, decode,
11+ eitherDecode, toJSON)
12+import Data.Aeson.Lens (key, _String)
1313import Data.Aeson.TH
1414import qualified Data.ByteString.Lazy as L
1515import Data.Char
@@ -28,7 +28,6 @@ import Text.Printf (printf)
2828
2929emptyPost = "" :: String
3030
31−<<<<<<< b865ecd79f55927c7265efcacc45692df148aa4a
3231defaultClientOpts :: DockerClientOpts
3332defaultClientOpts = DockerClientOpts
3433 { apiVersion = "v1.12"
@@ -51,21 +50,6 @@ getElemFromResponse k r = (^? responseBody . key k . _String) r
5150
5251getResponseStatusCode r = (^. responseStatus) r
5352
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)
6953
7054setupSSLCtx :: SSLOptions -> IO SSLContext
7155setupSSLCtx (SSLOptions key cert) = do
@@ -105,8 +89,6 @@ _dockerEmptyPostQuery :: DockerClientOpts -> Endpoint -> HttpRequestM Endpoint
10589_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint = Free (Post (fullUrl clientOpts endpoint) (toJSON emptyPost))
10690_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint = Free (PostSSL sslOpts (fullUrl clientOpts endpoint) (toJSON emptyPost))
10791
108−getDockerVersionM :: DockerClientOpts -> HttpRequestM Endpoint
109−getDockerVersionM clientOpts = _dockerGetQuery clientOpts VersionEndpoint
11092
11193_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)
11294
@@ -125,10 +107,6 @@ getDockerVersion clientOpts = decodeResponse <$> run (getDockerVersionM clientOp
125107-- startContainer :: DockerClientOpts -> String -> StartContainerOpts -> IO(Status)
126108-- startContainer clientOpts containerId startOpts = (^. responseStatus) <$> _dockerPostQuery (printf "/containers/%s/start" containerId) clientOpts startOpts
127109
128−stopContainerM :: DockerClientOpts -> Endpoint -> HttpRequestM Endpoint
129−stopContainerM clientOpts e = _dockerEmptyPostQuery clientOpts e
130−
131−
132110stopContainer :: DockerClientOpts -> String -> IO (Status)
133111stopContainer clientOpts cid = (^. responseStatus) <$> run (stopContainerM clientOpts (StopContainerEndpoint cid))
134112
Network/Docker/Internal.hsnew file+61
@@ -0,0 +1,61 @@
1+module Network.Docker.Internal where
2+
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+