From 0886d754eddaf864347e8ba3a5083f4881454115 Mon Sep 17 00:00:00 2001 From: Shihang Zhang Date: Tue, 28 Apr 2020 10:48:34 -0700 Subject: [PATCH] add TokenFileAuth which reloads token after expiry --- .../src/Kubernetes/Client/Auth/Token.hs | 29 ++-- .../src/Kubernetes/Client/Auth/TokenFile.hs | 73 +++++++++ .../src/Kubernetes/Client/Config.hs | 144 ++++++++++-------- .../Kubernetes/Client/Auth/TokenFileSpec.hs | 73 +++++++++ kubernetes-client/test/testdata/tokens/token1 | 1 + kubernetes-client/test/testdata/tokens/token2 | 1 + 6 files changed, 235 insertions(+), 86 deletions(-) create mode 100644 kubernetes-client/src/Kubernetes/Client/Auth/TokenFile.hs create mode 100644 kubernetes-client/test/Kubernetes/Client/Auth/TokenFileSpec.hs create mode 100644 kubernetes-client/test/testdata/tokens/token1 create mode 100644 kubernetes-client/test/testdata/tokens/token2 diff --git a/kubernetes-client/src/Kubernetes/Client/Auth/Token.hs b/kubernetes-client/src/Kubernetes/Client/Auth/Token.hs index 88c3ede..be125bc 100644 --- a/kubernetes-client/src/Kubernetes/Client/Auth/Token.hs +++ b/kubernetes-client/src/Kubernetes/Client/Auth/Token.hs @@ -1,15 +1,15 @@ {-# 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 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 -import qualified Data.Text.IO as T +import qualified Data.Text as T -- |Detects if token is specified in AuthConfig, if it is configures 'KubernetesClientConfig' with 'AuthApiKeyBearerToken' tokenAuth :: DetectAuth @@ -17,20 +17,11 @@ 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)] - } - + { configAuthMethods = [AnyAuthMethod (AuthApiKeyBearerToken $ "Bearer " <> t)] + } diff --git a/kubernetes-client/src/Kubernetes/Client/Auth/TokenFile.hs b/kubernetes-client/src/Kubernetes/Client/Auth/TokenFile.hs new file mode 100644 index 0000000..61ed7a5 --- /dev/null +++ b/kubernetes-client/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/kubernetes-client/src/Kubernetes/Client/Config.hs b/kubernetes-client/src/Kubernetes/Client/Config.hs index 1c673e9..a971621 100644 --- a/kubernetes-client/src/Kubernetes/Client/Config.hs +++ b/kubernetes-client/src/Kubernetes/Client/Config.hs @@ -26,32 +26,36 @@ module Kubernetes.Client.Config ) where -import qualified Kubernetes.OpenAPI.Core as K +import qualified Kubernetes.OpenAPI.Core as K -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 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.Function ( (&) ) import Data.Maybe -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.IO as T +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 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 data KubeConfigSource = KubeConfigFile FilePath @@ -64,42 +68,44 @@ data KubeConfigSource = KubeConfigFile FilePath token is synchronized across all the different clients being used. -} mkKubeClientConfig - :: OIDCCache - -> KubeConfigSource - -> IO (NH.Manager, K.KubernetesClientConfig) + :: 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 + 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) + (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 +mkKubeClientConfig _ KubeConfigCluster = mkInClusterClientConfig -- |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 + :: (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 - tok <- liftIO . T.readFile $ serviceAccountDir ++ "/token" + mgr <- liftIO . newManager . setCAStore caStore $ disableServerNameValidation + defTlsParams host <- liftIO $ getEnv "KUBERNETES_SERVICE_HOST" port <- liftIO $ getEnv "KUBERNETES_SERVICE_PORT" - cfg <- setTokenAuth tok . setMasterURI (T.pack $ "https://" ++ host ++ ":" ++ port) <$> liftIO K.newConfig + 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 + :: T.Text -- ^ Master URI + -> K.KubernetesClientConfig + -> K.KubernetesClientConfig setMasterURI masterURI kcfg = - kcfg { K.configHost = (LazyB.fromStrict . T.encodeUtf8) masterURI } + kcfg { K.configHost = (LazyB.fromStrict . T.encodeUtf8) masterURI } -- |Creates a 'NH.Manager' that can handle TLS. newManager :: TLS.ClientParams -> IO NH.Manager @@ -110,55 +116,59 @@ serviceAccountDir = "/var/run/secrets/kubernetes.io/serviceaccount" configureTLSParams :: Config -> FilePath -> IO TLS.ClientParams configureTLSParams cfg dir = do - defaultTLS <- defaultTLSClientParams + defaultTLS <- defaultTLSClientParams withCACertData <- addCACertData cfg defaultTLS withCACertFile <- addCACertFile cfg dir withCACertData return $ tlsValidation cfg withCACertFile 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 +tlsValidation cfg tlsParams = case getCluster cfg of + Left _ -> tlsParams + Right c -> case insecureSkipTLSVerify c of + Just True -> disableServerCertValidation tlsParams + _ -> tlsParams -addCACertData :: (MonadThrow m) => Config -> TLS.ClientParams -> m TLS.ClientParams +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 + 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 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 ) + let eitherCertFile = + getCluster cfg + >>= maybeToRight "cert file not provided" + . certificateAuthority + & fmap T.unpack + & fmap (dir ) case eitherCertFile of - Left _ -> return tlsParams + Left _ -> return tlsParams Right certFile -> do certText <- B.readFile certFile - return - $ updateClientParams tlsParams certText - & (fromRight tlsParams) + return $ updateClientParams tlsParams certText & fromRight tlsParams 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 +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/kubernetes-client/test/Kubernetes/Client/Auth/TokenFileSpec.hs b/kubernetes-client/test/Kubernetes/Client/Auth/TokenFileSpec.hs new file mode 100644 index 0000000..8593541 --- /dev/null +++ b/kubernetes-client/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/kubernetes-client/test/testdata/tokens/token1 b/kubernetes-client/test/testdata/tokens/token1 new file mode 100644 index 0000000..6554d01 --- /dev/null +++ b/kubernetes-client/test/testdata/tokens/token1 @@ -0,0 +1 @@ +token1 diff --git a/kubernetes-client/test/testdata/tokens/token2 b/kubernetes-client/test/testdata/tokens/token2 new file mode 100644 index 0000000..d63ef3f --- /dev/null +++ b/kubernetes-client/test/testdata/tokens/token2 @@ -0,0 +1 @@ +token2