{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# 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 Control.Monad.Except                  (runExceptT)
import Data.Either.Combinators
import Data.Function                         ((&))
import Data.Map                              (Map)
import Data.Maybe
import Data.Text
import Data.Text.Encoding                    (encodeUtf8)
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

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

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

#if !MIN_VERSION_hoauth2(2,8,0)
import qualified Network.OAuth.OAuth2.TokenRequest as OAuth2TokenRequest
#endif


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)
#if MIN_VERSION_hoauth2(2,3,0)
                         , OIDCAuth -> URI
redirectUri      :: URI
#endif
                         }

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

instance AuthMethod OIDCAuth where
  applyAuthMethod :: forall req contentType res accept.
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 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
-> [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 (f :: * -> *).
Functor f =>
([TypeRep] -> f [TypeRep])
-> KubernetesRequest req contentType res accept
-> f (KubernetesRequest req contentType res accept)
rAuthTypesL []

data OIDCGetTokenException =
#if MIN_VERSION_hoauth2(2,9,0)
  OIDCOAuthException TokenResponseError
#elif MIN_VERSION_hoauth2(2,8,0)
  OIDCOAuthException TokenRequestError
#else
  OIDCOAuthException (OAuth2Error OAuth2TokenRequest.Errors)
#endif
  | 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
$cshowsPrec :: Int -> OIDCGetTokenException -> ShowS
showsPrec :: Int -> OIDCGetTokenException -> ShowS
$cshow :: OIDCGetTokenException -> String
show :: OIDCGetTokenException -> String
$cshowList :: [OIDCGetTokenException] -> ShowS
showList :: [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
$cshowsPrec :: Int -> OIDCAuthParsingException -> ShowS
showsPrec :: Int -> OIDCAuthParsingException -> ShowS
$cshow :: OIDCAuthParsingException -> String
show :: OIDCAuthParsingException -> String
$cshowList :: [OIDCAuthParsingException] -> ShowS
showList :: [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
URI
issuerURL :: OIDCAuth -> Text
clientID :: OIDCAuth -> Text
clientSecret :: OIDCAuth -> Text
tlsParams :: OIDCAuth -> ClientParams
idTokenTVar :: OIDCAuth -> TVar (Maybe Text)
refreshTokenTVar :: OIDCAuth -> TVar (Maybe Text)
redirectUri :: OIDCAuth -> URI
issuerURL :: Text
clientID :: Text
clientSecret :: Text
tlsParams :: ClientParams
idTokenTVar :: TVar (Maybe Text)
refreshTokenTVar :: TVar (Maybe Text)
redirectUri :: URI
..}) = 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 a. a -> IO a
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
URI
issuerURL :: OIDCAuth -> Text
clientID :: OIDCAuth -> Text
clientSecret :: OIDCAuth -> Text
tlsParams :: OIDCAuth -> ClientParams
idTokenTVar :: OIDCAuth -> TVar (Maybe Text)
refreshTokenTVar :: OIDCAuth -> TVar (Maybe Text)
redirectUri :: OIDCAuth -> URI
issuerURL :: Text
clientID :: Text
clientSecret :: Text
tlsParams :: ClientParams
idTokenTVar :: TVar (Maybe Text)
refreshTokenTVar :: TVar (Maybe Text)
redirectUri :: URI
..}) = 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.
(HasCallStack, 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
      URI
tokenURI <- URIParserOptions -> ByteString -> Either URIParseError URI
parseURI URIParserOptions
strictURIParserOptions (Text -> ByteString
Text.encodeUtf8 Text
tokenEndpoint)
                  Either URIParseError URI
-> (Either URIParseError URI -> IO URI) -> IO URI
forall a b. a -> (a -> b) -> b
& (URIParseError -> IO URI)
-> (URI -> IO URI) -> Either URIParseError URI -> IO URI
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (OIDCGetTokenException -> IO URI
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM (OIDCGetTokenException -> IO URI)
-> (URIParseError -> OIDCGetTokenException)
-> URIParseError
-> IO URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParseError -> OIDCGetTokenException
OIDCURIException) URI -> IO URI
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

#if MIN_VERSION_hoauth2(2,3,0)
      let oauth :: OAuth2
oauth = OAuth2{ oauth2ClientId :: Text
oauth2ClientId = Text
clientID
                        , oauth2ClientSecret :: Text
oauth2ClientSecret = Text
clientSecret
                        , oauth2AuthorizeEndpoint :: URI
oauth2AuthorizeEndpoint = URI
tokenURI
                        , oauth2TokenEndpoint :: URI
oauth2TokenEndpoint = URI
tokenURI
                        , oauth2RedirectUri :: URI
oauth2RedirectUri = URI
redirectUri
                        }
#elif MIN_VERSION_hoauth2(2,2,0)
      let oauth = OAuth2{ oauth2ClientId = clientID
                        , oauth2ClientSecret = clientSecret
                        , oauth2AuthorizeEndpoint = tokenURI
                        , oauth2TokenEndpoint = tokenURI
                        , oauth2RedirectUri = Nothing
                        }
#elif MIN_VERSION_hoauth2(2,0,0)
      let oauth = OAuth2{ oauth2ClientId = clientID
                        , oauth2ClientSecret = Just clientSecret
                        , oauth2AuthorizeEndpoint = tokenURI
                        , oauth2TokenEndpoint = tokenURI
                        , oauth2RedirectUri = Nothing
                        }
#else
      let oauth = OAuth2{ oauthClientId = clientID
                        , oauthClientSecret = Just clientSecret
                        , oauthAccessTokenEndpoint = tokenURI
                        , oauthOAuthorizeEndpoint = tokenURI
                        , oauthCallback = Nothing
                        }
#endif

#if MIN_VERSION_hoauth2(2,2,0)
      OAuth2Token
oauthToken <- ExceptT TokenResponseError IO OAuth2Token
-> IO (Either TokenResponseError OAuth2Token)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenResponseError IO OAuth2Token
forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenResponseError m OAuth2Token
refreshAccessToken Manager
mgr OAuth2
oauth (Text -> RefreshToken
RefreshToken Text
token)) IO (Either TokenResponseError OAuth2Token)
-> (Either TokenResponseError OAuth2Token -> IO OAuth2Token)
-> IO OAuth2Token
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TokenResponseError -> IO OAuth2Token)
-> (OAuth2Token -> IO OAuth2Token)
-> Either TokenResponseError OAuth2Token
-> IO OAuth2Token
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (OIDCGetTokenException -> IO OAuth2Token
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM (OIDCGetTokenException -> IO OAuth2Token)
-> (TokenResponseError -> OIDCGetTokenException)
-> TokenResponseError
-> IO OAuth2Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResponseError -> OIDCGetTokenException
OIDCOAuthException) OAuth2Token -> IO OAuth2Token
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
#else
      oauthToken <- (refreshAccessToken mgr oauth (RefreshToken token)) >>= either (throwM . OIDCOAuthException) pure
#endif

      case OAuth2Token -> Maybe IdToken
OAuth.idToken OAuth2Token
oauthToken of
        Maybe IdToken
Nothing -> OIDCGetTokenException -> IO Text
forall (m :: * -> *) e a.
(HasCallStack, 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 a. a -> IO a
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
URI
issuerURL :: OIDCAuth -> Text
clientID :: OIDCAuth -> Text
clientSecret :: OIDCAuth -> Text
tlsParams :: OIDCAuth -> ClientParams
idTokenTVar :: OIDCAuth -> TVar (Maybe Text)
refreshTokenTVar :: OIDCAuth -> TVar (Maybe Text)
redirectUri :: OIDCAuth -> URI
issuerURL :: Text
clientID :: Text
clientSecret :: Text
tlsParams :: ClientParams
idTokenTVar :: TVar (Maybe Text)
refreshTokenTVar :: TVar (Maybe Text)
redirectUri :: URI
..} = 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 a b. (a -> b) -> IO a -> IO b
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 a b. (a -> b) -> IO a -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM (\OIDCAuth
oidc -> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall a. a -> IO a
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 a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
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.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM OIDCAuth -> IO OIDCAuth
forall a. a -> IO a
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 a. a -> IO a
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.
(HasCallStack, 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 a. a -> m a
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

#if MIN_VERSION_hoauth2(2,3,0)
  URI
redirectUri <- case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"redirect-uri" Map Text Text
authInfo of
    Maybe Text
Nothing -> OIDCAuthParsingException -> IO URI
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM (OIDCAuthParsingException -> IO URI)
-> OIDCAuthParsingException -> IO URI
forall a b. (a -> b) -> a -> b
$ String -> OIDCAuthParsingException
OIDCAuthMissingInformation String
"redirect-uri"
    Just Text
raw -> case URIParserOptions -> ByteString -> Either URIParseError URI
parseURI URIParserOptions
laxURIParserOptions (ByteString -> Either URIParseError URI)
-> ByteString -> Either URIParseError URI
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
raw of
      Left URIParseError
err -> OIDCAuthParsingException -> IO URI
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM (OIDCAuthParsingException -> IO URI)
-> OIDCAuthParsingException -> IO URI
forall a b. (a -> b) -> a -> b
$ String -> OIDCAuthParsingException
OIDCAuthMissingInformation (String
"Couldn't parse redirect URI: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> URIParseError -> String
forall a. Show a => a -> String
show URIParseError
err)
      Right URI
x -> URI -> IO URI
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return URI
x
#endif

  Either OIDCAuthParsingException OIDCAuth
-> IO (Either OIDCAuthParsingException OIDCAuth)
forall a. a -> IO a
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 a. a -> Either OIDCAuthParsingException a
forall (m :: * -> *) a. Monad m => a -> m a
return OIDCAuth{Text
TVar (Maybe Text)
ClientParams
URI
issuerURL :: Text
clientID :: Text
clientSecret :: Text
tlsParams :: ClientParams
idTokenTVar :: TVar (Maybe Text)
refreshTokenTVar :: TVar (Maybe Text)
redirectUri :: URI
idTokenTVar :: TVar (Maybe Text)
refreshTokenTVar :: TVar (Maybe Text)
redirectUri :: URI
tlsParams :: ClientParams
issuerURL :: Text
clientID :: Text
clientSecret :: 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 a. Maybe a -> Maybe a -> Maybe a
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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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