|
| 1 | +{-# LANGUAGE OverloadedStrings #-} |
| 2 | + |
| 3 | +module Kubernetes.ClientHelper where |
| 4 | + |
| 5 | +import qualified Kubernetes.Core as K |
| 6 | +import qualified Kubernetes.Model as K |
| 7 | + |
| 8 | +import Control.Exception.Safe (Exception, MonadThrow, throwM) |
| 9 | +import Control.Monad.IO.Class (MonadIO, liftIO) |
| 10 | +import qualified Data.ByteString as B |
| 11 | +import qualified Data.ByteString.Lazy as LazyB |
| 12 | +import Data.Default.Class (def) |
| 13 | +import Data.Either (rights) |
| 14 | +import Data.PEM (pemContent, pemParseBS) |
| 15 | +import qualified Data.Text as T |
| 16 | +import qualified Data.Text.Encoding as T |
| 17 | +import Data.Typeable (Typeable) |
| 18 | +import Data.X509 (SignedCertificate, |
| 19 | + decodeSignedCertificate) |
| 20 | +import qualified Data.X509 as X509 |
| 21 | +import Data.X509.CertificateStore (makeCertificateStore) |
| 22 | +import qualified Data.X509.Validation as X509 |
| 23 | +import Network.Connection (TLSSettings (..)) |
| 24 | +import qualified Network.HTTP.Client as NH |
| 25 | +import Network.HTTP.Client.TLS (mkManagerSettings) |
| 26 | +import Network.TLS (Credential, defaultParamsClient) |
| 27 | +import qualified Network.TLS as TLS |
| 28 | +import qualified Network.TLS.Extra as TLS |
| 29 | +import System.X509 (getSystemCertificateStore) |
| 30 | + |
| 31 | +-- |Sets the master URI in the 'K.KubernetesConfig'. |
| 32 | +setMasterURI |
| 33 | + :: T.Text -- ^ Master URI |
| 34 | + -> K.KubernetesConfig |
| 35 | + -> K.KubernetesConfig |
| 36 | +setMasterURI server kcfg = |
| 37 | + kcfg { K.configHost = (LazyB.fromStrict . T.encodeUtf8) server } |
| 38 | + |
| 39 | +-- |Disables the client-side auth methods validation. This is necessary if you are using client cert authentication. |
| 40 | +disableValidateAuthMethods :: K.KubernetesConfig -> K.KubernetesConfig |
| 41 | +disableValidateAuthMethods kcfg = kcfg { K.configValidateAuthMethods = False } |
| 42 | + |
| 43 | +-- |Configures the 'K.KubernetesConfig' to use token authentication. |
| 44 | +setTokenAuth |
| 45 | + :: T.Text -- ^Authentication token |
| 46 | + -> K.KubernetesConfig |
| 47 | + -> K.KubernetesConfig |
| 48 | +setTokenAuth token kcfg = kcfg |
| 49 | + { K.configAuthMethods = [K.AnyAuthMethod (K.AuthApiKeyBearerToken token)] |
| 50 | + } |
| 51 | + |
| 52 | +-- |Creates a 'NH.Manager' that can handle TLS. |
| 53 | +newManager :: TLS.ClientParams -> IO NH.Manager |
| 54 | +newManager cp = NH.newManager (mkManagerSettings (TLSSettings cp) Nothing) |
| 55 | + |
| 56 | +-- |Default TLS settings using the system CA store. |
| 57 | +defaultTLSClientParams :: IO TLS.ClientParams |
| 58 | +defaultTLSClientParams = do |
| 59 | + let defParams = defaultParamsClient "" "" |
| 60 | + systemCAStore <- getSystemCertificateStore |
| 61 | + return defParams |
| 62 | + { TLS.clientSupported = def |
| 63 | + { TLS.supportedCiphers = TLS.ciphersuite_strong |
| 64 | + } |
| 65 | + , TLS.clientShared = (TLS.clientShared defParams) |
| 66 | + { TLS.sharedCAStore = systemCAStore |
| 67 | + } |
| 68 | + } |
| 69 | + |
| 70 | +-- |Don't check whether the cert presented by the server matches the name of the server you are connecting to. |
| 71 | +-- This is necessary if you specify the server host by its IP address. |
| 72 | +disableServerNameValidation :: TLS.ClientParams -> TLS.ClientParams |
| 73 | +disableServerNameValidation cp = cp |
| 74 | + { TLS.clientHooks = (TLS.clientHooks cp) |
| 75 | + { TLS.onServerCertificate = X509.validate |
| 76 | + X509.HashSHA256 |
| 77 | + def |
| 78 | + def { X509.checkFQHN = False } |
| 79 | + } |
| 80 | + } |
| 81 | + |
| 82 | +-- |Insecure mode. The client will not validate the server cert at all. |
| 83 | +disableServerCertValidation :: TLS.ClientParams -> TLS.ClientParams |
| 84 | +disableServerCertValidation cp = cp |
| 85 | + { TLS.clientHooks = (TLS.clientHooks cp) |
| 86 | + { TLS.onServerCertificate = (\_ _ _ _ -> return []) |
| 87 | + } |
| 88 | + } |
| 89 | + |
| 90 | +-- |Use a custom CA store. |
| 91 | +setCAStore :: [SignedCertificate] -> TLS.ClientParams -> TLS.ClientParams |
| 92 | +setCAStore certs cp = cp |
| 93 | + { TLS.clientShared = (TLS.clientShared cp) |
| 94 | + { TLS.sharedCAStore = (makeCertificateStore certs) |
| 95 | + } |
| 96 | + } |
| 97 | + |
| 98 | +-- |Use a client cert for authentication. |
| 99 | +setClientCert :: Credential -> TLS.ClientParams -> TLS.ClientParams |
| 100 | +setClientCert cred cp = cp |
| 101 | + { TLS.clientHooks = (TLS.clientHooks cp) |
| 102 | + { TLS.onCertificateRequest = (\_ -> return (Just cred)) |
| 103 | + } |
| 104 | + } |
| 105 | + |
| 106 | +-- |Parses a PEM-encoded @ByteString@ into a list of certificates. |
| 107 | +parsePEMCerts :: B.ByteString -> Either String [SignedCertificate] |
| 108 | +parsePEMCerts b = do |
| 109 | + pems <- pemParseBS b |
| 110 | + return $ rights $ map (decodeSignedCertificate . pemContent) pems |
| 111 | + |
| 112 | +data ParsePEMCertsException = ParsePEMCertsException String deriving (Typeable, Show) |
| 113 | + |
| 114 | +instance Exception ParsePEMCertsException |
| 115 | + |
| 116 | +-- |Loads certificates from a PEM-encoded file. |
| 117 | +loadPEMCerts :: (MonadIO m, MonadThrow m) => FilePath -> m [SignedCertificate] |
| 118 | +loadPEMCerts p = do |
| 119 | + liftIO (B.readFile p) |
| 120 | + >>= either (throwM . ParsePEMCertsException) return |
| 121 | + . parsePEMCerts |
0 commit comments