git.iko.soy/docker-hs
on master help sign in
Fixes bad merges
95ed15dDeni Bertovic
Network/Docker.hs+14−81
compare with master
unifiedsplit
@@ -4,95 +4,26 @@
4
4
5module Network.Docker where
5module Network.Docker where
6
6
7−import Control.Applicative ((<$>), (<*>))
7+import Control.Applicative ((<$>), (<*>))
8+import Control.Lens
8import Control.Monad.Free
9import Control.Monad.Free
9−import Data.Aeson (FromJSON, ToJSON, Value, decode,
10+import Data.Aeson (FromJSON, ToJSON, Value, decode,
10− eitherDecode, toJSON)
11+ eitherDecode, toJSON)
11−import Data.Aeson.Lens (key, _String)
12+import Data.Aeson.Lens (key, _String)
12−import qualified Data.ByteString.Lazy as L
13+import qualified Data.ByteString.Lazy as L
13import Data.Char
14import Data.Char
14−import qualified Data.Text as T
15+import qualified Data.Text as T
15−import Network.HTTP.Client.OpenSSL
16import Network.Wreq
16import Network.Wreq
17−import OpenSSL (withOpenSSL)
18−import OpenSSL.Session (SSLContext, context)
19−import qualified OpenSSL.Session as SSL
20import Pipes
17import Pipes
21import Pipes
18import Pipes
22−import qualified Pipes.ByteString as PB
19+import qualified Pipes.ByteString as PB
23−import qualified Pipes.HTTP as PH
20+import qualified Pipes.HTTP as PH
24−import Text.Printf (printf)
21+import Text.Printf (printf)
25
22
26import Network.Docker.Internal
23import Network.Docker.Internal
27import Network.Docker.Options
24import Network.Docker.Options
28import Network.Docker.Types
25import Network.Docker.Types
29
26
30−emptyPost = "" :: String
31−
32−defaultClientOpts :: DockerClientOpts
33−defaultClientOpts = DockerClientOpts
34− { apiVersion = "v1.12"
35− , baseUrl = "http://127.0.0.1:3128/"
36− , ssl = NoSSL
37− }
38−run :: HttpRequestM r -> IO (Response L.ByteString)
39−run (Free (Get url)) = get url
40−run (Free (GetSSL sslOpts url)) = getSSL sslOpts url
41−run (Free (Post url body)) = post url body
42−run (Free (PostSSL sslOpts url body)) = postSSL sslOpts url body
43−
44−constructUrl :: URL -> ApiVersion -> String -> URL
45−constructUrl url apiVersion endpoint = printf "%s%s%s" url apiVersion endpoint
46−
47−-- decodeResponse :: Response L.ByteString -> a
48−decodeResponse r = decode (r ^. responseBody)
49−
50−getElemFromResponse k r = (^? responseBody . key k . _String) r
51−
52−getResponseStatusCode r = (^. responseStatus) r
53−
54−
55−setupSSLCtx :: SSLOptions -> IO SSLContext
56−setupSSLCtx (SSLOptions key cert) = do
57− ctx <- SSL.context
58− SSL.contextSetPrivateKeyFile ctx key
59− SSL.contextSetCertificateFile ctx cert
60− SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3
61− SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2
62− return ctx
63−
64−
65−mkOpts c = defaults & manager .~ Left (opensslManagerSettings c)
66−
67−getSSL
68− :: SSLOptions
69− -> String
70− -> IO (Response L.ByteString)
71−getSSL sopts url = withOpenSSL $ getWith (mkOpts $ setupSSLCtx sopts) url
72−
73−postSSL
74− :: ToJSON a
75− => SSLOptions
76− -> String
77− -> a
78− -> IO (Response L.ByteString)
79−postSSL sopts url = withOpenSSL . postWith (mkOpts $ setupSSLCtx sopts) url . toJSON
80−
81−_dockerGetQuery :: DockerClientOpts -> Endpoint -> HttpRequestM Endpoint
82−_dockerGetQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint = Free (Get (fullUrl clientOpts endpoint))
83−_dockerGetQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint = Free (GetSSL sslOpts (fullUrl clientOpts endpoint))
84−
85−_dockerPostQuery :: ToJSON a => DockerClientOpts -> Endpoint -> a -> HttpRequestM Endpoint
86−_dockerPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint postObject = Free (Post (fullUrl clientOpts endpoint) (toJSON postObject))
87−_dockerPostQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint postObject = Free (PostSSL sslOpts (fullUrl clientOpts endpoint) (toJSON postObject))
88−
89−_dockerEmptyPostQuery :: DockerClientOpts -> Endpoint -> HttpRequestM Endpoint
90−_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint = Free (Post (fullUrl clientOpts endpoint) (toJSON emptyPost))
91−_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint = Free (PostSSL sslOpts (fullUrl clientOpts endpoint) (toJSON emptyPost))
92−
93−
94−_dockerEmptyDeleteQuery endpoint clientOpts = delete (fullUrl clientOpts endpoint)
95−
96getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion)
27getDockerVersion :: DockerClientOpts -> IO (Maybe DockerVersion)
97getDockerVersion clientOpts = decodeResponse <$> runDocker (getDockerVersionM clientOpts SVersionEndpoint)
28getDockerVersion clientOpts = decodeResponse <$> runDocker (getDockerVersionM clientOpts SVersionEndpoint)
98
29
@@ -131,10 +62,12 @@ deleteContainerWithOpts clientOpts deleteOpts cid = (^. responseStatus) <$>
131 runDocker (deleteContainerM clientOpts (SDeleteContainerEndpoint cid deleteOpts))
62 runDocker (deleteContainerM clientOpts (SDeleteContainerEndpoint cid deleteOpts))
132
63
133getContainerLogsWithOpts :: DockerClientOpts -> LogOpts -> String -> IO (L.ByteString)
64getContainerLogsWithOpts :: DockerClientOpts -> LogOpts -> String -> IO (L.ByteString)
65+getContainerLogsWithOpts clientOpts l cid = (^. responseBody) <$>
134−getContainerLogsWithOpts clientOpts l cid = (^. responseBody) <$> runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid l))
66+ runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid l))
135
67
136getContainerLogs :: DockerClientOpts -> String -> IO (L.ByteString)
68getContainerLogs :: DockerClientOpts -> String -> IO (L.ByteString)
69+getContainerLogs clientOpts cid = (^. responseBody) <$>
137−getContainerLogs clientOpts cid = (^. responseBody) <$> runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid defaultLogOpts))
70+ runDocker (getContainerLogsM clientOpts (SContainerLogsEndpoint cid defaultLogOpts))
138
71
139getContainerLogsStream :: DockerClientOpts -> String -> IO ()
72getContainerLogsStream :: DockerClientOpts -> String -> IO ()
140getContainerLogsStream clientOpts cid = do
73getContainerLogsStream clientOpts cid = do
Network/Docker/Internal.hs+51−21
@@ -5,25 +5,28 @@ module Network.Docker.Internal where
5
5
6import Control.Lens
6import Control.Lens
7import Control.Monad.Free
7import Control.Monad.Free
8−import Data.Aeson (FromJSON, ToJSON, Value, decode,
8+import Data.Aeson (FromJSON, ToJSON, Value, decode,
9− eitherDecode, toJSON)
9+ eitherDecode, toJSON)
10−import Data.Aeson.Lens (key, _String)
10+import Data.Aeson.Lens (key, _String)
11−import qualified Data.ByteString.Lazy as L
11+import qualified Data.ByteString.Lazy as L
12+import Network.HTTP.Client.OpenSSL
12import Network.Wreq
13import Network.Wreq
13−-- import Pipes
14+import OpenSSL (withOpenSSL)
14−-- import qualified Pipes.ByteString as PB
15+import OpenSSL.Session (SSLContext, context)
15−-- import qualified Pipes.HTTP as PH
16+import qualified OpenSSL.Session as SSL
16−import Text.Printf (printf)
17+import Text.Printf (printf)
17
18
18import Network.Docker.Types
19import Network.Docker.Types
19
20
20emptyPost = "" :: String
21emptyPost = "" :: String
21
22
22−
23runDocker :: HttpRequestM r -> IO (Response L.ByteString)
23runDocker :: HttpRequestM r -> IO (Response L.ByteString)
24runDocker (Free (Get url)) = get url
24runDocker (Free (Get url)) = get url
25+runDocker (Free (GetSSL sslOpts url)) = getSSL sslOpts url
25runDocker (Free (Post url body)) = post url body
26runDocker (Free (Post url body)) = post url body
27+runDocker (Free (PostSSL sslOpts url body)) = postSSL sslOpts url body
26runDocker (Free (Delete url)) = delete url
28runDocker (Free (Delete url)) = delete url
29+runDocker (Free (DeleteSSL sslOpts url)) = deleteSSL sslOpts url
27
30
28constructUrl :: URL -> ApiVersion -> String -> URL
31constructUrl :: URL -> ApiVersion -> String -> URL
29constructUrl url apiVersion endpoint = printf "%s%s%s" url apiVersion endpoint
32constructUrl url apiVersion endpoint = printf "%s%s%s" url apiVersion endpoint
@@ -51,20 +54,55 @@ getEndpoint (SContainerLogsEndpoint cid (LogOpts stdout stderr follow )) =
51getEndpoint (SDeleteContainerEndpoint cid (DeleteOpts removeVolumes force)) =
54getEndpoint (SDeleteContainerEndpoint cid (DeleteOpts removeVolumes force)) =
52 printf "/containers/%s?v=%s;force=%s" cid (show removeVolumes) (show force)
55 printf "/containers/%s?v=%s;force=%s" cid (show removeVolumes) (show force)
53
56
57+setupSSLCtx :: SSLOptions -> IO SSLContext
58+setupSSLCtx (SSLOptions key cert) = do
59+ ctx <- SSL.context
60+ SSL.contextSetPrivateKeyFile ctx key
61+ SSL.contextSetCertificateFile ctx cert
62+ SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3
63+ SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2
64+ return ctx
65+
66+mkOpts c = defaults & manager .~ Left (opensslManagerSettings c)
67+
68+getSSL
69+ :: SSLOptions
70+ -> String
71+ -> IO (Response L.ByteString)
72+getSSL sopts url = withOpenSSL $ getWith (mkOpts $ setupSSLCtx sopts) url
73+
74+postSSL
75+ :: ToJSON a
76+ => SSLOptions
77+ -> String
78+ -> a
79+ -> IO (Response L.ByteString)
80+postSSL sopts url = withOpenSSL . postWith (mkOpts $ setupSSLCtx sopts) url . toJSON
81+
82+deleteSSL
83+ :: SSLOptions
84+ -> String
85+ -> IO (Response L.ByteString)
86+deleteSSL sopts url = withOpenSSL $ deleteWith (mkOpts $ setupSSLCtx sopts) url
87+
54fullUrl :: DockerClientOpts -> SEndpoint a -> URL
88fullUrl :: DockerClientOpts -> SEndpoint a -> URL
55fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) (getEndpoint endpoint)
89fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) (getEndpoint endpoint)
56
90
57_dockerGetQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)
91_dockerGetQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)
58−_dockerGetQuery clientOpts endpoint = Free (Get (fullUrl clientOpts endpoint))
92+_dockerGetQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint = Free (Get (fullUrl clientOpts endpoint))
93+_dockerGetQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint = Free (GetSSL sslOpts (fullUrl clientOpts endpoint))
59
94
60_dockerPostQuery :: ToJSON b => DockerClientOpts -> SEndpoint a -> b -> HttpRequestM (SEndpoint a)
95_dockerPostQuery :: ToJSON b => DockerClientOpts -> SEndpoint a -> b -> HttpRequestM (SEndpoint a)
61−_dockerPostQuery clientOpts endpoint postObject = Free (Post (fullUrl clientOpts endpoint) (toJSON postObject))
96+_dockerPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint postObject = Free (Post (fullUrl clientOpts endpoint) (toJSON postObject))
97+_dockerPostQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint postObject = Free (PostSSL sslOpts (fullUrl clientOpts endpoint) (toJSON postObject))
62
98
63_dockerEmptyPostQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)
99_dockerEmptyPostQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)
64−_dockerEmptyPostQuery clientOpts endpoint = Free (Post (fullUrl clientOpts endpoint) (toJSON emptyPost))
100+_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint = Free (Post (fullUrl clientOpts endpoint) (toJSON emptyPost))
101+_dockerEmptyPostQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint = Free (PostSSL sslOpts (fullUrl clientOpts endpoint) (toJSON emptyPost))
65
102
66_dockerDeleteQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)
103_dockerDeleteQuery :: DockerClientOpts -> SEndpoint a -> HttpRequestM (SEndpoint a)
67−_dockerDeleteQuery clientOpts endpoint = Free $ Delete $ fullUrl clientOpts endpoint
104+_dockerDeleteQuery clientOpts@DockerClientOpts{ssl = NoSSL} endpoint = Free (Delete (fullUrl clientOpts endpoint))
105+_dockerDeleteQuery clientOpts@DockerClientOpts{ssl = SSL sslOpts} endpoint = Free (DeleteSSL sslOpts (fullUrl clientOpts endpoint))
68
106
69getDockerVersionM :: DockerClientOpts -> SEndpoint VersionEndpoint -> HttpRequestM (SEndpoint VersionEndpoint)
107getDockerVersionM :: DockerClientOpts -> SEndpoint VersionEndpoint -> HttpRequestM (SEndpoint VersionEndpoint)
70getDockerVersionM clientOpts e = _dockerGetQuery clientOpts e
108getDockerVersionM clientOpts e = _dockerGetQuery clientOpts e
@@ -102,11 +140,3 @@ deleteContainerM clientOpts e = _dockerDeleteQuery clientOpts e
102getContainerLogsM :: DockerClientOpts -> SEndpoint ContainerLogsEndpoint -> HttpRequestM (SEndpoint ContainerLogsEndpoint)
140getContainerLogsM :: DockerClientOpts -> SEndpoint ContainerLogsEndpoint -> HttpRequestM (SEndpoint ContainerLogsEndpoint)
103getContainerLogsM clientOpts e = _dockerGetQuery clientOpts e
141getContainerLogsM clientOpts e = _dockerGetQuery clientOpts e
104
142
105−-- getContainerLogsM :: DockerClientOpts -> SEndpoint ContainerLogsEndpoint -> Bool -> HttpRequestM (SEndpoint ContainerLogsEndpoint)
106−-- getContainerLogsM clientOpts e f = case f of
107−-- False -> _dockerGetQuery clientOpts e
108−-- True -> do
109−-- req <- PH.parseUrl ((fullUrl clientOpts e) ++ "&follow=1")
110−-- let req' = req {PH.method = "GET"}
111−-- PH.withManager PH.defaultManagerSettings $ \m -> PH.withHTTP req' m $ \resp -> runEffect $ PH.responseBody resp >-> PB.stdout
112−
Network/Docker/Types.hs+4−9
@@ -73,13 +73,17 @@ defaultClientOpts :: DockerClientOpts
73defaultClientOpts = DockerClientOpts
73defaultClientOpts = DockerClientOpts
74 { apiVersion = "v1.20"
74 { apiVersion = "v1.20"
75 , baseUrl = "http://127.0.0.1:2375/"
75 , baseUrl = "http://127.0.0.1:2375/"
76+ , ssl = NoSSL
76 }
77 }
77
78
78
79
79data HttpRequestF a =
80data HttpRequestF a =
80 Get URL
81 Get URL
82+ | GetSSL SSLOptions URL
81 | Post URL Value
83 | Post URL Value
84+ | PostSSL SSLOptions URL Value
82 | Delete URL
85 | Delete URL
86+ | DeleteSSL SSLOptions URL
83 deriving ( Functor, Show )
87 deriving ( Functor, Show )
84
88
85
89
@@ -215,11 +219,6 @@ instance ToJSON CreateContainerOpts where
215 , "ExposedPorts" .= _exposedPorts
219 , "ExposedPorts" .= _exposedPorts
216 ]
220 ]
217
221
218−-- data CreateContainerResponse = CreateContainerResponse
219−-- { _createdContainerId :: String
220−-- , _warnings :: Maybe [T.Text]
221−-- } deriving (Show)
222−
223data StartContainerOpts = StartContainerOpts
222data StartContainerOpts = StartContainerOpts
224 { _Binds :: [T.Text]
223 { _Binds :: [T.Text]
225 , _Links :: [T.Text]
224 , _Links :: [T.Text]
@@ -293,10 +292,6 @@ instance FromJSON DockerContainer where
293 <*> (v .: "Status")
292 <*> (v .: "Status")
294 <*> (v .:? "Ports")
293 <*> (v .:? "Ports")
295
294
296−-- instance FromJSON CreateContainerResponse where
297−-- parseJSON (Object v) =
298−-- CreateContainerResponse <$> (v .: "Id")
299−-- <*> (v .:? "warnings")
300
295
301instance ToJSON DockerVersion where
296instance ToJSON DockerVersion where
302 toJSON = genericToJSON defaultOptions {
297 toJSON = genericToJSON defaultOptions {
docker.cabal+1
@@ -37,6 +37,7 @@ library
37 , pipes-bytestring >= 2.1.0
37 , pipes-bytestring >= 2.1.0
38 , HsOpenSSL
38 , HsOpenSSL
39 , http-client-openssl
39 , http-client-openssl
40+ , free >= 4.9
40 -- hs-source-dirs:
41 -- hs-source-dirs:
41 default-language: Haskell2010
42 default-language: Haskell2010
42
43