{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Kubernetes.Client.Auth.OIDC
  (oidcAuth, OIDCCache, cachedOIDCAuth)
where

import Control.Applicative
import Control.Concurrent.STM
import Control.Exception.Safe                (Exception, throwM)
import Data.Either.Combinators
import Data.Function                         ((&))
import Data.Map                              (Map)
import Data.Maybe
import Data.Monoid                           ((<>))
import Data.Text
import Data.Time.Clock.POSIX                 (getPOSIXTime)
import Jose.Jwt
import Kubernetes.Client.Auth.Internal.Types
import Kubernetes.Client.Internal.TLSUtils
import Kubernetes.Client.KubeConfig
import Kubernetes.OpenAPI.Core
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.OAuth.OAuth2                  as OAuth
import Network.TLS                           as TLS
import URI.ByteString
import Web.OIDC.Client.Discovery             as OIDC

import qualified Data.ByteString                   as BS
import qualified Data.ByteString.Base64            as B64
import qualified Data.Map                          as Map
import qualified Data.Text                         as Text
import qualified Data.Text.Encoding                as Text
import qualified Lens.Micro                        as L
import qualified Network.OAuth.OAuth2.TokenRequest as OAuth2TokenRequest

data OIDCAuth = OIDCAuth { OIDCAuth -> Text
issuerURL        :: Text
                         , OIDCAuth -> Text
clientID         :: Text
                         , OIDCAuth -> Text
clientSecret     :: Text
                         , OIDCAuth -> ClientParams
tlsParams        :: TLS.ClientParams
                         , OIDCAuth -> TVar (Maybe Text)
idTokenTVar      :: TVar(Maybe Text)
                         , OIDCAuth -> TVar (Maybe Text)
refreshTokenTVar :: TVar(Maybe Text)
                         }

-- | Cache OIDCAuth based on issuerURL and clientID.
type OIDCCache = TVar (Map (Text, Text) OIDCAuth)

instance AuthMethod OIDCAuth where
  applyAuthMethod :: KubernetesClientConfig
-> OIDCAuth
-> KubernetesRequest req contentType res accept
-> IO (KubernetesRequest req contentType res accept)
applyAuthMethod KubernetesClientConfig
_ OIDCAuth
oidc KubernetesRequest req contentType res accept
req = do
    Text
token <- OIDCAuth -> IO Text
getToken OIDCAuth
oidc
    KubernetesRequest req contentType res accept
-> IO (KubernetesRequest req contentType res accept)
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
-> [Header] -> KubernetesRequest req contentType res accept
forall req contentType res accept.
KubernetesRequest req contentType res accept
-> [Header] -> KubernetesRequest req contentType res accept
setHeader KubernetesRequest req contentType res accept
req [(HeaderName
"Authorization", ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Text -> ByteString
Text.encodeUtf8 Text
token))]
      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.
Lens_' (KubernetesRequest req contentType res accept) [TypeRep]
rAuthTypesL []

data OIDCGetTokenException = OIDCOAuthException (OAuth2Error OAuth2TokenRequest.Errors)
                           | OIDCURIException URIParseError
                           | OIDCGetTokenException String
  deriving Int -> OIDCGetTokenException -> ShowS
[OIDCGetTokenException] -> ShowS
OIDCGetTokenException -> String
(Int -> OIDCGetTokenException -> ShowS)
-> (OIDCGetTokenException -> String)
-> ([OIDCGetTokenException] -> ShowS)
-> Show OIDCGetTokenException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OIDCGetTokenException] -> ShowS
$cshowList :: [OIDCGetTokenException] -> ShowS
show :: OIDCGetTokenException -> String
$cshow :: OIDCGetTokenException -> String
showsPrec :: Int -> OIDCGetTokenException -> ShowS
$cshowsPrec :: Int -> OIDCGetTokenException -> ShowS
Show
instance Exception OIDCGetTokenException

data OIDCAuthParsingException = OIDCAuthCAParsingFailed ParseCertException
                              | OIDCAuthMissingInformation String
  deriving Int -> OIDCAuthParsingException -> ShowS
[OIDCAuthParsingException] -> ShowS
OIDCAuthParsingException -> String
(Int -> OIDCAuthParsingException -> ShowS)
-> (OIDCAuthParsingException -> String)
-> ([OIDCAuthParsingException] -> ShowS)
-> Show OIDCAuthParsingException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OIDCAuthParsingException] -> ShowS
$cshowList :: [OIDCAuthParsingException] -> ShowS
show :: OIDCAuthParsingException -> String
$cshow :: OIDCAuthParsingException -> String
showsPrec :: Int -> OIDCAuthParsingException -> ShowS
$cshowsPrec :: Int -> OIDCAuthParsingException -> ShowS
Show
instance Exception OIDCAuthParsingException

-- TODO: Consider a token expired few seconds before actual expiry to account for time skew
getToken :: OIDCAuth -> IO Text
getToken :: OIDCAuth -> IO Text
getToken auth :: OIDCAuth
auth@(OIDCAuth{Text
TVar (Maybe Text)
ClientParams
refreshTokenTVar :: TVar (Maybe Text)
idTokenTVar :: TVar (Maybe Text)
tlsParams :: ClientParams
clientSecret :: Text
clientID :: Text
issuerURL :: Text
refreshTokenTVar :: OIDCAuth -> TVar (Maybe Text)
idTokenTVar :: OIDCAuth -> TVar (Maybe Text)
tlsParams :: OIDCAuth -> ClientParams
clientSecret :: OIDCAuth -> Text
clientID :: OIDCAuth -> Text
issuerURL :: OIDCAuth -> Text
..}) = do
  POSIXTime
now <- IO POSIXTime
getPOSIXTime
  Maybe Text
maybeIdToken <- TVar (Maybe Text) -> IO (Maybe Text)
forall a. TVar a -> IO a
readTVarIO TVar (Maybe Text)
idTokenTVar
  case Maybe Text
maybeIdToken of
    Maybe Text
Nothing -> OIDCAuth -> IO Text
fetchToken OIDCAuth
auth
    Just Text
idToken -> do
      let maybeExpiry :: Maybe IntDate
maybeExpiry = do
            (JwtHeader
_, JwtClaims
claims) <- ByteString -> Either JwtError (JwtHeader, JwtClaims)
forall a.
FromJSON a =>
ByteString -> Either JwtError (JwtHeader, a)
decodeClaims (Text -> ByteString
Text.encodeUtf8 Text
idToken)
                           Either JwtError (JwtHeader, JwtClaims)
-> (Either JwtError (JwtHeader, JwtClaims)
    -> Maybe (JwtHeader, JwtClaims))
-> Maybe (JwtHeader, JwtClaims)
forall a b. a -> (a -> b) -> b
& Either JwtError (JwtHeader, JwtClaims)
-> Maybe (JwtHeader, JwtClaims)
forall a b. Either a b -> Maybe b
rightToMaybe
            JwtClaims -> Maybe IntDate
jwtExp JwtClaims
claims
      case Maybe IntDate
maybeExpiry of
        Maybe IntDate
Nothing -> OIDCAuth -> IO Text
fetchToken OIDCAuth
auth
        Just (IntDate POSIXTime
expiryDate) ->
          if POSIXTime
now POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
< POSIXTime
expiryDate
          then Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
idToken
          else OIDCAuth -> IO Text
fetchToken OIDCAuth
auth

fetchToken :: OIDCAuth -> IO Text
fetchToken :: OIDCAuth -> IO Text
fetchToken auth :: OIDCAuth
auth@(OIDCAuth{Text
TVar (Maybe Text)
ClientParams
refreshTokenTVar :: TVar (Maybe Text)
idTokenTVar :: TVar (Maybe Text)
tlsParams :: ClientParams
clientSecret :: Text
clientID :: Text
issuerURL :: Text
refreshTokenTVar :: OIDCAuth -> TVar (Maybe Text)
idTokenTVar :: OIDCAuth -> TVar (Maybe Text)
tlsParams :: OIDCAuth -> ClientParams
clientSecret :: OIDCAuth -> Text
clientID :: OIDCAuth -> Text
issuerURL :: OIDCAuth -> Text
..}) = do
  Manager
mgr <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
  Maybe Text
maybeToken <- TVar (Maybe Text) -> IO (Maybe Text)
forall a. TVar a -> IO a
readTVarIO TVar (Maybe Text)
refreshTokenTVar
  case Maybe Text
maybeToken of
    Maybe Text
Nothing -> OIDCGetTokenException -> IO Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (OIDCGetTokenException -> IO Text)
-> OIDCGetTokenException -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> OIDCGetTokenException
OIDCGetTokenException String
"cannot refresh id-token without a refresh token"
    Just Text
token -> do
      Text
tokenEndpoint <- Manager -> OIDCAuth -> IO Text
fetchTokenEndpoint Manager
mgr OIDCAuth
auth
      URIRef Absolute
tokenURI <- URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
strictURIParserOptions (Text -> ByteString
Text.encodeUtf8 Text
tokenEndpoint)
                  Either URIParseError (URIRef Absolute)
-> (Either URIParseError (URIRef Absolute) -> IO (URIRef Absolute))
-> IO (URIRef Absolute)
forall a b. a -> (a -> b) -> b
& (URIParseError -> IO (URIRef Absolute))
-> (URIRef Absolute -> IO (URIRef Absolute))
-> Either URIParseError (URIRef Absolute)
-> IO (URIRef Absolute)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (OIDCGetTokenException -> IO (URIRef Absolute)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (OIDCGetTokenException -> IO (URIRef Absolute))
-> (URIParseError -> OIDCGetTokenException)
-> URIParseError
-> IO (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParseError -> OIDCGetTokenException
OIDCURIException) URIRef Absolute -> IO (URIRef Absolute)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      let oauth :: OAuth2
oauth = OAuth2 :: Text
-> Maybe Text
-> URIRef Absolute
-> URIRef Absolute
-> Maybe (URIRef Absolute)
-> OAuth2
OAuth2{ oauthClientId :: Text
oauthClientId = Text
clientID
                        , oauthClientSecret :: Maybe Text
oauthClientSecret = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
clientSecret
                        , oauthAccessTokenEndpoint :: URIRef Absolute
oauthAccessTokenEndpoint = URIRef Absolute
tokenURI
                        , oauthOAuthorizeEndpoint :: URIRef Absolute
oauthOAuthorizeEndpoint = URIRef Absolute
tokenURI
                        , oauthCallback :: Maybe (URIRef Absolute)
oauthCallback = Maybe (URIRef Absolute)
forall a. Maybe a
Nothing
                        }
      OAuth2Token
oauthToken <- Manager
-> OAuth2 -> RefreshToken -> IO (OAuth2Result Errors OAuth2Token)
refreshAccessToken Manager
mgr OAuth2
oauth (Text -> RefreshToken
RefreshToken Text
token)
                    IO (OAuth2Result Errors OAuth2Token)
-> (OAuth2Result Errors OAuth2Token -> IO OAuth2Token)
-> IO OAuth2Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (OAuth2Error Errors -> IO OAuth2Token)
-> (OAuth2Token -> IO OAuth2Token)
-> OAuth2Result Errors OAuth2Token
-> IO OAuth2Token
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (OIDCGetTokenException -> IO OAuth2Token
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (OIDCGetTokenException -> IO OAuth2Token)
-> (OAuth2Error Errors -> OIDCGetTokenException)
-> OAuth2Error Errors
-> IO OAuth2Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OAuth2Error Errors -> OIDCGetTokenException
OIDCOAuthException) OAuth2Token -> IO OAuth2Token
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      case OAuth2Token -> Maybe IdToken
OAuth.idToken OAuth2Token
oauthToken of
        Maybe IdToken
Nothing -> OIDCGetTokenException -> IO Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (OIDCGetTokenException -> IO Text)
-> OIDCGetTokenException -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> OIDCGetTokenException
OIDCGetTokenException String
"token response did not contain an id_token, either the scope \"openid\" wasn't requested upon login, or the provider doesn't support id_tokens as part of the refresh response."
        Just (IdToken Text
t) -> do
          ()
_ <- STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe Text) -> Maybe Text -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Text)
idTokenTVar (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t)
          Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t

fetchTokenEndpoint :: Manager -> OIDCAuth -> IO Text
fetchTokenEndpoint :: Manager -> OIDCAuth -> IO Text
fetchTokenEndpoint Manager
mgr OIDCAuth{Text
TVar (Maybe Text)
ClientParams
refreshTokenTVar :: TVar (Maybe Text)
idTokenTVar :: TVar (Maybe Text)
tlsParams :: ClientParams
clientSecret :: Text
clientID :: Text
issuerURL :: Text
refreshTokenTVar :: OIDCAuth -> TVar (Maybe Text)
idTokenTVar :: OIDCAuth -> TVar (Maybe Text)
tlsParams :: OIDCAuth -> ClientParams
clientSecret :: OIDCAuth -> Text
clientID :: OIDCAuth -> Text
issuerURL :: OIDCAuth -> Text
..} = do
  Text -> Manager -> IO Provider
discover Text
issuerURL Manager
mgr
    IO Provider
-> (IO Provider -> IO Configuration) -> IO Configuration
forall a b. a -> (a -> b) -> b
& ((Provider -> Configuration) -> IO Provider -> IO Configuration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Provider -> Configuration
configuration)
    IO Configuration -> (IO Configuration -> IO Text) -> IO Text
forall a b. a -> (a -> b) -> b
& ((Configuration -> Text) -> IO Configuration -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Configuration -> Text
tokenEndpoint)

{-
   Detects if auth-provier name is oidc, if it is configures the 'KubernetesClientConfig' with OIDCAuth 'AuthMethod'.
   Does not use cache, consider using 'cachedOIDCAuth'.
-}
oidcAuth :: DetectAuth
oidcAuth :: DetectAuth
oidcAuth AuthInfo{$sel:authProvider:AuthInfo :: AuthInfo -> Maybe AuthProviderConfig
authProvider = Just(AuthProviderConfig Text
"oidc" (Just Map Text Text
cfg))} (ClientParams
tls, KubernetesClientConfig
kubecfg)
  = 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
$ Map Text Text -> IO (Either OIDCAuthParsingException OIDCAuth)
parseOIDCAuthInfo Map Text Text
cfg
    IO (Either OIDCAuthParsingException OIDCAuth)
-> (Either OIDCAuthParsingException OIDCAuth
    -> IO (ClientParams, KubernetesClientConfig))
-> IO (ClientParams, KubernetesClientConfig)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (OIDCAuthParsingException
 -> IO (ClientParams, KubernetesClientConfig))
-> (OIDCAuth -> IO (ClientParams, KubernetesClientConfig))
-> Either OIDCAuthParsingException OIDCAuth
-> IO (ClientParams, KubernetesClientConfig)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either OIDCAuthParsingException
-> IO (ClientParams, KubernetesClientConfig)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (\OIDCAuth
oidc -> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientParams
tls, KubernetesClientConfig -> OIDCAuth -> KubernetesClientConfig
forall auth.
AuthMethod auth =>
KubernetesClientConfig -> auth -> KubernetesClientConfig
addAuthMethod KubernetesClientConfig
kubecfg OIDCAuth
oidc))
oidcAuth AuthInfo
_ (ClientParams, KubernetesClientConfig)
_ = Maybe (IO (ClientParams, KubernetesClientConfig))
forall a. Maybe a
Nothing

-- TODO: Consider doing this whole function atomically, as two threads may miss the cache simultaneously
{-
   Detects if auth-provier name is oidc, if it is configures the 'KubernetesClientConfig' with OIDCAuth 'AuthMethod'.
   First looks for Auth information to be present in 'OIDCCache'. If found returns that, otherwise creates new Auth information and persists it in cache.
-}
cachedOIDCAuth :: OIDCCache -> DetectAuth
cachedOIDCAuth :: OIDCCache -> DetectAuth
cachedOIDCAuth OIDCCache
cache AuthInfo{$sel:authProvider:AuthInfo :: AuthInfo -> Maybe AuthProviderConfig
authProvider = Just(AuthProviderConfig Text
"oidc" (Just Map Text Text
cfg))} (ClientParams
tls, KubernetesClientConfig
kubecfg) = 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
  Map (Text, Text) OIDCAuth
latestCache <- OIDCCache -> IO (Map (Text, Text) OIDCAuth)
forall a. TVar a -> IO a
readTVarIO OIDCCache
cache
  Text
issuerURL <- Text -> IO Text
forall (m :: * -> *). MonadThrow m => Text -> m Text
lookupOrThrow Text
"idp-issuer-url"
  Text
clientID <- Text -> IO Text
forall (m :: * -> *). MonadThrow m => Text -> m Text
lookupOrThrow Text
"client-id"
  case (Text, Text) -> Map (Text, Text) OIDCAuth -> Maybe OIDCAuth
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text
issuerURL, Text
clientID) Map (Text, Text) OIDCAuth
latestCache of
    Just OIDCAuth
cacheHit -> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ClientParams, KubernetesClientConfig)
 -> IO (ClientParams, KubernetesClientConfig))
-> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall a b. (a -> b) -> a -> b
$ OIDCAuth -> (ClientParams, KubernetesClientConfig)
forall auth.
AuthMethod auth =>
auth -> (ClientParams, KubernetesClientConfig)
newTLSAndAuth OIDCAuth
cacheHit
    Maybe OIDCAuth
Nothing -> do
      OIDCAuth
parsedAuth <- Map Text Text -> IO (Either OIDCAuthParsingException OIDCAuth)
parseOIDCAuthInfo Map Text Text
cfg
                    IO (Either OIDCAuthParsingException OIDCAuth)
-> (Either OIDCAuthParsingException OIDCAuth -> IO OIDCAuth)
-> IO OIDCAuth
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (OIDCAuthParsingException -> IO OIDCAuth)
-> (OIDCAuth -> IO OIDCAuth)
-> Either OIDCAuthParsingException OIDCAuth
-> IO OIDCAuth
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either OIDCAuthParsingException -> IO OIDCAuth
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM OIDCAuth -> IO OIDCAuth
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      let newCache :: Map (Text, Text) OIDCAuth
newCache = (Text, Text)
-> OIDCAuth
-> Map (Text, Text) OIDCAuth
-> Map (Text, Text) OIDCAuth
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Text
issuerURL, Text
clientID) OIDCAuth
parsedAuth Map (Text, Text) OIDCAuth
latestCache
      Map (Text, Text) OIDCAuth
_ <- STM (Map (Text, Text) OIDCAuth) -> IO (Map (Text, Text) OIDCAuth)
forall a. STM a -> IO a
atomically (STM (Map (Text, Text) OIDCAuth) -> IO (Map (Text, Text) OIDCAuth))
-> STM (Map (Text, Text) OIDCAuth)
-> IO (Map (Text, Text) OIDCAuth)
forall a b. (a -> b) -> a -> b
$ OIDCCache
-> Map (Text, Text) OIDCAuth -> STM (Map (Text, Text) OIDCAuth)
forall a. TVar a -> a -> STM a
swapTVar OIDCCache
cache Map (Text, Text) OIDCAuth
newCache
      (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ClientParams, KubernetesClientConfig)
 -> IO (ClientParams, KubernetesClientConfig))
-> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall a b. (a -> b) -> a -> b
$ OIDCAuth -> (ClientParams, KubernetesClientConfig)
forall auth.
AuthMethod auth =>
auth -> (ClientParams, KubernetesClientConfig)
newTLSAndAuth OIDCAuth
parsedAuth
  where lookupOrThrow :: Text -> m Text
lookupOrThrow Text
k = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text Text
cfg
                         Maybe Text -> (Maybe Text -> m Text) -> m Text
forall a b. a -> (a -> b) -> b
& m Text -> (Text -> m Text) -> Maybe Text -> m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (OIDCAuthParsingException -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (OIDCAuthParsingException -> m Text)
-> OIDCAuthParsingException -> m Text
forall a b. (a -> b) -> a -> b
$ String -> OIDCAuthParsingException
OIDCAuthMissingInformation (String -> OIDCAuthParsingException)
-> String -> OIDCAuthParsingException
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
k) Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        newTLSAndAuth :: auth -> (ClientParams, KubernetesClientConfig)
newTLSAndAuth auth
auth = (ClientParams
tls, KubernetesClientConfig -> auth -> KubernetesClientConfig
forall auth.
AuthMethod auth =>
KubernetesClientConfig -> auth -> KubernetesClientConfig
addAuthMethod KubernetesClientConfig
kubecfg auth
auth)
cachedOIDCAuth OIDCCache
_ AuthInfo
_ (ClientParams, KubernetesClientConfig)
_ = Maybe (IO (ClientParams, KubernetesClientConfig))
forall a. Maybe a
Nothing

parseOIDCAuthInfo :: Map Text Text -> IO (Either OIDCAuthParsingException OIDCAuth)
parseOIDCAuthInfo :: Map Text Text -> IO (Either OIDCAuthParsingException OIDCAuth)
parseOIDCAuthInfo Map Text Text
authInfo = do
  Either ParseCertException ClientParams
eitherTLSParams <- Map Text Text -> IO (Either ParseCertException ClientParams)
parseCA Map Text Text
authInfo
  TVar (Maybe Text)
idTokenTVar <- STM (TVar (Maybe Text)) -> IO (TVar (Maybe Text))
forall a. STM a -> IO a
atomically (STM (TVar (Maybe Text)) -> IO (TVar (Maybe Text)))
-> STM (TVar (Maybe Text)) -> IO (TVar (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Maybe Text -> STM (TVar (Maybe Text))
forall a. a -> STM (TVar a)
newTVar (Maybe Text -> STM (TVar (Maybe Text)))
-> Maybe Text -> STM (TVar (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"id-token" Map Text Text
authInfo
  TVar (Maybe Text)
refreshTokenTVar <- STM (TVar (Maybe Text)) -> IO (TVar (Maybe Text))
forall a. STM a -> IO a
atomically (STM (TVar (Maybe Text)) -> IO (TVar (Maybe Text)))
-> STM (TVar (Maybe Text)) -> IO (TVar (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Maybe Text -> STM (TVar (Maybe Text))
forall a. a -> STM (TVar a)
newTVar (Maybe Text -> STM (TVar (Maybe Text)))
-> Maybe Text -> STM (TVar (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"refresh-token" Map Text Text
authInfo
  Either OIDCAuthParsingException OIDCAuth
-> IO (Either OIDCAuthParsingException OIDCAuth)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either OIDCAuthParsingException OIDCAuth
 -> IO (Either OIDCAuthParsingException OIDCAuth))
-> Either OIDCAuthParsingException OIDCAuth
-> IO (Either OIDCAuthParsingException OIDCAuth)
forall a b. (a -> b) -> a -> b
$ do
    ClientParams
tlsParams <- (ParseCertException -> OIDCAuthParsingException)
-> Either ParseCertException ClientParams
-> Either OIDCAuthParsingException ClientParams
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ParseCertException -> OIDCAuthParsingException
OIDCAuthCAParsingFailed Either ParseCertException ClientParams
eitherTLSParams
    Text
issuerURL <- Text -> Either OIDCAuthParsingException Text
lookupEither Text
"idp-issuer-url"
    Text
clientID <- Text -> Either OIDCAuthParsingException Text
lookupEither Text
"client-id"
    Text
clientSecret <- Text -> Either OIDCAuthParsingException Text
lookupEither Text
"client-secret"
    OIDCAuth -> Either OIDCAuthParsingException OIDCAuth
forall (m :: * -> *) a. Monad m => a -> m a
return OIDCAuth :: Text
-> Text
-> Text
-> ClientParams
-> TVar (Maybe Text)
-> TVar (Maybe Text)
-> OIDCAuth
OIDCAuth{Text
TVar (Maybe Text)
ClientParams
clientSecret :: Text
clientID :: Text
issuerURL :: Text
tlsParams :: ClientParams
refreshTokenTVar :: TVar (Maybe Text)
idTokenTVar :: TVar (Maybe Text)
refreshTokenTVar :: TVar (Maybe Text)
idTokenTVar :: TVar (Maybe Text)
tlsParams :: ClientParams
clientSecret :: Text
clientID :: Text
issuerURL :: Text
..}
    where lookupEither :: Text -> Either OIDCAuthParsingException Text
lookupEither Text
k = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text Text
authInfo
                           Maybe Text
-> (Maybe Text -> Either OIDCAuthParsingException Text)
-> Either OIDCAuthParsingException Text
forall a b. a -> (a -> b) -> b
& OIDCAuthParsingException
-> Maybe Text -> Either OIDCAuthParsingException Text
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> OIDCAuthParsingException
OIDCAuthMissingInformation (String -> OIDCAuthParsingException)
-> String -> OIDCAuthParsingException
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
k)

parseCA :: Map Text Text -> IO (Either ParseCertException TLS.ClientParams)
parseCA :: Map Text Text -> IO (Either ParseCertException ClientParams)
parseCA Map Text Text
authInfo = do
  ClientParams
tlsParams <- IO ClientParams
defaultTLSClientParams
  let maybeNewParams :: Maybe (IO (Either ParseCertException ClientParams))
maybeNewParams = (ClientParams
-> Map Text Text
-> Maybe (IO (Either ParseCertException ClientParams))
parseCAFile ClientParams
tlsParams Map Text Text
authInfo
                        Maybe (IO (Either ParseCertException ClientParams))
-> Maybe (IO (Either ParseCertException ClientParams))
-> Maybe (IO (Either ParseCertException ClientParams))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ClientParams
-> Map Text Text
-> Maybe (IO (Either ParseCertException ClientParams))
parseCAData ClientParams
tlsParams Map Text Text
authInfo)
  IO (Either ParseCertException ClientParams)
-> Maybe (IO (Either ParseCertException ClientParams))
-> IO (Either ParseCertException ClientParams)
forall a. a -> Maybe a -> a
fromMaybe (Either ParseCertException ClientParams
-> IO (Either ParseCertException ClientParams)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseCertException ClientParams
 -> IO (Either ParseCertException ClientParams))
-> Either ParseCertException ClientParams
-> IO (Either ParseCertException ClientParams)
forall a b. (a -> b) -> a -> b
$ ClientParams -> Either ParseCertException ClientParams
forall a b. b -> Either a b
Right ClientParams
tlsParams) Maybe (IO (Either ParseCertException ClientParams))
maybeNewParams

parseCAFile :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either ParseCertException TLS.ClientParams))
parseCAFile :: ClientParams
-> Map Text Text
-> Maybe (IO (Either ParseCertException ClientParams))
parseCAFile ClientParams
tlsParams Map Text Text
authInfo = do
  String
caFile <- Text -> String
Text.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"idp-certificate-authority" Map Text Text
authInfo
  IO (Either ParseCertException ClientParams)
-> Maybe (IO (Either ParseCertException ClientParams))
forall a. a -> Maybe a
Just (IO (Either ParseCertException ClientParams)
 -> Maybe (IO (Either ParseCertException ClientParams)))
-> IO (Either ParseCertException ClientParams)
-> Maybe (IO (Either ParseCertException ClientParams))
forall a b. (a -> b) -> a -> b
$ do
    ByteString
caText <- String -> IO ByteString
BS.readFile String
caFile
    Either ParseCertException ClientParams
-> IO (Either ParseCertException ClientParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseCertException ClientParams
 -> IO (Either ParseCertException ClientParams))
-> Either ParseCertException ClientParams
-> IO (Either ParseCertException ClientParams)
forall a b. (a -> b) -> a -> b
$ ClientParams
-> ByteString -> Either ParseCertException ClientParams
updateClientParams ClientParams
tlsParams ByteString
caText

parseCAData :: TLS.ClientParams -> Map Text Text -> Maybe (IO (Either ParseCertException TLS.ClientParams))
parseCAData :: ClientParams
-> Map Text Text
-> Maybe (IO (Either ParseCertException ClientParams))
parseCAData ClientParams
tlsParams Map Text Text
authInfo = do
  Text
caBase64 <- Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"idp-certificate-authority-data" Map Text Text
authInfo
  IO (Either ParseCertException ClientParams)
-> Maybe (IO (Either ParseCertException ClientParams))
forall a. a -> Maybe a
Just (IO (Either ParseCertException ClientParams)
 -> Maybe (IO (Either ParseCertException ClientParams)))
-> IO (Either ParseCertException ClientParams)
-> Maybe (IO (Either ParseCertException ClientParams))
forall a b. (a -> b) -> a -> b
$ Either ParseCertException ClientParams
-> IO (Either ParseCertException ClientParams)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseCertException ClientParams
 -> IO (Either ParseCertException ClientParams))
-> Either ParseCertException ClientParams
-> IO (Either ParseCertException ClientParams)
forall a b. (a -> b) -> a -> b
$ do
    ByteString
caText <- ByteString -> Either String ByteString
B64.decode (Text -> ByteString
Text.encodeUtf8 Text
caBase64)
              Either String ByteString
-> (Either String ByteString
    -> Either ParseCertException ByteString)
-> Either ParseCertException ByteString
forall a b. a -> (a -> b) -> b
& (String -> ParseCertException)
-> Either String ByteString -> Either ParseCertException ByteString
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> ParseCertException
Base64ParsingFailed
    ClientParams
-> ByteString -> Either ParseCertException ClientParams
updateClientParams ClientParams
tlsParams ByteString
caText