module Kubernetes.Client.Auth.ClientCert where

import Control.Exception.Safe                (Exception, throwM)
import Data.Text.Encoding
import Kubernetes.Client.Auth.Internal.Types
import Kubernetes.Client.Internal.TLSUtils
import Kubernetes.Client.KubeConfig
import Kubernetes.OpenAPI                    (KubernetesClientConfig (..))
import Network.TLS

-- | Detects if kuebconfig file provides 'client-certificate', if it configures TLS client params with the client certificate
clientCertFileAuth :: DetectAuth
clientCertFileAuth :: DetectAuth
clientCertFileAuth AuthInfo
auth (ClientParams
tlsParams, KubernetesClientConfig
cfg) = do
  FilePath
certFile <- AuthInfo -> Maybe FilePath
clientCertificate AuthInfo
auth
  FilePath
keyFile <- AuthInfo -> Maybe FilePath
clientKey AuthInfo
auth
  IO (ClientParams, KubernetesClientConfig)
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (ClientParams, KubernetesClientConfig)
 -> Maybe (IO (ClientParams, KubernetesClientConfig)))
-> IO (ClientParams, KubernetesClientConfig)
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall a b. (a -> b) -> a -> b
$ do
    Credential
cert <- FilePath -> FilePath -> IO (Either FilePath Credential)
credentialLoadX509 FilePath
certFile FilePath
keyFile
            IO (Either FilePath Credential)
-> (Either FilePath Credential -> IO Credential) -> IO Credential
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Credential)
-> (Credential -> IO Credential)
-> Either FilePath Credential
-> IO Credential
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CredentialLoadException -> IO Credential
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CredentialLoadException -> IO Credential)
-> (FilePath -> CredentialLoadException)
-> FilePath
-> IO Credential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> CredentialLoadException
CredentialLoadException) Credential -> IO Credential
forall (m :: * -> *) a. Monad m => a -> m a
return
    let newParams :: ClientParams
newParams = (Credential -> ClientParams -> ClientParams
setClientCert Credential
cert ClientParams
tlsParams)
        newCfg :: KubernetesClientConfig
newCfg = (KubernetesClientConfig -> KubernetesClientConfig
disableValidateAuthMethods KubernetesClientConfig
cfg)
    (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientParams
newParams, KubernetesClientConfig
newCfg)

-- | Detects if kuebconfig file provides 'client-certificate-data', if it configures TLS client params with the client certificate
clientCertDataAuth :: DetectAuth
clientCertDataAuth :: DetectAuth
clientCertDataAuth AuthInfo
auth (ClientParams
tlsParams, KubernetesClientConfig
cfg) = do
  ByteString
certB64 <- Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AuthInfo -> Maybe Text
clientCertificateData AuthInfo
auth
  ByteString
keyB64 <- Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AuthInfo -> Maybe Text
clientKeyData AuthInfo
auth
  IO (ClientParams, KubernetesClientConfig)
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall a. a -> Maybe a
Just (IO (ClientParams, KubernetesClientConfig)
 -> Maybe (IO (ClientParams, KubernetesClientConfig)))
-> IO (ClientParams, KubernetesClientConfig)
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall a b. (a -> b) -> a -> b
$  do
    Credential
cert <- ByteString -> ByteString -> IO Credential
forall (m :: * -> *).
MonadThrow m =>
ByteString -> ByteString -> m Credential
loadB64EncodedCert ByteString
certB64 ByteString
keyB64
    let newParams :: ClientParams
newParams = (Credential -> ClientParams -> ClientParams
setClientCert Credential
cert ClientParams
tlsParams)
        newCfg :: KubernetesClientConfig
newCfg = (KubernetesClientConfig -> KubernetesClientConfig
disableValidateAuthMethods KubernetesClientConfig
cfg)
    (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientParams
newParams, KubernetesClientConfig
newCfg)

-- |Disables the client-side auth methods validation. This is necessary if you are using client cert authentication.
disableValidateAuthMethods :: KubernetesClientConfig -> KubernetesClientConfig
disableValidateAuthMethods :: KubernetesClientConfig -> KubernetesClientConfig
disableValidateAuthMethods KubernetesClientConfig
kcfg = KubernetesClientConfig
kcfg { configValidateAuthMethods :: Bool
configValidateAuthMethods = Bool
False }

data CredentialLoadException = CredentialLoadException String
  deriving Int -> CredentialLoadException -> ShowS
[CredentialLoadException] -> ShowS
CredentialLoadException -> FilePath
(Int -> CredentialLoadException -> ShowS)
-> (CredentialLoadException -> FilePath)
-> ([CredentialLoadException] -> ShowS)
-> Show CredentialLoadException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CredentialLoadException] -> ShowS
$cshowList :: [CredentialLoadException] -> ShowS
show :: CredentialLoadException -> FilePath
$cshow :: CredentialLoadException -> FilePath
showsPrec :: Int -> CredentialLoadException -> ShowS
$cshowsPrec :: Int -> CredentialLoadException -> ShowS
Show

instance Exception CredentialLoadException