{-# 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 String
f) = do
  Config
kubeConfig <- String -> IO Config
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
decodeFileThrow String
f
  Text
masterURI  <-
    Cluster -> Text
server
    (Cluster -> Text) -> Either String Cluster -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Either String Cluster
getCluster Config
kubeConfig
    Either String Text -> (Either String Text -> IO Text) -> IO Text
forall a b. a -> (a -> b) -> b
&   (String -> IO Text)
-> (Text -> IO Text) -> Either String Text -> IO Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO Text -> String -> IO Text
forall a b. a -> b -> a
const (IO Text -> String -> IO Text) -> IO Text -> String -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"localhost:8080") Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
  ClientParams
tlsParams <- Config -> String -> IO ClientParams
configureTLSParams Config
kubeConfig (String -> String
takeDirectory String
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 a b. (a -> b) -> IO a -> IO b
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 String (Text, AuthInfo)
getAuthInfo Config
kubeConfig of
    Left String
_ -> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall a. a -> IO a
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 a. a -> IO a
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 :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
m (Manager, KubernetesClientConfig)
mkInClusterClientConfig = do
  [SignedCertificate]
caStore <- String -> m [SignedCertificate]
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
String -> m [SignedCertificate]
loadPEMCerts (String -> m [SignedCertificate])
-> String -> m [SignedCertificate]
forall a b. (a -> b) -> a -> b
$ String
serviceAccountDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/ca.crt"
  ClientParams
defTlsParams <- IO ClientParams -> m ClientParams
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ClientParams
defaultTLSClientParams
  Manager
mgr <- IO Manager -> m Manager
forall a. IO a -> m a
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
  String
host <- IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getEnv String
"KUBERNETES_SERVICE_HOST"
  String
port <- IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getEnv String
"KUBERNETES_SERVICE_PORT"
  KubernetesClientConfig
cfg  <- Text -> KubernetesClientConfig -> KubernetesClientConfig
setMasterURI (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"https://" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
host String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
port) (KubernetesClientConfig -> KubernetesClientConfig)
-> m KubernetesClientConfig -> m KubernetesClientConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO KubernetesClientConfig -> m KubernetesClientConfig
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO KubernetesClientConfig
K.newConfig IO KubernetesClientConfig
-> (KubernetesClientConfig -> IO KubernetesClientConfig)
-> IO KubernetesClientConfig
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> KubernetesClientConfig -> IO KubernetesClientConfig
setTokenFileAuth (String
serviceAccountDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/token"))
  (Manager, KubernetesClientConfig)
-> m (Manager, KubernetesClientConfig)
forall a. a -> m a
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 { K.configHost = (LazyB.fromStrict . T.encodeUtf8) 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 :: String
serviceAccountDir = String
"/var/run/secrets/kubernetes.io/serviceaccount"

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

addCACertFile :: Config -> FilePath -> TLS.ClientParams -> IO TLS.ClientParams
addCACertFile :: Config -> String -> ClientParams -> IO ClientParams
addCACertFile Config
cfg String
dir ClientParams
tlsParams = do
  let eitherCertFile :: Either String String
eitherCertFile =
        Config -> Either String Cluster
getCluster Config
cfg
          Either String Cluster
-> (Cluster -> Either String Text) -> Either String Text
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Text -> Either String Text
forall b a. b -> Maybe a -> Either b a
maybeToRight String
"cert file not provided"
          (Maybe Text -> Either String Text)
-> (Cluster -> Maybe Text) -> Cluster -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Cluster -> Maybe Text
certificateAuthority
          Either String Text
-> (Either String Text -> Either String String)
-> Either String String
forall a b. a -> (a -> b) -> b
&   (Text -> String) -> Either String Text -> Either String String
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack
          Either String String
-> (Either String String -> Either String String)
-> Either String String
forall a b. a -> (a -> b) -> b
&   (String -> String) -> Either String String -> Either String String
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
dir String -> String -> String
</>)
  case Either String String
eitherCertFile of
    Left  String
_        -> ClientParams -> IO ClientParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientParams
tlsParams
    Right String
certFile -> do
      ByteString
certText <- String -> IO ByteString
B.readFile String
certFile
      ClientParams -> IO ClientParams
forall a. a -> IO a
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 a. a -> IO a
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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DetectAuth
basicAuth AuthInfo
auth (ClientParams, KubernetesClientConfig)
input