{-# LANGUAGE OverloadedStrings #-}

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           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.Basic
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

data KubeConfigSource = KubeConfigFile FilePath
                      | KubeConfigCluster

{-|
  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
-> KubeConfigSource -> IO (Manager, KubernetesClientConfig)
mkKubeClientConfig OIDCCache
oidcCache (KubeConfigFile FilePath
f) = do
  Config
kubeConfig <- FilePath -> IO Config
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => FilePath -> m a
decodeFileThrow FilePath
f
  Text
masterURI  <-
    Cluster -> Text
server
    (Cluster -> Text)
-> Either FilePath Cluster -> Either FilePath Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Either FilePath Cluster
getCluster Config
kubeConfig
    Either FilePath Text
-> (Either FilePath Text -> IO Text) -> IO Text
forall a b. a -> (a -> b) -> b
&   (FilePath -> IO Text)
-> (Text -> IO Text) -> Either FilePath Text -> IO Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO Text -> FilePath -> IO Text
forall a b. a -> b -> a
const (IO Text -> FilePath -> IO Text) -> IO Text -> FilePath -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"localhost:8080") Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return
  ClientParams
tlsParams <- Config -> FilePath -> IO ClientParams
configureTLSParams Config
kubeConfig (FilePath -> FilePath
takeDirectory FilePath
f)
  KubernetesClientConfig
clientConfig <- IO KubernetesClientConfig
K.newConfig IO KubernetesClientConfig
-> (IO KubernetesClientConfig -> IO KubernetesClientConfig)
-> IO KubernetesClientConfig
forall a b. a -> (a -> b) -> b
& (KubernetesClientConfig -> KubernetesClientConfig)
-> IO KubernetesClientConfig -> IO KubernetesClientConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> KubernetesClientConfig -> KubernetesClientConfig
setMasterURI Text
masterURI)
  (ClientParams
tlsParamsWithAuth, KubernetesClientConfig
clientConfigWithAuth) <- case Config -> Either FilePath (Text, AuthInfo)
getAuthInfo Config
kubeConfig of
    Left FilePath
_ -> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientParams
tlsParams, KubernetesClientConfig
clientConfig)
    Right (Text
_, AuthInfo
auth) ->
      OIDCCache
-> AuthInfo
-> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
applyAuthSettings OIDCCache
oidcCache AuthInfo
auth (ClientParams
tlsParams, KubernetesClientConfig
clientConfig)
  Manager
mgr <- ClientParams -> IO Manager
newManager ClientParams
tlsParamsWithAuth
  (Manager, KubernetesClientConfig)
-> IO (Manager, KubernetesClientConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Manager
mgr, KubernetesClientConfig
clientConfigWithAuth)
mkKubeClientConfig OIDCCache
_ KubeConfigSource
KubeConfigCluster = IO (Manager, KubernetesClientConfig)
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
m (Manager, KubernetesClientConfig)
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 :: m (Manager, KubernetesClientConfig)
mkInClusterClientConfig = do
  [SignedCertificate]
caStore <- FilePath -> m [SignedCertificate]
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
FilePath -> m [SignedCertificate]
loadPEMCerts (FilePath -> m [SignedCertificate])
-> FilePath -> m [SignedCertificate]
forall a b. (a -> b) -> a -> b
$ FilePath
serviceAccountDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/ca.crt"
  ClientParams
defTlsParams <- IO ClientParams -> m ClientParams
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ClientParams
defaultTLSClientParams
  Manager
mgr <- IO Manager -> m Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> m Manager)
-> (ClientParams -> IO Manager) -> ClientParams -> m Manager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientParams -> IO Manager
newManager (ClientParams -> IO Manager)
-> (ClientParams -> ClientParams) -> ClientParams -> IO Manager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SignedCertificate] -> ClientParams -> ClientParams
setCAStore [SignedCertificate]
caStore (ClientParams -> m Manager) -> ClientParams -> m Manager
forall a b. (a -> b) -> a -> b
$ ClientParams -> ClientParams
disableServerNameValidation
    ClientParams
defTlsParams
  FilePath
host <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
getEnv FilePath
"KUBERNETES_SERVICE_HOST"
  FilePath
port <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
getEnv FilePath
"KUBERNETES_SERVICE_PORT"
  KubernetesClientConfig
cfg  <- Text -> KubernetesClientConfig -> KubernetesClientConfig
setMasterURI (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"https://" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
host FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
port) (KubernetesClientConfig -> KubernetesClientConfig)
-> m KubernetesClientConfig -> m KubernetesClientConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO KubernetesClientConfig -> m KubernetesClientConfig
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO KubernetesClientConfig
K.newConfig IO KubernetesClientConfig
-> (KubernetesClientConfig -> IO KubernetesClientConfig)
-> IO KubernetesClientConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> KubernetesClientConfig -> IO KubernetesClientConfig
setTokenFileAuth (FilePath
serviceAccountDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/token"))
  (Manager, KubernetesClientConfig)
-> m (Manager, KubernetesClientConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Manager
mgr, KubernetesClientConfig
cfg)

-- |Sets the master URI in the 'K.KubernetesClientConfig'.
setMasterURI
  :: T.Text                -- ^ Master URI
  -> K.KubernetesClientConfig
  -> K.KubernetesClientConfig
setMasterURI :: Text -> KubernetesClientConfig -> KubernetesClientConfig
setMasterURI Text
masterURI KubernetesClientConfig
kcfg =
  KubernetesClientConfig
kcfg { configHost :: ByteString
K.configHost = (ByteString -> ByteString
LazyB.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8) Text
masterURI }

-- |Creates a 'NH.Manager' that can handle TLS.
newManager :: TLS.ClientParams -> IO NH.Manager
newManager :: ClientParams -> IO Manager
newManager ClientParams
cp = ManagerSettings -> IO Manager
NH.newManager (TLSSettings -> Maybe SockSettings -> ManagerSettings
mkManagerSettings (ClientParams -> TLSSettings
TLSSettings ClientParams
cp) Maybe SockSettings
forall a. Maybe a
Nothing)

serviceAccountDir :: FilePath
serviceAccountDir :: FilePath
serviceAccountDir = FilePath
"/var/run/secrets/kubernetes.io/serviceaccount"

configureTLSParams :: Config -> FilePath -> IO TLS.ClientParams
configureTLSParams :: Config -> FilePath -> IO ClientParams
configureTLSParams Config
cfg FilePath
dir = do
  ClientParams
defaultTLS     <- IO ClientParams
defaultTLSClientParams
  ClientParams
withCACertData <- Config -> ClientParams -> IO ClientParams
forall (m :: * -> *).
MonadThrow m =>
Config -> ClientParams -> m ClientParams
addCACertData Config
cfg ClientParams
defaultTLS
  ClientParams
withCACertFile <- Config -> FilePath -> ClientParams -> IO ClientParams
addCACertFile Config
cfg FilePath
dir ClientParams
withCACertData
  ClientParams -> IO ClientParams
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientParams -> IO ClientParams)
-> ClientParams -> IO ClientParams
forall a b. (a -> b) -> a -> b
$ Config -> ClientParams -> ClientParams
tlsValidation Config
cfg ClientParams
withCACertFile

tlsValidation :: Config -> TLS.ClientParams -> TLS.ClientParams
tlsValidation :: Config -> ClientParams -> ClientParams
tlsValidation Config
cfg ClientParams
tlsParams = case Config -> Either FilePath Cluster
getCluster Config
cfg of
  Left  FilePath
_ -> ClientParams
tlsParams
  Right Cluster
c -> case Cluster -> Maybe Bool
insecureSkipTLSVerify Cluster
c of
    Just Bool
True -> ClientParams -> ClientParams
disableServerCertValidation ClientParams
tlsParams
    Maybe Bool
_         -> ClientParams
tlsParams

addCACertData
  :: (MonadThrow m) => Config -> TLS.ClientParams -> m TLS.ClientParams
addCACertData :: Config -> ClientParams -> m ClientParams
addCACertData Config
cfg ClientParams
tlsParams =
  let
    eitherCertText :: Either FilePath Text
eitherCertText =
      Config -> Either FilePath Cluster
getCluster Config
cfg
        Either FilePath Cluster
-> (Either FilePath Cluster -> Either FilePath Text)
-> Either FilePath Text
forall a b. a -> (a -> b) -> b
& (Either FilePath Cluster
-> (Cluster -> Either FilePath Text) -> Either FilePath Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Maybe Text -> Either FilePath Text
forall b a. b -> Maybe a -> Either b a
maybeToRight FilePath
"cert data not provided" (Maybe Text -> Either FilePath Text)
-> (Cluster -> Maybe Text) -> Cluster -> Either FilePath Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cluster -> Maybe Text
certificateAuthorityData
               )
          )
  in  case Either FilePath Text
eitherCertText of
        Left  FilePath
_          -> ClientParams -> m ClientParams
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientParams
tlsParams
        Right Text
certBase64 -> do
          ByteString
certText <-
            ByteString -> Either FilePath ByteString
B64.decode (Text -> ByteString
T.encodeUtf8 Text
certBase64)
              Either FilePath ByteString
-> (Either FilePath ByteString -> m ByteString) -> m ByteString
forall a b. a -> (a -> b) -> b
& (FilePath -> m ByteString)
-> (ByteString -> m ByteString)
-> Either FilePath ByteString
-> m ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseCertException -> m ByteString
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseCertException -> m ByteString)
-> (FilePath -> ParseCertException) -> FilePath -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ParseCertException
Base64ParsingFailed) ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ClientParams
-> ByteString -> Either ParseCertException ClientParams
updateClientParams ClientParams
tlsParams ByteString
certText Either ParseCertException ClientParams
-> (Either ParseCertException ClientParams -> m ClientParams)
-> m ClientParams
forall a b. a -> (a -> b) -> b
& (ParseCertException -> m ClientParams)
-> (ClientParams -> m ClientParams)
-> Either ParseCertException ClientParams
-> m ClientParams
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseCertException -> m ClientParams
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientParams -> m ClientParams
forall (m :: * -> *) a. Monad m => a -> m a
return

addCACertFile :: Config -> FilePath -> TLS.ClientParams -> IO TLS.ClientParams
addCACertFile :: Config -> FilePath -> ClientParams -> IO ClientParams
addCACertFile Config
cfg FilePath
dir ClientParams
tlsParams = do
  let eitherCertFile :: Either FilePath FilePath
eitherCertFile =
        Config -> Either FilePath Cluster
getCluster Config
cfg
          Either FilePath Cluster
-> (Cluster -> Either FilePath Text) -> Either FilePath Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe Text -> Either FilePath Text
forall b a. b -> Maybe a -> Either b a
maybeToRight FilePath
"cert file not provided"
          (Maybe Text -> Either FilePath Text)
-> (Cluster -> Maybe Text) -> Cluster -> Either FilePath Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Cluster -> Maybe Text
certificateAuthority
          Either FilePath Text
-> (Either FilePath Text -> Either FilePath FilePath)
-> Either FilePath FilePath
forall a b. a -> (a -> b) -> b
&   (Text -> FilePath)
-> Either FilePath Text -> Either FilePath FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack
          Either FilePath FilePath
-> (Either FilePath FilePath -> Either FilePath FilePath)
-> Either FilePath FilePath
forall a b. a -> (a -> b) -> b
&   (FilePath -> FilePath)
-> Either FilePath FilePath -> Either FilePath FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
dir FilePath -> FilePath -> FilePath
</>)
  case Either FilePath FilePath
eitherCertFile of
    Left  FilePath
_        -> ClientParams -> IO ClientParams
forall (m :: * -> *) a. Monad m => a -> m a
return ClientParams
tlsParams
    Right FilePath
certFile -> do
      ByteString
certText <- FilePath -> IO ByteString
B.readFile FilePath
certFile
      ClientParams -> IO ClientParams
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientParams -> IO ClientParams)
-> ClientParams -> IO ClientParams
forall a b. (a -> b) -> a -> b
$ ClientParams
-> ByteString -> Either ParseCertException ClientParams
updateClientParams ClientParams
tlsParams ByteString
certText Either ParseCertException ClientParams
-> (Either ParseCertException ClientParams -> ClientParams)
-> ClientParams
forall a b. a -> (a -> b) -> b
& ClientParams
-> Either ParseCertException ClientParams -> ClientParams
forall b a. b -> Either a b -> b
fromRight ClientParams
tlsParams

applyAuthSettings
  :: OIDCCache
  -> AuthInfo
  -> (TLS.ClientParams, K.KubernetesClientConfig)
  -> IO (TLS.ClientParams, K.KubernetesClientConfig)
applyAuthSettings :: OIDCCache
-> AuthInfo
-> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
applyAuthSettings OIDCCache
oidcCache AuthInfo
auth (ClientParams, KubernetesClientConfig)
input =
  IO (ClientParams, KubernetesClientConfig)
-> Maybe (IO (ClientParams, KubernetesClientConfig))
-> IO (ClientParams, KubernetesClientConfig)
forall a. a -> Maybe a -> a
fromMaybe ((ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientParams, KubernetesClientConfig)
input)
    (Maybe (IO (ClientParams, KubernetesClientConfig))
 -> IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
-> IO (ClientParams, KubernetesClientConfig)
forall a b. (a -> b) -> a -> b
$   DetectAuth
clientCertFileAuth AuthInfo
auth (ClientParams, KubernetesClientConfig)
input
    Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DetectAuth
clientCertDataAuth AuthInfo
auth (ClientParams, KubernetesClientConfig)
input
    Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DetectAuth
tokenAuth AuthInfo
auth (ClientParams, KubernetesClientConfig)
input
    Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DetectAuth
tokenFileAuth AuthInfo
auth (ClientParams, KubernetesClientConfig)
input
    Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DetectAuth
gcpAuth AuthInfo
auth (ClientParams, KubernetesClientConfig)
input
    Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OIDCCache -> DetectAuth
cachedOIDCAuth OIDCCache
oidcCache AuthInfo
auth (ClientParams, KubernetesClientConfig)
input
    Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DetectAuth
basicAuth AuthInfo
auth (ClientParams, KubernetesClientConfig)
input