add TokenFileAuth which reloads token after expiry

2020-04-28 10:48:34 -07:00
parent 95eb28bfaf
commit 0886d754ed
6 changed files with 235 additions and 86 deletions
--- 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)]
+  }
--- a/kubernetes-client/src/Kubernetes/Client/Auth/TokenFile.hs
+++ 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
--- 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
--- a/kubernetes-client/test/Kubernetes/Client/Auth/TokenFileSpec.hs
+++ 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)
+
--- a/kubernetes-client/test/testdata/tokens/token1
+++ b/kubernetes-client/test/testdata/tokens/token1
@@ -0,0 +1 @@
+token1
--- a/kubernetes-client/test/testdata/tokens/token2
+++ b/kubernetes-client/test/testdata/tokens/token2
@@ -0,0 +1 @@
+token2