Created
January 23, 2017 15:10
-
-
Save kseo/419fab10885c1f80b651da5b2eedff78 to your computer and use it in GitHub Desktop.
Docker API: SSL authentication
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE NamedFieldPuns #-} | |
import Control.Monad (when) | |
import qualified Data.ByteString.Char8 as BSC | |
import Data.Default.Class (def) | |
import Data.Monoid ((<>)) | |
import System.IO.Error (ioError, userError) | |
import Data.X509 (CertificateChain (..), HashALG(..)) | |
import Data.X509.CertificateStore (makeCertificateStore) | |
import Data.X509.File (readKeyFile, readSignedObject) | |
import Data.X509.Validation (validate, defaultChecks, defaultHooks, ValidationHooks(..)) | |
import System.X509 (getSystemCertificateStore) | |
import qualified Network.Socket as S | |
import Network.Connection (TLSSettings(TLSSettings)) | |
import Network.HTTP.Client (parseRequest, httpLbs, responseStatus, responseBody, | |
Manager, newManager, defaultManagerSettings, managerRawConnection) | |
import Network.HTTP.Client.Internal (makeConnection) | |
import Network.HTTP.Client.TLS (mkManagerSettings) | |
import Network.HTTP.Types.Status (statusCode) | |
import Network.TLS (ClientHooks (..), ClientParams (..), Shared (..), Supported (..), defaultParamsClient) | |
import Network.TLS.Extra (ciphersuite_strong) | |
newSSLAuthManager :: String -> Int -> FilePath -> FilePath -> FilePath -> IO Manager | |
newSSLAuthManager host port privKey cert ca = do | |
paramsE <- clientParamsWithClientAuth host (fromIntegral port) privKey cert | |
params <- clientParamsSetCA paramsE ca | |
let mSettings = mkManagerSettings (TLSSettings params) Nothing | |
newManager mSettings | |
clientParamsWithClientAuth :: S.HostName -> S.PortNumber -> FilePath -> FilePath -> IO ClientParams | |
clientParamsWithClientAuth host port keyFile certificateFile = do | |
cert <- readSignedObject certificateFile | |
keys <- readKeyFile keyFile | |
when (null keys) $ ioError (userError ("Could not read key file: " ++ keyFile)) | |
let key = head keys | |
onCertificateRequest = const . return $ Just (CertificateChain cert, key) | |
onServerCertificate = validate HashSHA256 (def { hookValidateName = \_ _ -> [] }) def | |
clientParams = (defaultParamsClient host $ BSC.pack (show port)) | |
{ clientHooks = def { onCertificateRequest, onServerCertificate } | |
, clientSupported = def { supportedCiphers = ciphersuite_strong } | |
} | |
return clientParams | |
clientParamsSetCA :: ClientParams -> FilePath -> IO ClientParams | |
clientParamsSetCA params path = do | |
userStore <- makeCertificateStore <$> readSignedObject path | |
systemStore <- getSystemCertificateStore | |
let store = userStore <> systemStore | |
let oldShared = clientShared params | |
return params { clientShared = oldShared { sharedCAStore = store } } | |
main :: IO () | |
main = do | |
manager <- newManager defaultManagerSettings | |
manager <- newSSLAuthManager "192.168.99.100" | |
2376 | |
"/Users/kseo/.docker/machine/machines/kodebox/key.pem" | |
"/Users/kseo/.docker/machine/machines/kodebox/cert.pem" | |
"/Users/kseo/.docker/machine/machines/kodebox/ca.pem" | |
request <- parseRequest "https://192.168.99.100:2376/v1.25/version" | |
response <- httpLbs request manager | |
putStrLn $ "The status code was: " ++ (show $ statusCode $ responseStatus response) | |
print $ responseBody response |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment