diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,6 +2,52 @@ ## Example +### Load KubeConfig file + +```haskell +import Control.Concurrent.STM (atomically, newTVar) +import Kubernetes.Client (KubeConfigSource (..), mkKubeClientConfig) +import Kubernetes.OpenAPI (Accept (..), MimeJSON (..), dispatchMime) + +import qualified Data.Map as Map +import qualified Kubernetes.OpenAPI.API.CoreV1 as CoreV1 + +main :: IO () +main = do + oidcCache <- atomically $ newTVar $ Map.fromList [] + (mgr, kcfg) <- mkKubeClientConfig oidcCache $ KubeConfigFile "/path/to/kubeconfig" + dispatchMime + mgr + kcfg + (CoreV1.listPodForAllNamespaces (Accept MimeJSON)) + >>= print +``` + +### Load InCluster Config + +```haskell +import Control.Concurrent.STM (atomically, newTVar) +import Data.Function ((&)) +import Kubernetes.Client (KubeConfigSource (..), mkKubeClientConfig) +import Kubernetes.OpenAPI (Accept (..), MimeJSON (..), dispatchMime) +import Network.TLS (credentialLoadX509) + +import qualified Data.Map as Map +import qualified Kubernetes.OpenAPI.API.CoreV1 as CoreV1 + +main :: IO () +main = do + oidcCache <- atomically $ newTVar $ Map.fromList [] + (mgr, kcfg) <- mkKubeClientConfig oidcCache KubeConfigCluster + dispatchMime + mgr + kcfg + (CoreV1.listPodForAllNamespaces (Accept MimeJSON)) + >>= print +``` + +### Load config from URL and paths + ```haskell {-# LANGUAGE OverloadedStrings #-} diff --git a/example/App.hs b/example/App.hs --- a/example/App.hs +++ b/example/App.hs @@ -2,18 +2,20 @@ module Main where -import Data.Function ((&)) -import Kubernetes.Client (defaultTLSClientParams, - disableServerCertValidation, - disableServerNameValidation, - disableValidateAuthMethods, - loadPEMCerts, newManager, - setCAStore, setClientCert, - setMasterURI, setTokenAuth) -import Kubernetes.OpenAPI (Accept (..), MimeJSON (..), - dispatchMime, newConfig) +import Control.Concurrent.STM (atomically, newTVar) +import Data.Function ((&)) +import Kubernetes.Client (KubeConfigSource (..), defaultTLSClientParams, + disableServerCertValidation, + disableServerNameValidation, + disableValidateAuthMethods, mkKubeClientConfig, + loadPEMCerts, newManager, setCAStore, + setClientCert, setMasterURI, setTokenAuth) +import Kubernetes.OpenAPI (Accept (..), MimeJSON (..), dispatchMime, + newConfig) +import Network.TLS (credentialLoadX509) + +import qualified Data.Map as Map import qualified Kubernetes.OpenAPI.API.CoreV1 as CoreV1 -import Network.TLS (credentialLoadX509) example :: IO () example = do @@ -38,6 +40,26 @@ manager <- newManager tlsParams dispatchMime manager + kcfg + (CoreV1.listPodForAllNamespaces (Accept MimeJSON)) + >>= print + +exampleWithKubeConfig :: IO () +exampleWithKubeConfig = do + oidcCache <- atomically $ newTVar $ Map.fromList [] + (mgr, kcfg) <- mkKubeClientConfig oidcCache $ KubeConfigFile "/path/to/kubeconfig" + dispatchMime + mgr + kcfg + (CoreV1.listPodForAllNamespaces (Accept MimeJSON)) + >>= print + +exampleWithInClusterConfig :: IO () +exampleWithInClusterConfig = do + oidcCache <- atomically $ newTVar $ Map.fromList [] + (mgr, kcfg) <- mkKubeClientConfig oidcCache KubeConfigCluster + dispatchMime + mgr kcfg (CoreV1.listPodForAllNamespaces (Accept MimeJSON)) >>= print diff --git a/kubernetes-client.cabal b/kubernetes-client.cabal --- a/kubernetes-client.cabal +++ b/kubernetes-client.cabal @@ -1,111 +1,174 @@ -cabal-version: 1.12 -name: kubernetes-client -version: 0.1.0.1 -license: Apache-2.0 -license-file: LICENSE -maintainer: Shimin Guo , - Akshay Mankar -synopsis: Client library for Kubernetes +cabal-version: 1.12 +name: kubernetes-client +version: 0.2.0.0 +license: Apache-2.0 +license-file: LICENSE +maintainer: + Shimin Guo , + Akshay Mankar + +synopsis: Client library for Kubernetes description: Client library for interacting with a Kubernetes cluster. . This package contains hand-written code while kubernetes-client-core contains code auto-generated from the OpenAPI spec. -category: Web -build-type: Simple + +category: Web +build-type: Simple extra-source-files: + test/testdata/certs/certificate.pem + test/testdata/certs/private-key.pem test/testdata/kubeconfig.yaml + test/testdata/tokens/token1 + test/testdata/tokens/token2 README.md library exposed-modules: Kubernetes.Client + Kubernetes.Client.Auth.ClientCert + Kubernetes.Client.Auth.GCP + Kubernetes.Client.Auth.Internal.Types + Kubernetes.Client.Auth.OIDC + Kubernetes.Client.Auth.Token + Kubernetes.Client.Auth.TokenFile Kubernetes.Client.Config + Kubernetes.Client.Internal.TLSUtils Kubernetes.Client.KubeConfig Kubernetes.Client.Watch - hs-source-dirs: src - other-modules: - Paths_kubernetes_client + Kubernetes.Data.K8sJSONPath + + hs-source-dirs: src + other-modules: Paths_kubernetes_client default-language: Haskell2010 + ghc-options: -Wall build-depends: - aeson >=1.2.2 && <1.5, + aeson >=1.2 && <1.5, + attoparsec ==0.13.*, base >=4.7 && <5.0, - bytestring >=0.10.0 && <0.11, - connection >=0.2.8 && <0.3, - containers >=0.6.0.1 && <0.7, - data-default-class >=0.1.2.0 && <0.2, + base64-bytestring >=1.0.0.2 && <1.1, + bytestring ==0.10.*, + connection >=0.2 && <0.4, + containers >=0.5 && <0.7, + data-default-class ==0.1.*, + either ==5.0.*, + filepath ==1.4.*, + hoauth2 ==1.8.*, http-client >=0.5 && <0.7, - http-client-tls >=0.3.5.3 && <0.4, - kubernetes-client-core ==0.1.0.1, - microlens >=0.4.3 && <0.5, - mtl >=2.2.1 && <2.3, - pem >=0.2.4 && <0.3, + http-client-tls ==0.3.*, + jose-jwt ==0.8.*, + jsonpath ==0.1.*, + kubernetes-client-core ==0.2.0.0, + microlens ==0.4.*, + mtl ==2.2.*, + oidc-client ==0.4.*, + pem ==0.2.*, safe-exceptions >=0.1.0.0 && <0.2, - streaming-bytestring >=0.1.5 && <0.2.0, + stm >=2.4 && <2.6, + streaming-bytestring >=0.1 && <0.2.0, text >=0.11 && <1.3, + time ==1.8.*, + timerep ==2.0.*, tls >=1.4.1 && <1.5, - x509 >=1.7.5 && <1.8, - x509-store >=1.6.7 && <1.7, - x509-system >=1.6.6 && <1.7, - x509-validation >=1.6.11 && <1.7 + typed-process ==0.2.*, + uri-bytestring ==0.3.*, + x509 ==1.7.*, + x509-store ==1.6.*, + x509-system ==1.6.*, + x509-validation ==1.6.*, + yaml >=0.8.32 && <0.12 test-suite example - type: exitcode-stdio-1.0 - main-is: App.hs - hs-source-dirs: example - other-modules: - Paths_kubernetes_client + type: exitcode-stdio-1.0 + main-is: App.hs + hs-source-dirs: example + other-modules: Paths_kubernetes_client default-language: Haskell2010 build-depends: - aeson >=1.2.2 && <1.5, + aeson >=1.2 && <1.5, + attoparsec ==0.13.*, base >=4.7 && <5.0, - bytestring >=0.10.0 && <0.11, - connection >=0.2.8 && <0.3, - containers >=0.6.0.1 && <0.7, - data-default-class >=0.1.2.0 && <0.2, + base64-bytestring >=1.0.0.2 && <1.1, + bytestring ==0.10.*, + connection >=0.2 && <0.4, + containers >=0.5 && <0.7, + data-default-class ==0.1.*, + either ==5.0.*, + filepath ==1.4.*, + hoauth2 ==1.8.*, http-client >=0.5 && <0.7, - http-client-tls >=0.3.5.3 && <0.4, + http-client-tls ==0.3.*, + jose-jwt ==0.8.*, + jsonpath ==0.1.*, kubernetes-client -any, - kubernetes-client-core ==0.1.0.1, - microlens >=0.4.3 && <0.5, - mtl >=2.2.1 && <2.3, - pem >=0.2.4 && <0.3, + kubernetes-client-core ==0.2.0.0, + microlens ==0.4.*, + mtl ==2.2.*, + oidc-client ==0.4.*, + pem ==0.2.*, safe-exceptions >=0.1.0.0 && <0.2, - streaming-bytestring >=0.1.5 && <0.2.0, + stm >=2.4 && <2.6, + streaming-bytestring >=0.1 && <0.2.0, text >=0.11 && <1.3, + time ==1.8.*, + timerep ==2.0.*, tls >=1.4.1 && <1.5, - x509 >=1.7.5 && <1.8, - x509-store >=1.6.7 && <1.7, - x509-system >=1.6.6 && <1.7, - x509-validation >=1.6.11 && <1.7 + typed-process ==0.2.*, + uri-bytestring ==0.3.*, + x509 ==1.7.*, + x509-store ==1.6.*, + x509-system ==1.6.*, + x509-validation ==1.6.*, + yaml >=0.8.32 && <0.12 test-suite spec - type: exitcode-stdio-1.0 - main-is: Spec.hs - hs-source-dirs: test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test other-modules: + Kubernetes.Client.Auth.ClientCertSpec + Kubernetes.Client.Auth.TokenFileSpec + Kubernetes.Client.KubeConfigSpec + Kubernetes.Data.K8sJSONPathSpec Paths_kubernetes_client + default-language: Haskell2010 build-depends: - aeson >=1.2.2 && <1.5, + aeson >=1.2 && <1.5, + attoparsec ==0.13.*, base >=4.7 && <5.0, - bytestring >=0.10.0 && <0.11, - connection >=0.2.8 && <0.3, - containers >=0.6.0.1 && <0.7, - data-default-class >=0.1.2.0 && <0.2, - hspec >=2.6.1 && <2.7, + base64-bytestring >=1.0.0.2 && <1.1, + bytestring ==0.10.*, + connection >=0.2 && <0.4, + containers >=0.5 && <0.7, + data-default-class ==0.1.*, + either ==5.0.*, + file-embed >=0.0.11 && <0.1, + filepath ==1.4.*, + hoauth2 ==1.8.*, + hspec >=2.7.1 && <2.8, + hspec-attoparsec >=0.1.0.2 && <0.2, http-client >=0.5 && <0.7, - http-client-tls >=0.3.5.3 && <0.4, + http-client-tls ==0.3.*, + jose-jwt ==0.8.*, + jsonpath ==0.1.*, kubernetes-client -any, - kubernetes-client-core ==0.1.0.1, - microlens >=0.4.3 && <0.5, - mtl >=2.2.1 && <2.3, - pem >=0.2.4 && <0.3, + kubernetes-client-core ==0.2.0.0, + microlens ==0.4.*, + mtl ==2.2.*, + oidc-client ==0.4.*, + pem ==0.2.*, safe-exceptions >=0.1.0.0 && <0.2, - streaming-bytestring >=0.1.5 && <0.2.0, + stm >=2.4 && <2.6, + streaming-bytestring >=0.1 && <0.2.0, text >=0.11 && <1.3, + time ==1.8.*, + timerep ==2.0.*, tls >=1.4.1 && <1.5, - x509 >=1.7.5 && <1.8, - x509-store >=1.6.7 && <1.7, - x509-system >=1.6.6 && <1.7, - x509-validation >=1.6.11 && <1.7, - yaml >=0.11.0.0 && <0.12 + typed-process ==0.2.*, + uri-bytestring ==0.3.*, + x509 ==1.7.*, + x509-store ==1.6.*, + x509-system ==1.6.*, + x509-validation ==1.6.*, + yaml >=0.11.1.2 && <0.12 diff --git a/src/Kubernetes/Client/Auth/ClientCert.hs b/src/Kubernetes/Client/Auth/ClientCert.hs new file mode 100644 --- /dev/null +++ b/src/Kubernetes/Client/Auth/ClientCert.hs @@ -0,0 +1,41 @@ +module Kubernetes.Client.Auth.ClientCert where + +import Control.Exception.Safe (Exception, throwM) +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 (throwM . CredentialLoadException) 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 } + +data CredentialLoadException = CredentialLoadException String + deriving Show + +instance Exception CredentialLoadException diff --git a/src/Kubernetes/Client/Auth/GCP.hs b/src/Kubernetes/Client/Auth/GCP.hs new file mode 100644 --- /dev/null +++ b/src/Kubernetes/Client/Auth/GCP.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Kubernetes.Client.Auth.GCP + ( gcpAuth ) +where + +import Control.Concurrent.STM +import Control.Exception.Safe (Exception, throwM) +import Data.Attoparsec.Text +import Data.Either.Combinators +import Data.Function ((&)) +import Data.JSONPath +import Data.Map (Map) +import Data.Monoid ((<>)) +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 + >>= either throwM pure + 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))} (tlsParams, kubecfg) + = Just $ do + configOrErr <- parseGCPAuthInfo cfg + case configOrErr of + Left err -> throwM err + Right gcp -> pure (tlsParams, addAuthMethod kubecfg gcp) +gcpAuth _ _ = Nothing + +data GCPAuthParsingException = GCPAuthMissingInformation String + | GCPAuthInvalidExpiry String + | GCPAuthInvalidTokenJSONPath String + | GCPAuthInvalidExpiryJSONPath String + deriving Show +instance Exception GCPAuthParsingException + +data GCPGetTokenException = GCPCmdProducedInvalidJSON String + | GCPTokenNotFound String + | GCPTokenExpiryNotFound String + | GCPTokenExpiryInvalid String + deriving Show +instance Exception GCPGetTokenException + +getToken :: GCPAuth -> IO (Either GCPGetTokenException Text) +getToken auth@(GCPAuth{..}) = getCurrentToken auth + >>= maybe (fetchToken auth) (return . Right) + +getCurrentToken :: GCPAuth -> IO (Maybe Text) +getCurrentToken (GCPAuth{..}) = do + now <- getCurrentTime + maybeExpiry <- readTVarIO gcpTokenExpiry + maybeToken <- readTVarIO gcpAccessToken + return $ do + expiry <- maybeExpiry + if expiry > now + then maybeToken + else Nothing + +fetchToken :: GCPAuth -> IO (Either GCPGetTokenException Text) +fetchToken GCPAuth{..} = do + (stdOut, _) <- readProcess_ gcpCmd + case parseTokenAndExpiry stdOut of + Left err -> return $ Left err + Right (token, expiry) -> do + atomically $ do + writeTVar gcpAccessToken (Just token) + writeTVar gcpTokenExpiry (Just expiry) + return $ Right token + where + parseTokenAndExpiry credsStr = do + credsJSON <- Aeson.eitherDecode credsStr + & mapLeft GCPCmdProducedInvalidJSON + token <- runJSONPath gcpTokenKey credsJSON + & mapLeft GCPTokenNotFound + expText <- runJSONPath gcpExpiryKey credsJSON + & mapLeft GCPTokenExpiryNotFound + expiry <- parseExpiryTime expText + & mapLeft GCPTokenExpiryInvalid + return (token, expiry) + +parseGCPAuthInfo :: Map Text Text -> IO (Either GCPAuthParsingException GCPAuth) +parseGCPAuthInfo authInfo = do + gcpAccessToken <- atomically $ newTVar $ Map.lookup "access-token" authInfo + eitherGCPExpiryToken <- sequence $ fmap (atomically . newTVar) lookupAndParseExpiry + return $ do + gcpTokenExpiry <- mapLeft GCPAuthInvalidExpiry eitherGCPExpiryToken + cmdPath <- Text.unpack <$> lookupEither "cmd-path" + cmdArgs <- Text.splitOn " " <$> lookupEither "cmd-args" + gcpTokenKey <- readJSONPath "token-key" [JSONPath [KeyChild "token_expiry"]] + & mapLeft GCPAuthInvalidTokenJSONPath + gcpExpiryKey <- readJSONPath "expiry-key" [JSONPath [KeyChild "access_token"]] + & mapLeft GCPAuthInvalidExpiryJSONPath + let gcpCmd = proc cmdPath (map Text.unpack cmdArgs) + pure $ GCPAuth{..} + where + lookupAndParseExpiry = + case Map.lookup "expiry" authInfo of + Nothing -> Right Nothing + Just expiryText -> Just <$> parseExpiryTime expiryText + lookupEither key = Map.lookup key authInfo + & maybeToRight (GCPAuthMissingInformation $ Text.unpack key) + parseK8sJSONPath = parseOnly (k8sJSONPath <* endOfInput) + readJSONPath key defaultPath = + maybe (Right defaultPath) parseK8sJSONPath $ Map.lookup key authInfo + +parseExpiryTime :: Text -> Either String UTCTime +parseExpiryTime expiryText = + zonedTimeToUTC <$> parseTimeRFC3339 expiryText + & maybeToRight ("failed to parse token expiry time " <> Text.unpack expiryText) diff --git a/src/Kubernetes/Client/Auth/Internal/Types.hs b/src/Kubernetes/Client/Auth/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/Kubernetes/Client/Auth/Internal/Types.hs @@ -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)) diff --git a/src/Kubernetes/Client/Auth/OIDC.hs b/src/Kubernetes/Client/Auth/OIDC.hs new file mode 100644 --- /dev/null +++ b/src/Kubernetes/Client/Auth/OIDC.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Kubernetes.Client.Auth.OIDC + (oidcAuth, OIDCCache, cachedOIDCAuth) +where + +import Control.Applicative +import Control.Concurrent.STM +import Control.Exception.Safe (Exception, throwM) +import Data.Either.Combinators +import Data.Function ((&)) +import Data.Map (Map) +import Data.Maybe +import Data.Monoid ((<>)) +import Data.Text +import Data.Time.Clock.POSIX (getPOSIXTime) +import Jose.Jwt +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 +import Network.TLS as TLS +import URI.ByteString +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 +import qualified Network.OAuth.OAuth2.TokenRequest as OAuth2TokenRequest + +data OIDCAuth = OIDCAuth { issuerURL :: Text + , clientID :: Text + , clientSecret :: Text + , tlsParams :: TLS.ClientParams + , idTokenTVar :: TVar(Maybe Text) + , refreshTokenTVar :: 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 [] + +data OIDCGetTokenException = OIDCOAuthException (OAuth2Error OAuth2TokenRequest.Errors) + | OIDCURIException URIParseError + | OIDCGetTokenException String + deriving Show +instance Exception OIDCGetTokenException + +data OIDCAuthParsingException = OIDCAuthCAParsingFailed ParseCertException + | OIDCAuthMissingInformation String + deriving Show +instance Exception OIDCAuthParsingException + +-- TODO: Consider a token expired few seconds before actual expiry to account for time skew +getToken :: OIDCAuth -> IO Text +getToken auth@(OIDCAuth{..}) = do + now <- getPOSIXTime + maybeIdToken <- readTVarIO idTokenTVar + case maybeIdToken of + Nothing -> fetchToken auth + Just idToken -> do + let maybeExpiry = do + (_, claims) <- decodeClaims (Text.encodeUtf8 idToken) + & rightToMaybe + jwtExp claims + case maybeExpiry of + Nothing -> fetchToken auth + Just (IntDate expiryDate) -> + if now < expiryDate + then pure idToken + else fetchToken auth + +fetchToken :: OIDCAuth -> IO Text +fetchToken auth@(OIDCAuth{..}) = do + mgr <- newManager tlsManagerSettings + maybeToken <- readTVarIO refreshTokenTVar + case maybeToken of + Nothing -> throwM $ OIDCGetTokenException "cannot refresh id-token without a refresh token" + Just token -> do + tokenEndpoint <- fetchTokenEndpoint mgr auth + tokenURI <- parseURI strictURIParserOptions (Text.encodeUtf8 tokenEndpoint) + & either (throwM . OIDCURIException) pure + let oauth = OAuth2{ oauthClientId = clientID + , oauthClientSecret = clientSecret + , oauthAccessTokenEndpoint = tokenURI + , oauthOAuthorizeEndpoint = tokenURI + , oauthCallback = Nothing + } + oauthToken <- refreshAccessToken mgr oauth (RefreshToken token) + >>= either (throwM . OIDCOAuthException) pure + case OAuth.idToken oauthToken of + Nothing -> throwM $ OIDCGetTokenException "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 idTokenTVar (Just t) + return t + +fetchTokenEndpoint :: Manager -> OIDCAuth -> IO Text +fetchTokenEndpoint mgr OIDCAuth{..} = do + discover issuerURL mgr + & (fmap configuration) + & (fmap tokenEndpoint) + +{- + 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 throwM (\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 + latestCache <- readTVarIO cache + issuerURL <- lookupOrThrow "idp-issuer-url" + clientID <- lookupOrThrow "client-id" + case Map.lookup (issuerURL, clientID) latestCache of + Just cacheHit -> return $ newTLSAndAuth cacheHit + Nothing -> do + parsedAuth <- parseOIDCAuthInfo cfg + >>= either throwM pure + let newCache = Map.insert (issuerURL, clientID) parsedAuth latestCache + _ <- atomically $ swapTVar cache newCache + return $ newTLSAndAuth parsedAuth + where lookupOrThrow k = Map.lookup k cfg + & maybe (throwM $ OIDCAuthMissingInformation $ Text.unpack k) pure + newTLSAndAuth auth = (tls, addAuthMethod kubecfg auth) +cachedOIDCAuth _ _ _ = Nothing + +parseOIDCAuthInfo :: Map Text Text -> IO (Either OIDCAuthParsingException OIDCAuth) +parseOIDCAuthInfo authInfo = do + eitherTLSParams <- parseCA authInfo + idTokenTVar <- atomically $ newTVar $ Map.lookup "id-token" authInfo + refreshTokenTVar <- atomically $ newTVar $ Map.lookup "refresh-token" authInfo + return $ do + tlsParams <- mapLeft OIDCAuthCAParsingFailed eitherTLSParams + issuerURL <- lookupEither "idp-issuer-url" + clientID <- lookupEither "client-id" + clientSecret <- lookupEither "client-secret" + return OIDCAuth{..} + where lookupEither k = Map.lookup k authInfo + & maybeToRight (OIDCAuthMissingInformation $ Text.unpack k) + +parseCA :: Map Text Text -> IO (Either ParseCertException TLS.ClientParams) +parseCA authInfo = do + tlsParams <- defaultTLSClientParams + let maybeNewParams = (parseCAFile tlsParams authInfo + <|> parseCAData tlsParams authInfo) + fromMaybe (pure $ Right tlsParams) maybeNewParams + +parseCAFile :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either ParseCertException TLS.ClientParams)) +parseCAFile tlsParams authInfo = do + caFile <- Text.unpack <$> Map.lookup "idp-certificate-authority" authInfo + Just $ do + caText <- BS.readFile caFile + return $ updateClientParams tlsParams caText + +parseCAData :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either ParseCertException TLS.ClientParams)) +parseCAData tlsParams authInfo = do + caBase64 <- Map.lookup "idp-certificate-authority-data" authInfo + Just $ pure $ do + caText <- B64.decode (Text.encodeUtf8 caBase64) + & mapLeft Base64ParsingFailed + updateClientParams tlsParams caText diff --git a/src/Kubernetes/Client/Auth/Token.hs b/src/Kubernetes/Client/Auth/Token.hs new file mode 100644 --- /dev/null +++ b/src/Kubernetes/Client/Auth/Token.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} +module Kubernetes.Client.Auth.Token where + +import Data.Monoid ( (<>) ) +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 + +-- |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) + +-- |Configures the 'KubernetesClientConfig' to use token authentication. +setTokenAuth + :: T.Text -- ^Authentication token + -> KubernetesClientConfig + -> KubernetesClientConfig +setTokenAuth t kcfg = kcfg + { configAuthMethods = [AnyAuthMethod (AuthApiKeyBearerToken $ "Bearer " <> t)] + } diff --git a/src/Kubernetes/Client/Auth/TokenFile.hs b/src/Kubernetes/Client/Auth/TokenFile.hs new file mode 100644 --- /dev/null +++ b/src/Kubernetes/Client/Auth/TokenFile.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} +module Kubernetes.Client.Auth.TokenFile where + +import Control.Concurrent.STM +import Data.Function ( (&) ) +import Data.Monoid ( (<>) ) +import Data.Text ( Text ) +import Data.Time.Clock +import Kubernetes.Client.Auth.Internal.Types +import Kubernetes.OpenAPI.Core +import Kubernetes.Client.KubeConfig + hiding ( token ) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified Lens.Micro as L + +data TokenFileAuth = TokenFileAuth { token :: TVar(Maybe Text) + , expiry :: TVar(Maybe UTCTime) + , file :: FilePath + , period :: NominalDiffTime + } + +instance AuthMethod TokenFileAuth where + applyAuthMethod _ tokenFile req = do + t <- getToken tokenFile + pure + $ req + `setHeader` toHeader ("authorization", "Bearer " <> t) + & L.set rAuthTypesL [] + +-- |Detects if token-file is specified in AuthConfig. +tokenFileAuth :: DetectAuth +tokenFileAuth auth (tlsParams, cfg) = do + file <- tokenFile auth + return $ do + c <- setTokenFileAuth file cfg + return (tlsParams, c) + +-- |Configures the 'KubernetesClientConfig' to use TokenFile authentication. +setTokenFileAuth + :: FilePath -> KubernetesClientConfig -> IO KubernetesClientConfig +setTokenFileAuth f kcfg = atomically $ do + t <- newTVar (Nothing :: Maybe Text) + e <- newTVar (Nothing :: Maybe UTCTime) + return kcfg + { configAuthMethods = + [ AnyAuthMethod + (TokenFileAuth { token = t, expiry = e, file = f, period = 60 }) + ] + } + +getToken :: TokenFileAuth -> IO Text +getToken auth = getCurrentToken auth >>= maybe (reloadToken auth) return + +getCurrentToken :: TokenFileAuth -> IO (Maybe Text) +getCurrentToken TokenFileAuth { token, expiry } = do + now <- getCurrentTime + maybeExpiry <- readTVarIO expiry + maybeToken <- readTVarIO token + return $ do + e <- maybeExpiry + if e > now then maybeToken else Nothing + +reloadToken :: TokenFileAuth -> IO Text +reloadToken TokenFileAuth { token, expiry, file, period } = do + content <- T.readFile file + let t = T.strip content + now <- getCurrentTime + atomically $ do + writeTVar token (Just t) + writeTVar expiry (Just (addUTCTime period now)) + return t diff --git a/src/Kubernetes/Client/Config.hs b/src/Kubernetes/Client/Config.hs --- a/src/Kubernetes/Client/Config.hs +++ b/src/Kubernetes/Client/Config.hs @@ -1,136 +1,174 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} -module Kubernetes.Client.Config where +module Kubernetes.Client.Config + ( KubeConfigSource(..) + , addCACertData + , addCACertFile + , applyAuthSettings + , clientHooksL + , defaultTLSClientParams + , disableServerCertValidation + , disableServerNameValidation + , disableValidateAuthMethods + , loadPEMCerts + , mkInClusterClientConfig + , mkKubeClientConfig + , newManager + , onCertificateRequestL + , onServerCertificateL + , parsePEMCerts + , serviceAccountDir + , setCAStore + , setClientCert + , setMasterURI + , setTokenAuth + , tlsValidation + ) +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 qualified Data.Text as T +import qualified Data.Text.Encoding 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.Auth.TokenFile +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 } +data KubeConfigSource = KubeConfigFile FilePath + | KubeConfigCluster --- |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 } +{-| + Creates 'NH.Manager' and 'K.KubernetesClientConfig' for a given + 'KubeConfigSource'. It is recommended that multiple 'kubeClient' invocations + across an application share an 'OIDCCache', this makes sure updation of OAuth + token is synchronized across all the different clients being used. +-} +mkKubeClientConfig + :: OIDCCache -> KubeConfigSource -> IO (NH.Manager, K.KubernetesClientConfig) +mkKubeClientConfig oidcCache (KubeConfigFile f) = do + kubeConfig <- decodeFileThrow f + masterURI <- + server + <$> getCluster kubeConfig + & either (const $ pure "localhost:8080") return + tlsParams <- configureTLSParams kubeConfig (takeDirectory f) + clientConfig <- K.newConfig & fmap (setMasterURI masterURI) + (tlsParamsWithAuth, clientConfigWithAuth) <- case getAuthInfo kubeConfig of + Left _ -> return (tlsParams, clientConfig) + Right (_, auth) -> + applyAuthSettings oidcCache auth (tlsParams, clientConfig) + mgr <- newManager tlsParamsWithAuth + return (mgr, clientConfigWithAuth) +mkKubeClientConfig _ KubeConfigCluster = mkInClusterClientConfig --- |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)] - } +-- |Creates 'NH.Manager' and 'K.KubernetesClientConfig' assuming it is being executed in a pod +mkInClusterClientConfig + :: (MonadIO m, MonadThrow m) => m (NH.Manager, K.KubernetesClientConfig) +mkInClusterClientConfig = do + caStore <- loadPEMCerts $ serviceAccountDir ++ "/ca.crt" + defTlsParams <- liftIO defaultTLSClientParams + mgr <- liftIO . newManager . setCAStore caStore $ disableServerNameValidation + defTlsParams + host <- liftIO $ getEnv "KUBERNETES_SERVICE_HOST" + port <- liftIO $ getEnv "KUBERNETES_SERVICE_PORT" + cfg <- setMasterURI (T.pack $ "https://" ++ host ++ ":" ++ port) <$> liftIO + (K.newConfig >>= setTokenFileAuth (serviceAccountDir ++ "/token")) + return (mgr, cfg) +-- |Sets the master URI in the 'K.KubernetesClientConfig'. +setMasterURI + :: T.Text -- ^ Master URI + -> K.KubernetesClientConfig + -> K.KubernetesClientConfig +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 +serviceAccountDir :: FilePath +serviceAccountDir = "/var/run/secrets/kubernetes.io/serviceaccount" -data ParsePEMCertsException = ParsePEMCertsException String deriving (Typeable, Show) +configureTLSParams :: Config -> FilePath -> IO TLS.ClientParams +configureTLSParams cfg dir = do + defaultTLS <- defaultTLSClientParams + withCACertData <- addCACertData cfg defaultTLS + withCACertFile <- addCACertFile cfg dir withCACertData + return $ tlsValidation cfg withCACertFile -instance Exception ParsePEMCertsException +tlsValidation :: Config -> TLS.ClientParams -> TLS.ClientParams +tlsValidation cfg tlsParams = case getCluster cfg of + Left _ -> tlsParams + Right c -> case insecureSkipTLSVerify c of + Just True -> disableServerCertValidation tlsParams + _ -> tlsParams --- |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 +addCACertData + :: (MonadThrow m) => Config -> TLS.ClientParams -> m TLS.ClientParams +addCACertData cfg tlsParams = + let + eitherCertText = + getCluster cfg + & (>>= (maybeToRight "cert data not provided" . certificateAuthorityData + ) + ) + in case eitherCertText of + Left _ -> pure tlsParams + Right certBase64 -> do + certText <- + B64.decode (T.encodeUtf8 certBase64) + & either (throwM . Base64ParsingFailed) pure + updateClientParams tlsParams certText & either throwM return -serviceAccountDir :: FilePath -serviceAccountDir = "/var/run/secrets/kubernetes.io/serviceaccount" +addCACertFile :: Config -> FilePath -> TLS.ClientParams -> IO TLS.ClientParams +addCACertFile cfg dir tlsParams = do + let eitherCertFile = + getCluster cfg + >>= maybeToRight "cert file not provided" + . certificateAuthority + & fmap T.unpack + & fmap (dir ) + case eitherCertFile of + Left _ -> return tlsParams + Right certFile -> do + certText <- B.readFile certFile + return $ updateClientParams tlsParams certText & fromRight tlsParams -cluster :: (MonadIO m, MonadThrow m) => m (NH.Manager, K.KubernetesClientConfig) -cluster = do - caStore <- loadPEMCerts $ serviceAccountDir ++ "/ca.crt" - defTlsParams <- liftIO defaultTLSClientParams - mgr <- liftIO . newManager . setCAStore caStore $ disableServerNameValidation defTlsParams - 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) +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 diff --git a/src/Kubernetes/Client/Internal/TLSUtils.hs b/src/Kubernetes/Client/Internal/TLSUtils.hs new file mode 100644 --- /dev/null +++ b/src/Kubernetes/Client/Internal/TLSUtils.hs @@ -0,0 +1,110 @@ +{-# 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.Either.Combinators (mapLeft) +import Data.Function ((&)) +import Data.PEM (pemContent, pemParseBS) +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 ParseCertException [SignedCertificate] +parsePEMCerts pemBS = do + pems <- pemParseBS pemBS + & mapLeft PEMParsingFailed + return $ rights $ map (decodeSignedCertificate . pemContent) pems + +-- | Updates client params, sets CA store to passed bytestring of CA certificates +updateClientParams :: TLS.ClientParams -> ByteString -> Either ParseCertException TLS.ClientParams +updateClientParams cp certText = parsePEMCerts certText + & (fmap (flip setCAStore cp)) + +-- |Use a custom CA store. +setCAStore :: [SignedCertificate] -> TLS.ClientParams -> TLS.ClientParams +setCAStore certs tlsParams = + tlsParams & clientSharedL . sharedCAStoreL .~ 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 }) + +clientSharedL :: Lens' TLS.ClientParams TLS.Shared +clientSharedL = lens TLS.clientShared (\tlsParams cs -> tlsParams {TLS.clientShared = cs} ) + +sharedCAStoreL :: Lens' TLS.Shared CertificateStore +sharedCAStoreL = lens TLS.sharedCAStore (\shared store -> shared{TLS.sharedCAStore = store}) + +-- |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 }) + +-- |Loads certificates from a PEM-encoded file. +loadPEMCerts :: (MonadIO m, MonadThrow m) => FilePath -> m [SignedCertificate] +loadPEMCerts pemFile = do + liftIO (B.readFile pemFile) + >>= (either throwM return) + . parsePEMCerts + +-- |Loads Base64 encoded certificate and private key +loadB64EncodedCert :: (MonadThrow m) => B.ByteString -> B.ByteString -> m Credential +loadB64EncodedCert certB64 keyB64 = either throwM pure $ do + certText <- B64.decode certB64 + & mapLeft Base64ParsingFailed + keyText <- B64.decode keyB64 + & mapLeft Base64ParsingFailed + credentialLoadX509FromMemory certText keyText + & mapLeft FailedToLoadCredential + +data ParseCertException = PEMParsingFailed String + | Base64ParsingFailed String + | FailedToLoadCredential String + deriving Show + +instance Exception ParseCertException diff --git a/src/Kubernetes/Data/K8sJSONPath.hs b/src/Kubernetes/Data/K8sJSONPath.hs new file mode 100644 --- /dev/null +++ b/src/Kubernetes/Data/K8sJSONPath.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} +module Kubernetes.Data.K8sJSONPath where + +import Data.Aeson +import Data.Aeson.Text +import Data.JSONPath +import Data.Monoid ((<>)) +import Data.Text as Text + +import Control.Applicative ((<|>)) +import Data.Attoparsec.Text +import Data.Text.Lazy (toStrict) + +data K8sPathElement = PlainText Text + | JSONPath [JSONPathElement] + deriving (Show, Eq) + +k8sJSONPath :: Parser [K8sPathElement] +k8sJSONPath = many1 pathElementParser + +pathElementParser :: Parser K8sPathElement +pathElementParser = jsonpathParser <|> plainTextParser + +plainTextParser :: Parser K8sPathElement +plainTextParser = PlainText <$> takeWhile1 (/= '{') + +jsonpathParser :: Parser K8sPathElement +jsonpathParser = JSONPath <$> (char '{' *> jsonPath <* char '}') + +runJSONPath :: [K8sPathElement] -> Value -> Either String Text +runJSONPath [] _ = pure "" +runJSONPath (e:es) v = do + res <- runPathElement e v + rest <- runJSONPath es v + pure $ res <> rest + +runPathElement :: K8sPathElement -> Value -> Either String Text +runPathElement (PlainText t) _ = pure t +runPathElement (JSONPath p) v = encodeResult $ executeJSONPath p v + +encodeResult :: ExecutionResult Value -> Either String Text +encodeResult (ResultValue val) = return $ jsonToText val +encodeResult (ResultList vals) = return $ (intercalate " " $ Prelude.map jsonToText vals) +encodeResult (ResultError err) = Left err + +jsonToText :: Value -> Text +jsonToText (String t) = t +jsonToText x = toStrict $ encodeToLazyText x diff --git a/test/Kubernetes/Client/Auth/ClientCertSpec.hs b/test/Kubernetes/Client/Auth/ClientCertSpec.hs new file mode 100644 --- /dev/null +++ b/test/Kubernetes/Client/Auth/ClientCertSpec.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module Kubernetes.Client.Auth.ClientCertSpec where + +import Test.Hspec + +import Data.FileEmbed +import Data.Maybe (isJust, isNothing) +import Data.Text.Encoding (decodeUtf8) +import Kubernetes.Client.Auth.ClientCert +import Kubernetes.Client.KubeConfig +import Kubernetes.OpenAPI +import Network.TLS (defaultParamsClient) + +import qualified Data.ByteString.Base64 as B64 + +emptyAuthInfo :: AuthInfo +emptyAuthInfo = AuthInfo Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + +spec :: Spec +spec = do + let inputTLSParams = defaultParamsClient "" "" + certFilePath = "test/testdata/certs/certificate.pem" + keyFilePath = "test/testdata/certs/private-key.pem" + base64EncodedCert = decodeUtf8 $ B64.encode $(embedFile $ "test/testdata/certs/certificate.pem") + base64EncodedKey = decodeUtf8 $ B64.encode $(embedFile $ "test/testdata/certs/private-key.pem") + describe "ClientCert File Authentication" $ do + context "when cert and key file are provided in AuthInfo" $ do + let auth = emptyAuthInfo { clientCertificate = Just $ certFilePath + , clientKey = Just $ keyFilePath } + it "should detect client cert file auth" $ do + inputConfig <- newConfig + isJust (clientCertFileAuth auth (inputTLSParams, inputConfig)) `shouldBe` True + + it "should disable validate auth method" $ do + inputConfig <- newConfig + case clientCertFileAuth auth (inputTLSParams, inputConfig) of + Nothing -> expectationFailure "expected to detect client cert file auth" + Just detectedAuth -> do + (_, cfg) <- detectedAuth + configValidateAuthMethods cfg `shouldBe` False + + it "should return Nothing if the cert file is not provided" $ do + let auth = emptyAuthInfo {clientKey = Just "/some/file"} + inputConfig <- newConfig + isNothing (clientCertFileAuth auth (inputTLSParams, inputConfig)) `shouldBe` True + + it "should return Nothing if the key file is not provided" $ do + let auth = emptyAuthInfo {clientCertificate = Just "/some/file"} + inputConfig <- newConfig + isNothing (clientCertFileAuth auth (undefined, inputConfig)) `shouldBe` True + + describe "ClientCert Data Authentication" $ do + context "when cert and key file are provided in AuthInfo" $ do + let auth = emptyAuthInfo { clientCertificateData = Just base64EncodedCert + , clientKeyData = Just base64EncodedKey} + it "should detect client cert data auth" $ do + inputConfig <- newConfig + isJust (clientCertDataAuth auth (inputTLSParams, inputConfig)) `shouldBe` True + + it "should disable validate auth method" $ do + inputConfig <- newConfig + case clientCertDataAuth auth (inputTLSParams, inputConfig) of + Nothing -> expectationFailure "expected to detect client cert file auth" + Just detectedAuth -> do + (_, cfg) <- detectedAuth + configValidateAuthMethods cfg `shouldBe` False + + it "should return Nothing if the cert file is not provided" $ do + let auth = emptyAuthInfo {clientKeyData = Just base64EncodedKey} + inputConfig <- newConfig + isNothing (clientCertDataAuth auth (inputTLSParams, inputConfig)) `shouldBe` True + + it "should return Nothing if the key file is not provided" $ do + let auth = emptyAuthInfo {clientCertificateData = Just base64EncodedCert} + inputConfig <- newConfig + isNothing (clientCertDataAuth auth (inputTLSParams, inputConfig)) `shouldBe` True diff --git a/test/Kubernetes/Client/Auth/TokenFileSpec.hs b/test/Kubernetes/Client/Auth/TokenFileSpec.hs new file mode 100644 --- /dev/null +++ b/test/Kubernetes/Client/Auth/TokenFileSpec.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE OverloadedStrings #-} +module Kubernetes.Client.Auth.TokenFileSpec where + +import Test.Hspec +import Control.Concurrent +import Data.Function ( (&) ) +import Data.FileEmbed +import Data.Typeable +import Data.Maybe ( isJust + , isNothing + ) +import Data.Text ( Text ) +import Data.Text.Encoding ( decodeUtf8 ) +import Kubernetes.Client.Auth.TokenFile +import Kubernetes.Client.KubeConfig +import Kubernetes.OpenAPI +import Kubernetes.OpenAPI.Core ( _applyAuthMethods + , _mkRequest + ) +import Network.TLS ( defaultParamsClient ) + +import qualified Data.ByteString.Base64 as B64 + +emptyAuthInfo :: AuthInfo +emptyAuthInfo = AuthInfo Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + +spec :: Spec +spec = do + let testTLSParams = defaultParamsClient "" "" + token1FilePath = "test/testdata/tokens/token1" + token2FilePath = "test/testdata/tokens/token2" + describe "TokenFile Authentication" $ do + it "should return Nothing if the file is not provided" $ do + testConfig <- newConfig + isNothing (tokenFileAuth emptyAuthInfo (testTLSParams, testConfig)) + `shouldBe` True + + it "should reload token after expiry" $ do + let auth = emptyAuthInfo { tokenFile = Just token1FilePath } + testConfig <- newConfig + case tokenFileAuth auth (testTLSParams, testConfig) of + Nothing -> expectationFailure "expected to detect TokenFile auth" + Just detectedAuth -> do + (_, cfg@(KubernetesClientConfig { configAuthMethods = AnyAuthMethod (a) : as })) <- + detectedAuth + case cast a :: Maybe TokenFileAuth of + Nothing -> expectationFailure "expected to be TokenFile auth" + Just tf -> do + let tfWithShorterPeriod = tf { period = 5 } + x <- getToken tfWithShorterPeriod + x `shouldBe` ("token1" :: Text) + + let tfWithShorterPeriod' = + tfWithShorterPeriod { file = token2FilePath } + threadDelay 2000000 -- sleep 2 seconds + x <- getToken tfWithShorterPeriod' + x `shouldBe` ("token1" :: Text) + + threadDelay 3000000 -- sleep 3 seconds + x <- getToken tfWithShorterPeriod' + x `shouldBe` ("token2" :: Text) + diff --git a/test/Kubernetes/Client/KubeConfigSpec.hs b/test/Kubernetes/Client/KubeConfigSpec.hs new file mode 100644 --- /dev/null +++ b/test/Kubernetes/Client/KubeConfigSpec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Kubernetes.Client.KubeConfigSpec where + +import Data.Aeson (decode, encode, parseJSON, + toJSON) +import Data.Maybe (fromJust) +import Data.Yaml (decodeFile) +import Kubernetes.Client.KubeConfig (AuthInfo (..), Cluster (..), + Config, Context (..), + getAuthInfo, getCluster, + getContext) +import Test.Hspec + +spec :: Spec +spec = do + let getConfig :: IO Config + getConfig = fromJust <$> decodeFile "test/testdata/kubeconfig.yaml" + describe "FromJSON and ToJSON instances" $ do + it "roundtrips successfully" $ do + config <- getConfig + decode (encode (toJSON config)) `shouldBe` Just config + describe "getContext" $ do + it "returns the correct context" $ do + config <- getConfig + getContext config `shouldBe` (Right (Context "cluster-aaa" "user-aaa" Nothing)) + + describe "getCluster" $ do + it "returns the correct cluster" $ do + config <- getConfig + server <$> getCluster config `shouldBe` (Right "https://aaa.example.com") + + describe "getAuthInfo" $ do + it "returns the correct authInfo" $ do + config <- getConfig + fst <$> getAuthInfo config `shouldBe` (Right "user-aaa") diff --git a/test/Kubernetes/Data/K8sJSONPathSpec.hs b/test/Kubernetes/Data/K8sJSONPathSpec.hs new file mode 100644 --- /dev/null +++ b/test/Kubernetes/Data/K8sJSONPathSpec.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +module Kubernetes.Data.K8sJSONPathSpec where + +import Test.Hspec +import Test.Hspec.Attoparsec + +import Kubernetes.Data.K8sJSONPath +import Data.Text +import Data.JSONPath +import Data.Aeson + +spec :: Spec +spec = do + describe "K8sJSONPath" $ do + describe "Parsing" $ do + it "should parse plain text" $ do + ("plain" :: Text) ~> k8sJSONPath + `shouldParse` [PlainText "plain"] + + it "should parse jsonpath" $ do + ("{.foo}" :: Text) ~> k8sJSONPath + `shouldParse` [JSONPath [KeyChild "foo"]] + + it "should parse K8sJSONPath with both text and jsonpath" $ do + ("kind is {.kind}" :: Text) ~> k8sJSONPath + `shouldParse` [PlainText "kind is ", JSONPath [KeyChild "kind"]] + + describe "Running" $ do + it "should interpolate string with json values" $ do + let path = [PlainText "kind is ", JSONPath [KeyChild "kind"]] + val = (object ["kind" .= ("Pod" :: Text)]) + runJSONPath path val `shouldBe` Right "kind is Pod" + diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,31 +1,1 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -import Data.Aeson (decode, encode, parseJSON, - toJSON) -import Data.Maybe (fromJust) -import Data.Yaml (decodeFile) -import Kubernetes.Client.KubeConfig (AuthInfo (..), Cluster (..), - Config, Context (..), - getAuthInfo, getCluster, - getContext) -import Test.Hspec - -main :: IO () -main = do - config :: Config <- fromJust <$> decodeFile "test/testdata/kubeconfig.yaml" - hspec $ do - describe "FromJSON and ToJSON instances" $ do - it "roundtrips successfully" $ do - decode (encode (toJSON config)) `shouldBe` Just config - describe "getContext" $ do - it "returns the correct context" $ do - getContext config `shouldBe` (Right (Context "cluster-aaa" "user-aaa" Nothing)) - - describe "getCluster" $ do - it "returns the correct cluster" $ do - server <$> getCluster config `shouldBe` (Right "https://aaa.example.com") - - describe "getAuthInfo" $ do - it "returns the correct authInfo" $ do - fst <$> getAuthInfo config `shouldBe` (Right "user-aaa") +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/testdata/certs/certificate.pem b/test/testdata/certs/certificate.pem new file mode 100644 --- /dev/null +++ b/test/testdata/certs/certificate.pem @@ -0,0 +1,17 @@ +-----BEGIN CERTIFICATE----- +MIICsDCCAZgCCQCyRyEmfEJy9jANBgkqhkiG9w0BAQUFADAZMRcwFQYDVQQDDA5z +ZWxmLXNpZ25lZC1jYTAgFw0xOTA3MjMyMTUwMThaGA8yMTI5MDEyNzIxNTAxOFow +GTEXMBUGA1UEAwwOc2VsZi1zaWduZWQtY2EwggEiMA0GCSqGSIb3DQEBAQUAA4IB +DwAwggEKAoIBAQDbxmgIae5FUbLu76NmsUbbo7D0Bk6cUpII/lhREQptoL4YkOo3 +MnLVQ6bkTG1hdWkN2A+eDHDJklNR6zzrCAA395lKhCZWSxq9o3AFWFMI8TWSptxL +X/fl/vDh1pH4u/nGjKC1fSf2F9nvxywIgd0PNttWG8bNMzl3gZULfg0TWKvSX6Ln +9SLA9Whsr3WMQno46JiKauB7z1+9Qc+26uEOi6kpc2mYIDTCUO5+umUEsV+seQS+ +TUe9lMQCLuZVmnWoygbCx5+eXm//iYOBSz8Z5jpEOuA6mY9FJAUU3uoGR656NImZ +IBjgVSZBIDleq2V/lmdbjHy8GpQTMtButMorAgMBAAEwDQYJKoZIhvcNAQEFBQAD +ggEBALHSlOI+Ra6QWr5V3FQS2ypkddK19RZ3TxEvCt8Brt2uNBw6Oxw/qLq17xiB +C7bJV1SA9MNqdv1grk1kVil5aUeAGLIQtVD3C1/qiCgfP+HN1Fb0QnMcxJwESRmc +TDQoYEkZp/TqgggDbmJD6S91EpXs1QiAvNA5+9L8ikOrOJQeHkzFen9PXoSqkVTl +XPwOsCIzcBnuq+agt3pkiFcHtm348y4Yjv3kOimAhzanR96DH2DtTBCmDE/cYW7j +s5aOI/MKlrZxh2gFvgqBZMjVUv8bNuDAU+8prDH4YzsDFeGKD42lDvnL+XQ69xKE +oLBoM+xTo5QwQp0ZWW3srw47BKo= +-----END CERTIFICATE----- diff --git a/test/testdata/certs/private-key.pem b/test/testdata/certs/private-key.pem new file mode 100644 --- /dev/null +++ b/test/testdata/certs/private-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEowIBAAKCAQEA28ZoCGnuRVGy7u+jZrFG26Ow9AZOnFKSCP5YUREKbaC+GJDq +NzJy1UOm5ExtYXVpDdgPngxwyZJTUes86wgAN/eZSoQmVksavaNwBVhTCPE1kqbc +S1/35f7w4daR+Lv5xoygtX0n9hfZ78csCIHdDzbbVhvGzTM5d4GVC34NE1ir0l+i +5/UiwPVobK91jEJ6OOiYimrge89fvUHPturhDoupKXNpmCA0wlDufrplBLFfrHkE +vk1HvZTEAi7mVZp1qMoGwsefnl5v/4mDgUs/GeY6RDrgOpmPRSQFFN7qBkeuejSJ +mSAY4FUmQSA5Xqtlf5ZnW4x8vBqUEzLQbrTKKwIDAQABAoIBACG0nRHlRSCmdf3F +DNdcCtT2ltXl/bplw3XTpDHSnjnP9DeKShFrEEd616advgy7WABCiaqgl8+iPFsM +68vT70ymEYFnIQYNAK3i2fRH5nwxmhjCtHhu4HMKlWDdaoeuNJFp0d/jsPRCFi96 +6Vrop8GElUDwg53G5GJaokQf8dtsbg05Qv0C+BLMjYoXt+OCSYn0Jnzc3YLyn6pf +0Ubhb5X73+pSFcY0JindJzHo/c3k5255VOorimxSA9Kr0glYJ2MlOuWM7khZfWjJ +yJPEfa0hM/mPkR2WZ3Rif1Hb01BcrpjsNmQKFDKG+gumxL0CYzUlxOrVI5RO5+yC +wKw8FYkCgYEA/QSzpNxc+qtYj9lJL3p2sxN8cQNOhDOF3DdEZmwToPF2JQKqnDo0 +5LDugNgUuOilVFYGxmLNC9RMB+PgOT7kHgZY99cZFuUCww85j2NIbdoATXFZvUdD +O2E9o4X4RQ4+WQTZZ01sfjxMa6Y+t5HC49wvwHwdY0SMA3w6jPkBer8CgYEA3l1q +yJObFV6rorCoeJIpLPGs1lQpXb0qgENmE6tnwYQ56mIuP0mLiSvqkISWwQyEiPjZ +g9O70adOLom/0l9ssIsE1bHk/k/391rzYsvXvHM/uuIFNd7yqYApBLXq3jiNZbfq +CeoWkymez0VOWzgIQxh2UHZ+5+qRSMDgV6hq55UCgYBr00ofcs2pAcZvHyFCO4VE +UYSRwOAAFNjx/ReIMny29M/te9JrW57Y6tHpVKyYFIUIiNTATLCnXuS75A/VNYkP +hpL5o9AMYrInoGBeS+g88E96sViWAj2Tm6AiBODFxQkq9JcVn/ghX98NbT6DCnos +ktRCymHXwQmOHq3xD9jijwKBgGX3KFQ5e0/dTY8Yuugu/bqiR8MwbJeTer2+Kjyy +yK0wWO5lfxd+PgH0pWcHpal4d/3nPrb4jJOiyHMGr3NkVo7N8LWdEYicWvSOPDT9 +jDvaDUtBAWqmhVe8cRK76Ktl+1C9eRB6y0dIOo6JFVk25HL/8KEM9Tybj2txJm6L +yBnRAoGBAN3K6EhZ6eO0BorVNi8/5KaE8D0f3ZFEgUBEpVwiJLmL1hXbsiv2JyjE ++dR+reScpl8NODycnnFzBzlIijB52CZWo+cxyFSvZxz3RrJZ8XaM/fg5MgNmcwLQ +zejmoH7LuYD4z/OaPzgupJZlRUZNADOqZ8alsxSIvOHkImUAT9Q2 +-----END RSA PRIVATE KEY----- diff --git a/test/testdata/tokens/token1 b/test/testdata/tokens/token1 new file mode 100644 --- /dev/null +++ b/test/testdata/tokens/token1 @@ -0,0 +1,1 @@ +token1 diff --git a/test/testdata/tokens/token2 b/test/testdata/tokens/token2 new file mode 100644 --- /dev/null +++ b/test/testdata/tokens/token2 @@ -0,0 +1,1 @@ +token2