diff --git a/Network/Docker.hs b/Network/Docker.hs --- a/Network/Docker.hs +++ b/Network/Docker.hs @@ -2,28 +2,33 @@ module Network.Docker where -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative ((<$>), (<*>)) import Control.Lens -import Data.Aeson (FromJSON, ToJSON, decode, eitherDecode, - toJSON) -import Data.Aeson.Lens (key, _String) +import Data.Aeson (FromJSON, ToJSON, decode, + eitherDecode, toJSON) +import Data.Aeson.Lens (key, _String) import Data.Aeson.TH -import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy as L import Data.Char -import qualified Data.Text as T +import qualified Data.Text as T import Network.Docker.Options import Network.Docker.Types +import Network.HTTP.Client.OpenSSL import Network.Wreq +import OpenSSL (withOpenSSL) +import OpenSSL.Session (SSLContext, context) +import qualified OpenSSL.Session as SSL import Pipes -import qualified Pipes.ByteString as PB -import qualified Pipes.HTTP as PH -import Text.Printf (printf) +import qualified Pipes.ByteString as PB +import qualified Pipes.HTTP as PH +import Text.Printf (printf) defaultClientOpts :: DockerClientOpts defaultClientOpts = DockerClientOpts { apiVersion = "v1.12" , baseUrl = "http://127.0.0.1:3128/" + , ssl = NoSSL } constructUrl :: URL -> ApiVersion -> Endpoint -> URL @@ -40,11 +45,43 @@ fullUrl :: DockerClientOpts -> Endpoint -> URL fullUrl clientOpts endpoint = constructUrl (baseUrl clientOpts) (apiVersion clientOpts) endpoint +setupSSLCtx :: SSLOptions -> IO SSLContext +setupSSLCtx (SSLOptions key cert) = do + ctx <- SSL.context + SSL.contextSetPrivateKeyFile ctx key + SSL.contextSetCertificateFile ctx cert + SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3 + SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2 + return ctx + + +mkOpts c = defaults & manager .~ Left (opensslManagerSettings c) + +getSSL + :: SSLOptions + -> String + -> IO (Response L.ByteString) +getSSL sopts url = withOpenSSL $ getWith (mkOpts $ setupSSLCtx sopts) url + +postSSL + :: ToJSON a + => SSLOptions + -> String + -> a + -> IO (Response L.ByteString) +postSSL sopts url = withOpenSSL . postWith (mkOpts $ setupSSLCtx sopts) url . toJSON + _dockerGetQuery :: Endpoint -> DockerClientOpts -> IO(Response L.ByteString) -_dockerGetQuery endpoint clientOpts = get (fullUrl clientOpts endpoint) +_dockerGetQuery endpoint clientOpts@DockerClientOpts{ssl = NoSSL} = + get (fullUrl clientOpts endpoint) +_dockerGetQuery endpoint clientOpts@DockerClientOpts{ssl = SSL sslOpts} = + getSSL sslOpts (fullUrl clientOpts endpoint) _dockerPostQuery :: ToJSON a => Endpoint -> DockerClientOpts -> a -> IO (Response L.ByteString) -_dockerPostQuery endpoint clientOpts postObject = post (fullUrl clientOpts endpoint) (toJSON postObject) +_dockerPostQuery endpoint clientOpts@DockerClientOpts{ssl = NoSSL} postObject = + post (fullUrl clientOpts endpoint) (toJSON postObject) +_dockerPostQuery endpoint clientOpts@DockerClientOpts{ssl = SSL sslOpts} postObject = + postSSL sslOpts (fullUrl clientOpts endpoint) postObject emptyPost = "" :: String _dockerEmptyPostQuery endpoint clientOpts = post (fullUrl clientOpts endpoint) (toJSON emptyPost) diff --git a/Network/Docker/Types.hs b/Network/Docker/Types.hs --- a/Network/Docker/Types.hs +++ b/Network/Docker/Types.hs @@ -6,10 +6,8 @@ module Network.Docker.Types where -import Prelude hiding(id) import Control.Applicative import Control.Lens.TH -import Control.Lens.TH import Data.Aeson import Data.Aeson.TH import Data.Bool @@ -20,7 +18,8 @@ import GHC.Generics import Network.Docker.Options import Network.Wreq.Types (Postable) - +import OpenSSL.Session (SSLContext) +import Prelude hiding (id) type URL = String type ApiVersion = String @@ -31,10 +30,19 @@ type Port = Int type PortType = String +data SSL = NoSSL | SSL SSLOptions deriving Show + data DockerClientOpts = DockerClientOpts { apiVersion :: ApiVersion , baseUrl :: URL + , ssl :: SSL } deriving (Show) + + +data SSLOptions = SSLOptions { + optionsKey :: FilePath + , optionsCert :: FilePath + } deriving Show data ResourceId = ResourceId { _id :: String } deriving (Show, Eq) diff --git a/docker.cabal b/docker.cabal --- a/docker.cabal +++ b/docker.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: docker -version: 0.2.0.2 +version: 0.2.0.3 synopsis: Haskell wrapper for Docker Remote API -- description: homepage: https://github.com/denibertovic/docker-hs @@ -35,6 +35,8 @@ , pipes >= 4.1.2 , pipes-text >= 0.0.0.12 , pipes-bytestring >= 2.1.0 + , HsOpenSSL + , http-client-openssl -- hs-source-dirs: default-language: Haskell2010 @@ -59,6 +61,8 @@ , tasty-hunit >= 0.8 , process , http-types + , HsOpenSSL + , http-client-openssl type: exitcode-stdio-1.0 main-is: tests.hs hs-source-dirs: tests diff --git a/tests/tests.hs b/tests/tests.hs --- a/tests/tests.hs +++ b/tests/tests.hs @@ -1,21 +1,21 @@ module Main where -import Network.Docker -import Network.Docker.Types +import Network.Docker +import Network.Docker.Types -import Test.Tasty -import Test.Tasty.HUnit -import qualified Test.Tasty.QuickCheck as QC -import qualified Test.QuickCheck.Monadic as QCM +import qualified Test.QuickCheck.Monadic as QCM +import Test.Tasty +import Test.Tasty.HUnit +import qualified Test.Tasty.QuickCheck as QC -import Data.Maybe (isJust, fromJust) -import System.Process (system) -import Data.Text (unpack) -import Control.Concurrent (threadDelay) -import Network.HTTP.Types.Status -import qualified Data.ByteString.Char8 as C -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL +import Control.Concurrent (threadDelay) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as BL +import Data.Maybe (fromJust, isJust) +import Data.Text (unpack) +import Network.HTTP.Types.Status +import System.Process (system) opts = defaultClientOpts { baseUrl = "http://127.0.0.1:2375/" }