{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Kubernetes.Client.Auth.Basic where

import           Data.ByteString.Base64         ( encode )
import           Data.Function                  ( (&) )
import           Data.Text                      ( Text )
import           Kubernetes.Client.Auth.Internal.Types
import           Kubernetes.Client.KubeConfig
import           Kubernetes.OpenAPI.Core

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid                              ((<>))
#endif

import qualified Data.Text.Encoding            as T
import qualified Lens.Micro                    as L


data BasicAuth = BasicAuth { BasicAuth -> Text
basicAuthUsername :: Text
                           , BasicAuth -> Text
basicAuthPassword :: Text
                           }

instance AuthMethod BasicAuth where
  applyAuthMethod :: forall req contentType res accept.
KubernetesClientConfig
-> BasicAuth
-> KubernetesRequest req contentType res accept
-> IO (KubernetesRequest req contentType res accept)
applyAuthMethod KubernetesClientConfig
_ BasicAuth{Text
basicAuthUsername :: BasicAuth -> Text
basicAuthPassword :: BasicAuth -> Text
basicAuthUsername :: Text
basicAuthPassword :: Text
..} KubernetesRequest req contentType res accept
req =
    KubernetesRequest req contentType res accept
-> IO (KubernetesRequest req contentType res accept)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (KubernetesRequest req contentType res accept
 -> IO (KubernetesRequest req contentType res accept))
-> KubernetesRequest req contentType res accept
-> IO (KubernetesRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$           KubernetesRequest req contentType res accept
req
      KubernetesRequest req contentType res accept
-> [Header] -> KubernetesRequest req contentType res accept
forall req contentType res accept.
KubernetesRequest req contentType res accept
-> [Header] -> KubernetesRequest req contentType res accept
`setHeader` (HeaderName, Text) -> [Header]
forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"authorization", Text
"Basic " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
encodeBasicAuth)
      KubernetesRequest req contentType res accept
-> (KubernetesRequest req contentType res accept
    -> KubernetesRequest req contentType res accept)
-> KubernetesRequest req contentType res accept
forall a b. a -> (a -> b) -> b
&           ASetter
  (KubernetesRequest req contentType res accept)
  (KubernetesRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> [TypeRep]
-> KubernetesRequest req contentType res accept
-> KubernetesRequest req contentType res accept
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  (KubernetesRequest req contentType res accept)
  (KubernetesRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept (f :: * -> *).
Functor f =>
([TypeRep] -> f [TypeRep])
-> KubernetesRequest req contentType res accept
-> f (KubernetesRequest req contentType res accept)
rAuthTypesL []
    where
      encodeBasicAuth :: Text
encodeBasicAuth = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
basicAuthUsername Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
basicAuthPassword

-- |Detects if username and password is specified in AuthConfig, if it is configures 'KubernetesClientConfig' with 'BasicAuth'
basicAuth :: DetectAuth
basicAuth :: DetectAuth
basicAuth AuthInfo
auth (ClientParams
tlsParams, KubernetesClientConfig
cfg) = do
  Text
u <- AuthInfo -> Maybe Text
username AuthInfo
auth
  Text
p <- AuthInfo -> Maybe Text
password AuthInfo
auth
  IO (ClientParams, KubernetesClientConfig)
-> Maybe (IO (ClientParams, KubernetesClientConfig))
forall a. a -> Maybe a
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
$ (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientParams
tlsParams, Text -> Text -> KubernetesClientConfig -> KubernetesClientConfig
setBasicAuth Text
u Text
p KubernetesClientConfig
cfg)

-- |Configures the 'KubernetesClientConfig' to use basic authentication.
setBasicAuth
  :: Text                 -- ^Username
  -> Text                 -- ^Password
  -> KubernetesClientConfig
  -> KubernetesClientConfig
setBasicAuth :: Text -> Text -> KubernetesClientConfig -> KubernetesClientConfig
setBasicAuth Text
u Text
p KubernetesClientConfig
kcfg = KubernetesClientConfig
kcfg
  { configAuthMethods = [AnyAuthMethod (BasicAuth u p)]
  }