kubernetes-client/haskell
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

First draft: Kube config loader

Browse Source 
I needed to move a few methods to TLSUtils due to circular dependencies,
this will of course break compatibility with previous versions. I will
re-export all the previous functions again.

Apart from that, there is a fair bit of code in here without any tests,
so next thing I will do is start adding unit tests to make sure the
basics are fine.

The OIDC and GCP Auth code is difficult to test at unit level, so we
may have to figure out some way to integration test those.

I noticed that the code has mixed indentation (2 spaces and 4 spaces),
all the new code in this commit is 2 space indented. I did not reindent
4 spaces lines for easier code review. We should do that after this work
is over.

[#2]
This commit is contained in:
Akshay Mankar
2019-07-16 03:10:39 +01:00
parent 01b367bb93
commit c90b1c03f8
10 changed files with 636 additions and 110 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
kubernetes-client/package.yaml
View File

@@ -13,6 +13,8 @@ license: Apache-2.0
license-file: LICENSE
library:
source-dirs: src
ghc-options:
- -Wall
tests:
spec:
main: Spec.hs
@@ -27,26 +29,41 @@ tests:
dependencies:
- kubernetes-client
extra-source-files:
- README.md
- test/testdata/*
- README.md
dependencies:
- base >=4.7 && <5.0
- base64-bytestring
- bytestring >=0.10.0 && <0.11
- aeson >=1.2.2 && <1.5
- attoparsec >=0.13.0.0 && <0.14
- jsonpath >=0.1.0.0 && <0.2
- connection >=0.2.8
- containers >= 0.6.0.1
- data-default-class >=0.1.2.0
- either
- filepath
- hoauth2
- http-client >=0.5 && <0.7
- http-client-tls >=0.3.5.3
- jwt
- kubernetes-client-core ==0.1.0.1
- microlens >=0.4.3 && <0.5
- mtl >=2.2.1
- oidc-client
- pem >=0.2.4
- safe-exceptions >=0.1.0.0
- stm
- streaming-bytestring >= 0.1.5 && < 0.2.0
- text >=0.11 && <1.3
- time
- timerep
- tls >=1.4.1
- typed-process
- uri-bytestring
- x509 >=1.7.5
- x509-system >=1.6.6
- x509-store >=1.6.7
- x509-validation >=1.6.11
- yaml

35
kubernetes-client/src/Kubernetes/Client/Auth/ClientCert.hs Normal file
View File

@@ -0,0 +1,35 @@
module Kubernetes.Client.Auth.ClientCert where
import Data.Text.Encoding
import Kubernetes.Client.Auth.Internal.Types
import Kubernetes.Client.Internal.TLSUtils
import Kubernetes.Client.KubeConfig
import Kubernetes.OpenAPI (KubernetesClientConfig (..))
import Network.TLS
-- | Detects if kuebconfig file provides 'client-certificate', if it configures TLS client params with the client certificate
clientCertFileAuth :: DetectAuth
clientCertFileAuth auth (tlsParams, cfg) = do
certFile <- clientCertificate auth
keyFile <- clientKey auth
return $ do
cert <- credentialLoadX509 certFile keyFile >>= either error return
let newParams = (setClientCert cert tlsParams)
newCfg = (disableValidateAuthMethods cfg)
return (newParams, newCfg)
-- | Detects if kuebconfig file provides 'client-certificate-data', if it configures TLS client params with the client certificate
clientCertDataAuth :: DetectAuth
clientCertDataAuth auth (tlsParams, cfg) = do
certB64 <- encodeUtf8 <$> clientCertificateData auth
keyB64 <- encodeUtf8 <$> clientKeyData auth
Just $ do
cert <- loadB64EncodedCert certB64 keyB64
let newParams = (setClientCert cert tlsParams)
newCfg = (disableValidateAuthMethods cfg)
return (newParams, newCfg)
-- |Disables the client-side auth methods validation. This is necessary if you are using client cert authentication.
disableValidateAuthMethods :: KubernetesClientConfig -> KubernetesClientConfig
disableValidateAuthMethods kcfg = kcfg { configValidateAuthMethods = False }

108
kubernetes-client/src/Kubernetes/Client/Auth/GCP.hs Normal file
View File

@@ -0,0 +1,108 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Kubernetes.Client.Auth.GCP
( gcpAuth )
where
import Control.Concurrent.STM
import Data.Bifunctor (first)
import Data.Either.Combinators
import Data.Function ((&))
import Data.JSONPath
import Data.Map (Map)
import Data.Text (Text)
import Data.Time.Clock
import Data.Time.LocalTime
import Data.Time.RFC3339
import Kubernetes.Client.Auth.Internal.Types
import Kubernetes.Client.KubeConfig
import Kubernetes.Data.K8sJSONPath
import Kubernetes.OpenAPI.Core
import System.Process.Typed
import qualified Data.Aeson as Aeson
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Lens.Micro as L
-- TODO: Add support for scopes based token fetching
data GCPAuth = GCPAuth { gcpAccessToken :: TVar(Maybe Text)
, gcpTokenExpiry :: TVar(Maybe UTCTime)
, gcpCmd :: ProcessConfig () () ()
, gcpTokenKey :: [K8sPathElement]
, gcpExpiryKey :: [K8sPathElement]
}
instance AuthMethod GCPAuth where
applyAuthMethod _ gcp req = do
token <- getToken gcp >>= exceptEither
pure
$ setHeader req [("Authorization", "Bearer " <> (Text.encodeUtf8 token))]
& L.set rAuthTypesL []
-- |Detects if auth-provier name is gcp, if it is configures the 'KubernetesClientConfig' with GCPAuth 'AuthMethod'
gcpAuth :: DetectAuth
gcpAuth AuthInfo{authProvider = Just(AuthProviderConfig "gcp" (Just cfg))} (tls, kubecfg)
= Just $ do
configOfErr <- parseGCPAuthInfo cfg
case configOfErr of
Left e -> error $ Text.unpack e
Right gcp -> pure (tls, addAuthMethod kubecfg gcp)
gcpAuth _ _ = Nothing
exceptEither :: Either Text a -> IO a
exceptEither (Right a) = pure a
exceptEither (Left t) = error (show t)
getToken :: GCPAuth -> IO (Either Text Text)
getToken g@(GCPAuth{..}) = getCurrentToken g
>>= maybe (fetchToken g) (return . Right)
getCurrentToken :: GCPAuth -> IO (Maybe Text)
getCurrentToken (GCPAuth{..}) = do
now <- getCurrentTime
maybeExpiry <- atomically $ readTVar gcpTokenExpiry
maybeToken <- atomically $ readTVar gcpAccessToken
return $ do
expiry <- maybeExpiry
if expiry > now
then maybeToken
else Nothing
-- TODO: log if parsed expiry is invalid
fetchToken :: GCPAuth -> IO (Either Text Text)
fetchToken GCPAuth{..} = do
(stdOut, _) <- readProcess_ gcpCmd
let credsJSON = Aeson.eitherDecode stdOut
& first Text.pack
token = runJSONPath gcpTokenKey =<< credsJSON
expText = runJSONPath gcpExpiryKey =<< credsJSON
expiry :: Either Text (Maybe UTCTime)
expiry = Just <$> (parseExpiryTime =<< expText)
atomically $ writeTVar gcpAccessToken (rightToMaybe token)
atomically $ writeTVar gcpTokenExpiry (either (const Nothing) id expiry)
return token
parseGCPAuthInfo :: Map Text Text -> IO (Either Text GCPAuth)
parseGCPAuthInfo m = do
gcpAccessToken <- atomically $ newTVar $ Map.lookup "access-token" m
case maybe (pure Nothing) ((Just <$>) . parseExpiryTime) $ Map.lookup "expiry" m of
(Left e) -> return $ Left e
Right t -> do
gcpTokenExpiry <- atomically $ newTVar t
return $ do
cmdPath <- Text.unpack <$> lookupEither m "cmd-path"
cmdArgs <- Text.splitOn " " <$> lookupEither m "cmd-args"
let gcpCmd = proc cmdPath (map Text.unpack cmdArgs)
gcpTokenKey = readJSONPath m "token-key" [JSONPath [KeyChild "token_expiry"]]
gcpExpiryKey = readJSONPath m "expiry-key" [JSONPath [KeyChild "access_token"]]
pure $ GCPAuth{..}
lookupEither :: (Show key, Ord key) => Map key val -> key -> Either Text val
lookupEither m k = maybeToRight e $ Map.lookup k m
where e = "Couldn't find key: " <> (Text.pack $ show k) <> " in GCP auth info"
parseExpiryTime :: Text -> Either Text UTCTime
parseExpiryTime s = zonedTimeToUTC <$> parseTimeRFC3339 s
& maybeToRight ("failed to parse token expiry time " <> s)

9
kubernetes-client/src/Kubernetes/Client/Auth/Internal/Types.hs Normal file
View File

@@ -0,0 +1,9 @@
module Kubernetes.Client.Auth.Internal.Types where
import Network.TLS as TLS
import Kubernetes.Client.KubeConfig
import Kubernetes.OpenAPI (KubernetesClientConfig)
type DetectAuth = AuthInfo
-> (TLS.ClientParams, KubernetesClientConfig)
-> Maybe (IO (TLS.ClientParams, KubernetesClientConfig))

168
kubernetes-client/src/Kubernetes/Client/Auth/OIDC.hs Normal file
View File

@@ -0,0 +1,168 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Kubernetes.Client.Auth.OIDC
(oidcAuth, OIDCCache, cachedOIDCAuth)
where
import Control.Applicative
import Control.Concurrent.STM
import Data.Either.Combinators
import Data.Function ((&))
import Data.Map (Map)
import Data.Maybe
import Data.Text
import Data.Time.Clock.POSIX (getPOSIXTime)
import Kubernetes.Client.Auth.Internal.Types
import Kubernetes.Client.Internal.TLSUtils
import Kubernetes.Client.KubeConfig
import Kubernetes.OpenAPI.Core
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.OAuth.OAuth2 as OAuth hiding (error)
import Network.TLS as TLS
import URI.ByteString
import Web.JWT as JWT
import Web.OIDC.Client.Discovery as OIDC
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Lens.Micro as L
data OIDCAuth = OIDCAuth { issuerURL :: Text
, clientID :: Text
, clientSecret :: Text
, tlsParams :: TLS.ClientParams
, idTokenMVar :: TVar(Maybe Text)
, refreshTokenMVar :: TVar(Maybe Text)
}
-- | Cache OIDCAuth based on issuerURL and clientID.
type OIDCCache = TVar (Map (Text, Text) OIDCAuth)
instance AuthMethod OIDCAuth where
applyAuthMethod _ oidc req = do
token <- getToken oidc
pure
$ setHeader req [("Authorization", "Bearer " <> (Text.encodeUtf8 token))]
& L.set rAuthTypesL []
-- TODO: Consider a token expired few seconds before actual expiry to account for time skew
getToken :: OIDCAuth -> IO Text
getToken o@(OIDCAuth{..}) = do
now <- getPOSIXTime
mgr <- newManager tlsManagerSettings
idToken <- atomically $ readTVar idTokenMVar
let maybeExp = idToken
& (>>= decode)
& (fmap claims)
& (>>= JWT.exp)
& (fmap secondsSinceEpoch)
isValidToken = fromMaybe False (fmap (now <) maybeExp)
if not isValidToken
then fetchToken mgr o
else return $ fromMaybe (error "impossible") idToken
fetchToken :: Manager -> OIDCAuth -> IO Text
fetchToken mgr o@(OIDCAuth{..}) = do
maybeToken <- atomically $ readTVar refreshTokenMVar
case maybeToken of
Nothing -> error "cannot refresh id-token without a refresh token"
Just token -> do
tokenEndpoint <- fetchTokenEndpoint mgr o
tokenURI <- exceptEither $ parseURI strictURIParserOptions (Text.encodeUtf8 tokenEndpoint)
let oauth = OAuth2{ oauthClientId = clientID
, oauthClientSecret = clientSecret
, oauthAccessTokenEndpoint = tokenURI
, oauthOAuthorizeEndpoint = tokenURI
, oauthCallback = Nothing
}
oauthToken <- refreshAccessToken mgr oauth (RefreshToken token)
>>= exceptEither
case OAuth.idToken oauthToken of
Nothing -> error "token response did not contain an id_token, either the scope \"openid\" wasn't requested upon login, or the provider doesn't support id_tokens as part of the refresh response."
Just (IdToken t) -> do
_ <- atomically $ writeTVar idTokenMVar (Just t)
return t
fetchTokenEndpoint :: Manager -> OIDCAuth -> IO Text
fetchTokenEndpoint mgr OIDCAuth{..} = do
discover issuerURL mgr
& (fmap configuration)
& (fmap tokenEndpoint)
exceptEither :: Show b => Either b a -> IO a
exceptEither (Right a) = pure a
exceptEither (Left t) = error (show t)
{-
Detects if auth-provier name is oidc, if it is configures the 'KubernetesClientConfig' with OIDCAuth 'AuthMethod'.
Does not use cache, consider using 'cachedOIDCAuth'.
-}
oidcAuth :: DetectAuth
oidcAuth AuthInfo{authProvider = Just(AuthProviderConfig "oidc" (Just cfg))} (tls, kubecfg)
= Just
$ parseOIDCAuthInfo cfg
>>= either error (\oidc -> pure (tls, addAuthMethod kubecfg oidc))
oidcAuth _ _ = Nothing
-- TODO: Consider doing this whole function atomically, as two threads may miss the cache simultaneously
{-
Detects if auth-provier name is oidc, if it is configures the 'KubernetesClientConfig' with OIDCAuth 'AuthMethod'.
First looks for Auth information to be present in 'OIDCCache'. If found returns that, otherwise creates new Auth information and persists it in cache.
-}
cachedOIDCAuth :: OIDCCache -> DetectAuth
cachedOIDCAuth cache AuthInfo{authProvider = Just(AuthProviderConfig "oidc" (Just cfg))} (tls, kubecfg) = Just $ do
m <- atomically $ readTVar cache
o <- case findInCache m cfg of
Left e -> error e
Right (Just o) -> return o
Right Nothing -> do
o@(OIDCAuth{..}) <- either error pure =<< parseOIDCAuthInfo cfg
let newCache = Map.insert (issuerURL, clientID) o m
_ <- atomically $ swapTVar cache newCache
return o
pure (tls, addAuthMethod kubecfg o)
cachedOIDCAuth _ _ _ = Nothing
findInCache :: Map (Text, Text) a -> Map Text Text -> Either String (Maybe a)
findInCache cache cfg = do
issuerURL <- lookupEither cfg "idp-issuer-url"
clientID <- lookupEither cfg "client-id"
return $ Map.lookup (issuerURL, clientID) cache
parseOIDCAuthInfo :: Map Text Text -> IO (Either String OIDCAuth)
parseOIDCAuthInfo m = do
eitherTLSParams <- parseCA m
idTokenMVar <- atomically $ newTVar $ Map.lookup "id-token" m
refreshTokenMVar <- atomically $ newTVar $ Map.lookup "refresh-token" m
return $ do
tlsParams <- eitherTLSParams
issuerURL <- lookupEither m "idp-issuer-url"
clientID <- lookupEither m "client-id"
clientSecret <- lookupEither m "client-secret"
return OIDCAuth{..}
parseCA :: Map Text Text -> IO (Either String TLS.ClientParams)
parseCA m = do
t <- defaultTLSClientParams
fromMaybe (pure $ pure t) (parseCAFile t m <|> parseCAData t m)
parseCAFile :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either String TLS.ClientParams))
parseCAFile t m = do
caFile <- Text.unpack <$> Map.lookup "idp-certificate-authority" m
return $ updateClientParams t <$> BS.readFile caFile
parseCAData :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either String TLS.ClientParams))
parseCAData t m = do
caText <- Map.lookup "idp-certificate-authority-data" m
pure . pure
$ (B64.decode $ Text.encodeUtf8 caText)
>>= updateClientParams t
lookupEither :: (Show key, Ord key) => Map key val -> key -> Either String val
lookupEither m k = maybeToRight e $ Map.lookup k m
where e = "Couldn't find key: " <> show k <> " in OIDC auth info"

35
kubernetes-client/src/Kubernetes/Client/Auth/Token.hs Normal file
View File

@@ -0,0 +1,35 @@
{-# LANGUAGE OverloadedStrings #-}
module Kubernetes.Client.Auth.Token where
import Kubernetes.Client.Auth.Internal.Types
import Kubernetes.Client.KubeConfig (AuthInfo (..))
import Kubernetes.OpenAPI.Core (AnyAuthMethod (..),
KubernetesClientConfig (..))
import Kubernetes.OpenAPI.Model (AuthApiKeyBearerToken (..))
import qualified Data.Text as T
import qualified Data.Text.IO as T
-- |Detects if token is specified in AuthConfig, if it is configures 'KubernetesClientConfig' with 'AuthApiKeyBearerToken'
tokenAuth :: DetectAuth
tokenAuth auth (tlsParams, cfg) = do
t <- token auth
return $ return (tlsParams, setTokenAuth t cfg)
-- |Detects if token-file is specified in AuthConfig, if it is configures 'KubernetesClientConfig' with 'AuthApiKeyBearerToken'
tokenFileAuth :: DetectAuth
tokenFileAuth auth (tlsParams, cfg) = do
file <- tokenFile auth
return $ do
t <- T.readFile file
return (tlsParams, setTokenAuth t cfg)
-- |Configures the 'KubernetesClientConfig' to use token authentication.
setTokenAuth
:: T.Text -- ^Authentication token
-> KubernetesClientConfig
-> KubernetesClientConfig
setTokenAuth t kcfg = kcfg
{ configAuthMethods = [AnyAuthMethod (AuthApiKeyBearerToken $ "Bearer " <> t)]
}

212
kubernetes-client/src/Kubernetes/Client/Config.hs
View File

@@ -1,126 +1,48 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
module Kubernetes.Client.Config where
import qualified Kubernetes.OpenAPI.Core as K
import qualified Kubernetes.OpenAPI.Model as K
import qualified Kubernetes.OpenAPI.Core as K
import Control.Exception.Safe (Exception, MonadThrow, throwM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LazyB
import Data.Default.Class (def)
import Data.Either (rights)
import Data.Monoid ((<>))
import Data.PEM (pemContent, pemParseBS)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import Data.Typeable (Typeable)
import Data.X509 (SignedCertificate,
decodeSignedCertificate)
import qualified Data.X509 as X509
import Data.X509.CertificateStore (CertificateStore, makeCertificateStore)
import qualified Data.X509.Validation as X509
import Lens.Micro (Lens', lens, set)
import Network.Connection (TLSSettings (..))
import qualified Network.HTTP.Client as NH
import Network.HTTP.Client.TLS (mkManagerSettings)
import Network.TLS (Credential, defaultParamsClient)
import qualified Network.TLS as TLS
import qualified Network.TLS.Extra as TLS
import System.Environment (getEnv)
import System.X509 (getSystemCertificateStore)
import Control.Applicative ((<|>))
import Control.Exception.Safe (MonadThrow, throwM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as LazyB
import Data.Either.Combinators
import Data.Function ((&))
import Data.Maybe
import Data.Monoid ((<>))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import Data.Yaml
import Kubernetes.Client.Auth.ClientCert
import Kubernetes.Client.Auth.GCP
import Kubernetes.Client.Auth.OIDC
import Kubernetes.Client.Auth.Token
import Kubernetes.Client.Internal.TLSUtils
import Kubernetes.Client.KubeConfig
import Network.Connection (TLSSettings (..))
import qualified Network.HTTP.Client as NH
import Network.HTTP.Client.TLS (mkManagerSettings)
import qualified Network.TLS as TLS
import System.Environment (getEnv)
import System.FilePath
-- |Sets the master URI in the 'K.KubernetesClientConfig'.
setMasterURI
:: T.Text -- ^ Master URI
-> K.KubernetesClientConfig
-> K.KubernetesClientConfig
setMasterURI server kcfg =
kcfg { K.configHost = (LazyB.fromStrict . T.encodeUtf8) server }
-- |Disables the client-side auth methods validation. This is necessary if you are using client cert authentication.
disableValidateAuthMethods :: K.KubernetesClientConfig -> K.KubernetesClientConfig
disableValidateAuthMethods kcfg = kcfg { K.configValidateAuthMethods = False }
-- |Configures the 'K.KubernetesClientConfig' to use token authentication.
setTokenAuth
:: T.Text -- ^Authentication token
-> K.KubernetesClientConfig
-> K.KubernetesClientConfig
setTokenAuth token kcfg = kcfg
{ K.configAuthMethods = [K.AnyAuthMethod (K.AuthApiKeyBearerToken $ "Bearer " <> token)]
}
setMasterURI masterURI kcfg =
kcfg { K.configHost = (LazyB.fromStrict . T.encodeUtf8) masterURI }
-- |Creates a 'NH.Manager' that can handle TLS.
newManager :: TLS.ClientParams -> IO NH.Manager
newManager cp = NH.newManager (mkManagerSettings (TLSSettings cp) Nothing)
-- |Default TLS settings using the system CA store.
defaultTLSClientParams :: IO TLS.ClientParams
defaultTLSClientParams = do
let defParams = defaultParamsClient "" ""
systemCAStore <- getSystemCertificateStore
return defParams
{ TLS.clientSupported = def
{ TLS.supportedCiphers = TLS.ciphersuite_strong
}
, TLS.clientShared = (TLS.clientShared defParams)
{ TLS.sharedCAStore = systemCAStore
}
}
clientHooksL :: Lens' TLS.ClientParams TLS.ClientHooks
clientHooksL = lens TLS.clientHooks (\cp ch -> cp { TLS.clientHooks = ch })
onServerCertificateL :: Lens' TLS.ClientParams (CertificateStore -> TLS.ValidationCache -> X509.ServiceID -> X509.CertificateChain -> IO [X509.FailedReason])
onServerCertificateL =
clientHooksL . lens TLS.onServerCertificate (\ch osc -> ch { TLS.onServerCertificate = osc })
-- |Don't check whether the cert presented by the server matches the name of the server you are connecting to.
-- This is necessary if you specify the server host by its IP address.
disableServerNameValidation :: TLS.ClientParams -> TLS.ClientParams
disableServerNameValidation =
set onServerCertificateL (X509.validate X509.HashSHA256 def (def { X509.checkFQHN = False }))
-- |Insecure mode. The client will not validate the server cert at all.
disableServerCertValidation :: TLS.ClientParams -> TLS.ClientParams
disableServerCertValidation = set onServerCertificateL (\_ _ _ _ -> return [])
-- |Use a custom CA store.
setCAStore :: [SignedCertificate] -> TLS.ClientParams -> TLS.ClientParams
setCAStore certs cp = cp
{ TLS.clientShared = (TLS.clientShared cp)
{ TLS.sharedCAStore = (makeCertificateStore certs)
}
}
onCertificateRequestL :: Lens' TLS.ClientParams (([TLS.CertificateType], Maybe [TLS.HashAndSignatureAlgorithm], [X509.DistinguishedName]) -> IO (Maybe (X509.CertificateChain, TLS.PrivKey)))
onCertificateRequestL =
clientHooksL . lens TLS.onCertificateRequest (\ch ocr -> ch { TLS.onCertificateRequest = ocr })
-- |Use a client cert for authentication.
setClientCert :: Credential -> TLS.ClientParams -> TLS.ClientParams
setClientCert cred = set onCertificateRequestL (\_ -> return $ Just cred)
-- |Parses a PEM-encoded @ByteString@ into a list of certificates.
parsePEMCerts :: B.ByteString -> Either String [SignedCertificate]
parsePEMCerts b = do
pems <- pemParseBS b
return $ rights $ map (decodeSignedCertificate . pemContent) pems
data ParsePEMCertsException = ParsePEMCertsException String deriving (Typeable, Show)
instance Exception ParsePEMCertsException
-- |Loads certificates from a PEM-encoded file.
loadPEMCerts :: (MonadIO m, MonadThrow m) => FilePath -> m [SignedCertificate]
loadPEMCerts p = do
liftIO (B.readFile p)
>>= either (throwM . ParsePEMCertsException) return
. parsePEMCerts
serviceAccountDir :: FilePath
serviceAccountDir = "/var/run/secrets/kubernetes.io/serviceaccount"
@@ -132,5 +54,75 @@ cluster = do
tok <- liftIO . T.readFile $ serviceAccountDir ++ "/token"
host <- liftIO $ getEnv "KUBERNETES_SERVICE_HOST"
port <- liftIO $ getEnv "KUBERNETES_SERVICE_PORT"
config <- setTokenAuth tok . setMasterURI (T.pack $ "https://" ++ host ++ ":" ++ port) <$> liftIO K.newConfig
return (mgr, config)
cfg <- setTokenAuth tok . setMasterURI (T.pack $ "https://" ++ host ++ ":" ++ port) <$> liftIO K.newConfig
return (mgr, cfg)
data KubeConfigSource = KubeConfigFile FilePath
| KubeConfigCluster
kubeClient
:: OIDCCache
-> KubeConfigSource
-> IO (NH.Manager, K.KubernetesClientConfig)
kubeClient oidcCache (KubeConfigFile f) = do
kubeConfigFile <- decodeFileThrow f
uri <- getCluster kubeConfigFile
& fmap server
& either (const $ pure "localhost:8080") return
t <- defaultTLSClientParams
& fmap (tlsValidation kubeConfigFile)
& (>>= (addCACertData kubeConfigFile))
& (>>= addCACertFile kubeConfigFile (takeDirectory f))
c <- K.newConfig & fmap (setMasterURI uri)
(tlsParams, cfg) <-
case getAuthInfo kubeConfigFile of
Left _ -> return (t,c)
Right (_, auth)-> applyAuthSettings oidcCache auth (t, c)
mgr <- newManager tlsParams
return (mgr, cfg)
kubeClient _ (KubeConfigCluster) = Kubernetes.Client.Config.cluster
tlsValidation :: Config -> TLS.ClientParams -> TLS.ClientParams
tlsValidation cfg t = case getCluster cfg of
Left _ -> t
Right c -> case insecureSkipTLSVerify c of
Just True -> disableServerCertValidation t
_ -> t
addCACertData :: (MonadThrow m) => Config -> TLS.ClientParams -> m TLS.ClientParams
addCACertData cfg t =
let eitherCertText = getCluster cfg
& (>>= (maybeToRight "cert data not provided" . certificateAuthorityData))
in case eitherCertText of
Left _ -> pure t
Right certText ->
(B64.decode $ T.encodeUtf8 certText)
>>= updateClientParams t
& either (throwM . ParsePEMCertsException) return
addCACertFile :: Config -> FilePath -> TLS.ClientParams -> IO TLS.ClientParams
addCACertFile cfg dir t = do
let certFile = getCluster cfg
>>= maybeToRight "cert file not provided" . certificateAuthority
& fmap T.unpack
& fmap (dir </>)
case certFile of
Left _ -> return t
Right f -> do
certText <- B.readFile f
return
$ updateClientParams t certText
& (fromRight t)
applyAuthSettings
:: OIDCCache
-> AuthInfo
-> (TLS.ClientParams, K.KubernetesClientConfig)
-> IO (TLS.ClientParams, K.KubernetesClientConfig)
applyAuthSettings oidcCache auth input = fromMaybe (pure input)
$ clientCertFileAuth auth input
<|> clientCertDataAuth auth input
<|> tokenAuth auth input
<|> tokenFileAuth auth input
<|> gcpAuth auth input
<|> cachedOIDCAuth oidcCache auth input

102
kubernetes-client/src/Kubernetes/Client/Internal/TLSUtils.hs Normal file
View File

@@ -0,0 +1,102 @@
{-# LANGUAGE OverloadedStrings #-}
module Kubernetes.Client.Internal.TLSUtils where
import Control.Exception.Safe (Exception, MonadThrow, throwM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString (ByteString)
import Data.Default.Class (def)
import Data.Either (rights)
import Data.Function ((&))
import Data.PEM (pemContent, pemParseBS)
import Data.Typeable (Typeable)
import Data.X509 (SignedCertificate, decodeSignedCertificate)
import Data.X509.CertificateStore (CertificateStore, makeCertificateStore)
import Lens.Micro
import Network.TLS (Credential, defaultParamsClient)
import Network.TLS
import System.X509 (getSystemCertificateStore)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.X509 as X509
import qualified Data.X509.Validation as X509
import qualified Network.TLS as TLS
import qualified Network.TLS.Extra as TLS
-- |Default TLS settings using the system CA store.
defaultTLSClientParams :: IO TLS.ClientParams
defaultTLSClientParams = do
let defParams = defaultParamsClient "" ""
systemCAStore <- getSystemCertificateStore
return defParams
{ TLS.clientSupported = def
{ TLS.supportedCiphers = TLS.ciphersuite_strong
}
, TLS.clientShared = (TLS.clientShared defParams)
{ TLS.sharedCAStore = systemCAStore
}
}
-- |Parses a PEM-encoded @ByteString@ into a list of certificates.
parsePEMCerts :: B.ByteString -> Either String [SignedCertificate]
parsePEMCerts b = do
pems <- pemParseBS b
return $ rights $ map (decodeSignedCertificate . pemContent) pems
updateClientParams :: TLS.ClientParams -> ByteString -> Either String TLS.ClientParams
updateClientParams cp certText = parsePEMCerts certText
& (fmap (flip setCAStore cp))
-- |Use a custom CA store.
setCAStore :: [SignedCertificate] -> TLS.ClientParams -> TLS.ClientParams
setCAStore certs cp = cp
{ TLS.clientShared = (TLS.clientShared cp)
{ TLS.sharedCAStore = (makeCertificateStore certs)
}
}
-- |Use a client cert for authentication.
setClientCert :: Credential -> TLS.ClientParams -> TLS.ClientParams
setClientCert cred = set onCertificateRequestL (\_ -> return $ Just cred)
clientHooksL :: Lens' TLS.ClientParams TLS.ClientHooks
clientHooksL = lens TLS.clientHooks (\cp ch -> cp { TLS.clientHooks = ch })
onServerCertificateL :: Lens' TLS.ClientParams (CertificateStore -> TLS.ValidationCache -> X509.ServiceID -> X509.CertificateChain -> IO [X509.FailedReason])
onServerCertificateL =
clientHooksL . lens TLS.onServerCertificate (\ch osc -> ch { TLS.onServerCertificate = osc })
-- |Don't check whether the cert presented by the server matches the name of the server you are connecting to.
-- This is necessary if you specify the server host by its IP address.
disableServerNameValidation :: TLS.ClientParams -> TLS.ClientParams
disableServerNameValidation =
set onServerCertificateL (X509.validate X509.HashSHA256 def (def { X509.checkFQHN = False }))
-- |Insecure mode. The client will not validate the server cert at all.
disableServerCertValidation :: TLS.ClientParams -> TLS.ClientParams
disableServerCertValidation = set onServerCertificateL (\_ _ _ _ -> return [])
onCertificateRequestL :: Lens' TLS.ClientParams (([TLS.CertificateType], Maybe [TLS.HashAndSignatureAlgorithm], [X509.DistinguishedName]) -> IO (Maybe (X509.CertificateChain, TLS.PrivKey)))
onCertificateRequestL =
clientHooksL . lens TLS.onCertificateRequest (\ch ocr -> ch { TLS.onCertificateRequest = ocr })
data ParsePEMCertsException = ParsePEMCertsException String deriving (Typeable, Show)
instance Exception ParsePEMCertsException
-- |Loads certificates from a PEM-encoded file.
loadPEMCerts :: (MonadIO m, MonadThrow m) => FilePath -> m [SignedCertificate]
loadPEMCerts p = do
liftIO (B.readFile p)
>>= throwLeft
. parsePEMCerts
-- |Loads Base64 encoded certificate and private key
loadB64EncodedCert :: (MonadThrow m) => B.ByteString -> B.ByteString -> m Credential
loadB64EncodedCert certB64 keyB64 = throwLeft $ do
certText <- B64.decode certB64
keyText <- B64.decode keyB64
credentialLoadX509FromMemory certText keyText
throwLeft :: (MonadThrow m) => Either String a -> m a
throwLeft = either (throwM . ParsePEMCertsException) return

57
kubernetes-client/src/Kubernetes/Data/K8sJSONPath.hs Normal file
View File

@@ -0,0 +1,57 @@
{-# LANGUAGE OverloadedStrings #-}
module Kubernetes.Data.K8sJSONPath where
import Data.Aeson
import Data.Aeson.Text
import Data.JSONPath
import Data.Map as Map
import Data.Text as Text
import Control.Applicative ((<|>))
import Data.Attoparsec.Text
import Data.Bifunctor (bimap)
import Data.String (IsString)
import Data.Text.Lazy (toStrict)
data K8sPathElement = PlainText Text
| JSONPath [JSONPathElement]
deriving (Show, Eq)
k8sJSONPath :: Parser [K8sPathElement]
k8sJSONPath = many1 pathElementParser
pathElementParser :: Parser K8sPathElement
pathElementParser = curlsParser <|> plainTextParser
plainTextParser :: Parser K8sPathElement
plainTextParser = PlainText <$> takeWhile1 (/= '{')
curlsParser :: Parser K8sPathElement
curlsParser = JSONPath <$> (char '{' *> jsonPath <* char '}')
runJSONPath :: [K8sPathElement] -> Value -> Either Text Text
runJSONPath [] _ = pure ""
runJSONPath (e:es) v = do
res <- runPathElement e v
rest <- runJSONPath es v
pure $ res <> rest
runPathElement :: K8sPathElement -> Value -> Either Text Text
runPathElement (PlainText t) _ = pure t
runPathElement (JSONPath p) v = encodeResult $ executeJSONPath p v
readJSONPath :: Map Text Text -> Text -> [K8sPathElement] -> [K8sPathElement]
readJSONPath m key def = case Map.lookup key m of
Nothing -> def
Just str -> case parseOnly (k8sJSONPath <* endOfInput) str of
Left e -> error e
Right p -> p
encodeResult :: ExecutionResult Value -> Either Text Text
encodeResult (ResultValue val) = return $ jsonToText val
encodeResult (ResultList vals) = return $ (intercalate " " $ Prelude.map jsonToText vals)
encodeResult (ResultError err) = Left $ pack err
jsonToText :: Value -> Text
jsonToText (String t) = t
jsonToText x = toStrict $ encodeToLazyText x

3
stack.yaml
View File

@@ -1,5 +1,8 @@
resolver: lts-13.9
extra-deps:
- jsonpath-0.1.0.1
- jwt-0.10.0
- oidc-client-0.4.0.0
- katip-0.8.0.0
packages:
- kubernetes