git.iko.soy/docker-hs
on master help sign in
Merge pull request #4 from ababkin/master

Add SSL capability

commit086623d5425bfad5e397ce773fb9fdf2d6be3d75 authorDeni Bertovic <deni@denibertovic.com> dateMon 19 Oct 2015, 16:39 (11 years ago) parent33a3cbc6facc9d
3 files changed+53−4
compare with master
unifiedsplit
Network/Docker.hs+39−2 Network/Docker/Types.hs+10−2 docker.cabal+4
Network/Docker.hs+39−2
@@ -18,12 +18,17 @@ import Pipes
1818import qualified Pipes.ByteString as PB
1919import qualified Pipes.HTTP as PH
2020import 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
2125
2226
2327defaultClientOpts :: DockerClientOpts
2428defaultClientOpts = DockerClientOpts
2529 { apiVersion = "v1.12"
2630 , baseUrl = "http://127.0.0.1:3128/"
31+ , ssl = NoSSL
2732 }
2833
2934constructUrl :: URL -> ApiVersion -> Endpoint -> URL
@@ -40,11 +45,43 @@ getResponseStatusCode r = (^. responseStatus) r
4045fullUrl :: DockerClientOpts -> Endpoint -> URL
4146fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) endpoint
4247
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+
4374_dockerGetQuery :: Endpoint -> DockerClientOpts -> IO(Response L.ByteString)
44−_dockerGetQuery endpoint clientOpts = get (fullUrl clientOpts endpoint)
75+_dockerGetQuery endpoint clientOpts@DockerClientOpts{ssl = NoSSL} =
76+ get (fullUrl clientOpts endpoint)
77+_dockerGetQuery endpoint clientOpts@DockerClientOpts{ssl = SSL sslOpts} =
78+ getSSL sslOpts (fullUrl clientOpts endpoint)
4579
4680_dockerPostQuery :: ToJSON a => Endpoint -> DockerClientOpts -> a -> IO (Response L.ByteString)
47−_dockerPostQuery endpoint clientOpts postObject = post (fullUrl clientOpts endpoint) (toJSON postObject)
81+_dockerPostQuery endpoint clientOpts@DockerClientOpts{ssl = NoSSL} postObject =
82+ post (fullUrl clientOpts endpoint) (toJSON postObject)
83+_dockerPostQuery endpoint clientOpts@DockerClientOpts{ssl = SSL sslOpts} postObject =
84+ postSSL sslOpts (fullUrl clientOpts endpoint) postObject
4885
4986emptyPost = "" :: String
5087_dockerEmptyPostQuery endpoint clientOpts = post (fullUrl clientOpts endpoint) (toJSON emptyPost)
Network/Docker/Types.hs+10−2
@@ -9,7 +9,6 @@ module Network.Docker.Types where
99import Prelude hiding(id)
1010import Control.Applicative
1111import Control.Lens.TH
12−import Control.Lens.TH
1312import Data.Aeson
1413import Data.Aeson.TH
1514import Data.Bool
@@ -20,7 +19,7 @@ import qualified Data.Text as T
2019import GHC.Generics
2120import Network.Docker.Options
2221import Network.Wreq.Types (Postable)
23−
22+import OpenSSL.Session (SSLContext)
2423
2524type URL = String
2625type ApiVersion = String
@@ -31,12 +30,21 @@ type IP = String
3130type Port = Int
3231type PortType = String
3332
33+data SSL = NoSSL | SSL SSLOptions deriving Show
34+
3435data DockerClientOpts = DockerClientOpts {
3536 apiVersion :: ApiVersion
3637 , baseUrl :: URL
38+ , ssl :: SSL
3739 } deriving (Show)
3840
3941
42+data SSLOptions = SSLOptions {
43+ optionsKey :: FilePath
44+ , optionsCert :: FilePath
45+ } deriving Show
46+
47+
4048data ResourceId = ResourceId { _id :: String } deriving (Show, Eq)
4149
4250
docker.cabal+4
@@ -35,6 +35,8 @@ library
3535 , pipes >= 4.1.2
3636 , pipes-text >= 0.0.0.12
3737 , pipes-bytestring >= 2.1.0
38+ , HsOpenSSL
39+ , http-client-openssl
3840 -- hs-source-dirs:
3941 default-language: Haskell2010
4042
@@ -59,6 +61,8 @@ test-suite tests
5961 , tasty-hunit >= 0.8
6062 , process
6163 , http-types
64+ , HsOpenSSL
65+ , http-client-openssl
6266 type: exitcode-stdio-1.0
6367 main-is: tests.hs
6468 hs-source-dirs: tests