add TokenFileAuth which reloads token after expiry

kubernetes-client/src/Kubernetes/Client/Auth/Token.hs

@@ -1,15 +1,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Kubernetes.Client.Auth.Token where
 
-import Data.Monoid                           ((<>))
+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           Kubernetes.Client.KubeConfig   ( AuthInfo(..) )
+import           Kubernetes.OpenAPI.Core        ( AnyAuthMethod(..)
+                                                , KubernetesClientConfig(..)
+                                                )
+import           Kubernetes.OpenAPI.Model       ( AuthApiKeyBearerToken(..) )
 
 import qualified Data.Text                     as T
-import qualified Data.Text.IO as T
 
 -- |Detects if token is specified in AuthConfig, if it is configures 'KubernetesClientConfig' with 'AuthApiKeyBearerToken'
 tokenAuth :: DetectAuth
@@ -17,14 +17,6 @@ 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
@@ -33,4 +25,3 @@ setTokenAuth
 setTokenAuth t kcfg = kcfg
   { configAuthMethods = [AnyAuthMethod (AuthApiKeyBearerToken $ "Bearer " <> t)]
   }
-

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

kubernetes-client/src/Kubernetes/Client/Config.hs

@@ -28,30 +28,34 @@ where
 
 import qualified Kubernetes.OpenAPI.Core       as K
 
-import           Control.Applicative                 ((<|>))
-import           Control.Exception.Safe              (MonadThrow, throwM)
-import           Control.Monad.IO.Class              (MonadIO, liftIO)
+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           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           Network.Connection             ( TLSSettings(..) )
 import qualified Network.HTTP.Client           as NH
-import           Network.HTTP.Client.TLS             (mkManagerSettings)
+import           Network.HTTP.Client.TLS        ( mkManagerSettings )
 import qualified Network.TLS                   as TLS
-import           System.Environment                  (getEnv)
+import           System.Environment             ( getEnv )
 import           System.FilePath
 
 data KubeConfigSource = KubeConfigFile FilePath
@@ -64,33 +68,35 @@ 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
+  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'.
@@ -116,46 +122,50 @@ configureTLSParams cfg dir = do
   return $ tlsValidation cfg withCACertFile
 
 tlsValidation :: Config -> TLS.ClientParams -> TLS.ClientParams
-tlsValidation cfg tlsParams =
-  case getCluster cfg of
+tlsValidation cfg tlsParams = case getCluster cfg of
   Left  _ -> tlsParams
-    Right c ->
-      case insecureSkipTLSVerify c of
+  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))
+  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)
+          certText <-
+            B64.decode (T.encodeUtf8 certBase64)
               & either (throwM . Base64ParsingFailed) pure
-         updateClientParams tlsParams certText
-           & either throwM return
+          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
+  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)
+      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)
+applyAuthSettings oidcCache auth input =
+  fromMaybe (pure input)
     $   clientCertFileAuth auth input
     <|> clientCertDataAuth auth input
     <|> tokenAuth auth input

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)
+

kubernetes-client/test/testdata/tokens/token1

@@ -0,0 +1 @@
+token1

kubernetes-client/test/testdata/tokens/token2

@@ -0,0 +1 @@
+token2