git.iko.soy/docker-hs
on master help sign in
add SSL capability
23cb5f1Alex Babkin
Network/Docker.hs+39−2
compare with master
unifiedsplit
@@ -18,12 +18,17 @@ import Pipes
18import qualified Pipes.ByteString as PB
18import qualified Pipes.ByteString as PB
19import qualified Pipes.HTTP as PH
19import qualified Pipes.HTTP as PH
20import Text.Printf (printf)
20import Text.Printf (printf)
21+import Network.HTTP.Client.OpenSSL
22+import OpenSSL (withOpenSSL)
23+import OpenSSL.Session (SSLContext, context)
24+import qualified OpenSSL.Session as SSL
21
25
22
26
23defaultClientOpts :: DockerClientOpts
27defaultClientOpts :: DockerClientOpts
24defaultClientOpts = DockerClientOpts
28defaultClientOpts = DockerClientOpts
25 { apiVersion = "v1.12"
29 { apiVersion = "v1.12"
26 , baseUrl = "http://127.0.0.1:3128/"
30 , baseUrl = "http://127.0.0.1:3128/"
31+ , ssl = NoSSL
27 }
32 }
28
33
29constructUrl :: URL -> ApiVersion -> Endpoint -> URL
34constructUrl :: URL -> ApiVersion -> Endpoint -> URL
@@ -40,11 +45,43 @@ getResponseStatusCode r = (^. responseStatus) r
40fullUrl :: DockerClientOpts -> Endpoint -> URL
45fullUrl :: DockerClientOpts -> Endpoint -> URL
41fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) endpoint
46fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) endpoint
42
47
48+setupSSLCtx :: SSLOptions -> IO SSLContext
49+setupSSLCtx (SSLOptions key cert) = do
50+ ctx <- SSL.context
51+ SSL.contextSetPrivateKeyFile ctx key
52+ SSL.contextSetCertificateFile ctx cert
53+ SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3
54+ SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2
55+ return ctx
56+
57+
58+mkOpts c = defaults & manager .~ Left (opensslManagerSettings c)
59+
60+getSSL
61+ :: SSLOptions
62+ -> String
63+ -> IO (Response L.ByteString)
64+getSSL sopts url = withOpenSSL $ getWith (mkOpts $ setupSSLCtx sopts) url
65+
66+postSSL
67+ :: ToJSON a
68+ => SSLOptions
69+ -> String
70+ -> a
71+ -> IO (Response L.ByteString)
72+postSSL sopts url = withOpenSSL . postWith (mkOpts $ setupSSLCtx sopts) url . toJSON
73+
43_dockerGetQuery :: Endpoint -> DockerClientOpts -> IO(Response L.ByteString)
74_dockerGetQuery :: Endpoint -> DockerClientOpts -> IO(Response L.ByteString)
75+_dockerGetQuery endpoint clientOpts@DockerClientOpts{ssl = NoSSL} =
44−_dockerGetQuery endpoint clientOpts = get (fullUrl clientOpts endpoint)
76+ get (fullUrl clientOpts endpoint)
77+_dockerGetQuery endpoint clientOpts@DockerClientOpts{ssl = SSL sslOpts} =
78+ getSSL sslOpts (fullUrl clientOpts endpoint)
45
79
46_dockerPostQuery :: ToJSON a => Endpoint -> DockerClientOpts -> a -> IO (Response L.ByteString)
80_dockerPostQuery :: ToJSON a => Endpoint -> DockerClientOpts -> a -> IO (Response L.ByteString)
81+_dockerPostQuery endpoint clientOpts@DockerClientOpts{ssl = NoSSL} postObject =
47−_dockerPostQuery endpoint clientOpts postObject = post (fullUrl clientOpts endpoint) (toJSON postObject)
82+ post (fullUrl clientOpts endpoint) (toJSON postObject)
83+_dockerPostQuery endpoint clientOpts@DockerClientOpts{ssl = SSL sslOpts} postObject =
84+ postSSL sslOpts (fullUrl clientOpts endpoint) postObject
48
85
49emptyPost = "" :: String
86emptyPost = "" :: String
50_dockerEmptyPostQuery endpoint clientOpts = post (fullUrl clientOpts endpoint) (toJSON emptyPost)
87_dockerEmptyPostQuery endpoint clientOpts = post (fullUrl clientOpts endpoint) (toJSON emptyPost)
Network/Docker/Types.hs+10−1
@@ -20,7 +20,7 @@ import qualified Data.Text as T
20import GHC.Generics
20import GHC.Generics
21import Network.Docker.Options
21import Network.Docker.Options
22import Network.Wreq.Types (Postable)
22import Network.Wreq.Types (Postable)
23−
23+import OpenSSL.Session (SSLContext)
24
24
25type URL = String
25type URL = String
26type ApiVersion = String
26type ApiVersion = String
@@ -31,12 +31,21 @@ type IP = String
31type Port = Int
31type Port = Int
32type PortType = String
32type PortType = String
33
33
34+data SSL = NoSSL | SSL SSLOptions deriving Show
35+
34data DockerClientOpts = DockerClientOpts {
36data DockerClientOpts = DockerClientOpts {
35 apiVersion :: ApiVersion
37 apiVersion :: ApiVersion
36 , baseUrl :: URL
38 , baseUrl :: URL
39+ , ssl :: SSL
37 } deriving (Show)
40 } deriving (Show)
38
41
39
42
43+data SSLOptions = SSLOptions {
44+ optionsClientCert :: FilePath
45+ , optionsCaCert :: FilePath
46+ } deriving Show
47+
48+
40data ResourceId = ResourceId { _id :: String } deriving (Show, Eq)
49data ResourceId = ResourceId { _id :: String } deriving (Show, Eq)
41
50
42
51
docker.cabal+4
@@ -35,6 +35,8 @@ library
35 , pipes >= 4.1.2
35 , pipes >= 4.1.2
36 , pipes-text >= 0.0.0.12
36 , pipes-text >= 0.0.0.12
37 , pipes-bytestring >= 2.1.0
37 , pipes-bytestring >= 2.1.0
38+ , HsOpenSSL
39+ , http-client-openssl
38 -- hs-source-dirs:
40 -- hs-source-dirs:
39 default-language: Haskell2010
41 default-language: Haskell2010
40
42
@@ -59,6 +61,8 @@ test-suite tests
59 , tasty-hunit >= 0.8
61 , tasty-hunit >= 0.8
60 , process
62 , process
61 , http-types
63 , http-types
64+ , HsOpenSSL
65+ , http-client-openssl
62 type: exitcode-stdio-1.0
66 type: exitcode-stdio-1.0
63 main-is: tests.hs
67 main-is: tests.hs
64 hs-source-dirs: tests
68 hs-source-dirs: tests