{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Kubernetes.Client.Auth.GCP
  ( gcpAuth )
where

import Control.Concurrent.STM
import Control.Exception.Safe                (Exception, throwM)
import Data.Either.Combinators
import Data.Function                         ((&))
import Data.JSONPath
import Data.Map                              (Map)
import Data.Text                             (Text)
import Data.Time.Clock
import Data.Time.LocalTime
import Data.Time.RFC3339
import Kubernetes.Client.Auth.Internal.Types
import Kubernetes.Client.KubeConfig
import Kubernetes.Data.K8sJSONPath
import Kubernetes.OpenAPI.Core
import System.Process.Typed

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

import qualified Data.Aeson         as Aeson
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

-- TODO: Add support for scopes based token fetching
data GCPAuth = GCPAuth { GCPAuth -> TVar (Maybe Text)
gcpAccessToken :: TVar(Maybe Text)
                       , GCPAuth -> TVar (Maybe UTCTime)
gcpTokenExpiry :: TVar(Maybe UTCTime)
                       , GCPAuth -> ProcessConfig () () ()
gcpCmd         :: ProcessConfig () () ()
                       , GCPAuth -> [K8sPathElement]
gcpTokenKey    :: [K8sPathElement]
                       , GCPAuth -> [K8sPathElement]
gcpExpiryKey   :: [K8sPathElement]
                       }

instance AuthMethod GCPAuth where
  applyAuthMethod :: forall req contentType res accept.
KubernetesClientConfig
-> GCPAuth
-> KubernetesRequest req contentType res accept
-> IO (KubernetesRequest req contentType res accept)
applyAuthMethod KubernetesClientConfig
_ GCPAuth
gcp KubernetesRequest req contentType res accept
req = do
    Text
token <- GCPAuth -> IO (Either GCPGetTokenException Text)
getToken GCPAuth
gcp
             IO (Either GCPGetTokenException Text)
-> (Either GCPGetTokenException Text -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GCPGetTokenException -> IO Text)
-> (Text -> IO Text) -> Either GCPGetTokenException Text -> IO Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GCPGetTokenException -> IO Text
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM Text -> IO Text
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)
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 []

-- |Detects if auth-provier name is gcp, if it is configures the 'KubernetesClientConfig' with GCPAuth 'AuthMethod'
gcpAuth :: DetectAuth
gcpAuth :: DetectAuth
gcpAuth AuthInfo{$sel:authProvider:AuthInfo :: AuthInfo -> Maybe AuthProviderConfig
authProvider = Just(AuthProviderConfig Text
"gcp" (Just Map Text Text
cfg))} (ClientParams
tlsParams, 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
      Either GCPAuthParsingException GCPAuth
configOrErr <- Map Text Text -> IO (Either GCPAuthParsingException GCPAuth)
parseGCPAuthInfo Map Text Text
cfg
      case Either GCPAuthParsingException GCPAuth
configOrErr of
        Left GCPAuthParsingException
err  -> GCPAuthParsingException
-> IO (ClientParams, KubernetesClientConfig)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM GCPAuthParsingException
err
        Right GCPAuth
gcp -> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientParams
tlsParams, KubernetesClientConfig -> GCPAuth -> KubernetesClientConfig
forall auth.
AuthMethod auth =>
KubernetesClientConfig -> auth -> KubernetesClientConfig
addAuthMethod KubernetesClientConfig
kubecfg GCPAuth
gcp)
gcpAuth AuthInfo
_ (ClientParams, KubernetesClientConfig)
_ = Maybe (IO (ClientParams, KubernetesClientConfig))
forall a. Maybe a
Nothing

data GCPAuthParsingException = GCPAuthMissingInformation String
                             | GCPAuthInvalidExpiry String
                             | GCPAuthInvalidTokenJSONPath String
                             | GCPAuthInvalidExpiryJSONPath String
  deriving Int -> GCPAuthParsingException -> ShowS
[GCPAuthParsingException] -> ShowS
GCPAuthParsingException -> String
(Int -> GCPAuthParsingException -> ShowS)
-> (GCPAuthParsingException -> String)
-> ([GCPAuthParsingException] -> ShowS)
-> Show GCPAuthParsingException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GCPAuthParsingException -> ShowS
showsPrec :: Int -> GCPAuthParsingException -> ShowS
$cshow :: GCPAuthParsingException -> String
show :: GCPAuthParsingException -> String
$cshowList :: [GCPAuthParsingException] -> ShowS
showList :: [GCPAuthParsingException] -> ShowS
Show
instance Exception GCPAuthParsingException

data GCPGetTokenException = GCPCmdProducedInvalidJSON String
                          | GCPTokenNotFound String
                          | GCPTokenExpiryNotFound String
                          | GCPTokenExpiryInvalid String
  deriving Int -> GCPGetTokenException -> ShowS
[GCPGetTokenException] -> ShowS
GCPGetTokenException -> String
(Int -> GCPGetTokenException -> ShowS)
-> (GCPGetTokenException -> String)
-> ([GCPGetTokenException] -> ShowS)
-> Show GCPGetTokenException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GCPGetTokenException -> ShowS
showsPrec :: Int -> GCPGetTokenException -> ShowS
$cshow :: GCPGetTokenException -> String
show :: GCPGetTokenException -> String
$cshowList :: [GCPGetTokenException] -> ShowS
showList :: [GCPGetTokenException] -> ShowS
Show
instance Exception GCPGetTokenException

getToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
getToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
getToken auth :: GCPAuth
auth@(GCPAuth{}) = GCPAuth -> IO (Maybe Text)
getCurrentToken GCPAuth
auth IO (Maybe Text)
-> (Maybe Text -> IO (Either GCPGetTokenException Text))
-> IO (Either GCPGetTokenException Text)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Either GCPGetTokenException Text)
-> (Text -> IO (Either GCPGetTokenException Text))
-> Maybe Text
-> IO (Either GCPGetTokenException Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GCPAuth -> IO (Either GCPGetTokenException Text)
fetchToken GCPAuth
auth) (Either GCPGetTokenException Text
-> IO (Either GCPGetTokenException Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GCPGetTokenException Text
 -> IO (Either GCPGetTokenException Text))
-> (Text -> Either GCPGetTokenException Text)
-> Text
-> IO (Either GCPGetTokenException Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either GCPGetTokenException Text
forall a b. b -> Either a b
Right)

getCurrentToken :: GCPAuth -> IO (Maybe Text)
getCurrentToken :: GCPAuth -> IO (Maybe Text)
getCurrentToken (GCPAuth{[K8sPathElement]
TVar (Maybe Text)
TVar (Maybe UTCTime)
ProcessConfig () () ()
gcpAccessToken :: GCPAuth -> TVar (Maybe Text)
gcpTokenExpiry :: GCPAuth -> TVar (Maybe UTCTime)
gcpCmd :: GCPAuth -> ProcessConfig () () ()
gcpTokenKey :: GCPAuth -> [K8sPathElement]
gcpExpiryKey :: GCPAuth -> [K8sPathElement]
gcpAccessToken :: TVar (Maybe Text)
gcpTokenExpiry :: TVar (Maybe UTCTime)
gcpCmd :: ProcessConfig () () ()
gcpTokenKey :: [K8sPathElement]
gcpExpiryKey :: [K8sPathElement]
..}) = do
  UTCTime
now <- IO UTCTime
getCurrentTime
  Maybe UTCTime
maybeExpiry <- TVar (Maybe UTCTime) -> IO (Maybe UTCTime)
forall a. TVar a -> IO a
readTVarIO TVar (Maybe UTCTime)
gcpTokenExpiry
  Maybe Text
maybeToken <- TVar (Maybe Text) -> IO (Maybe Text)
forall a. TVar a -> IO a
readTVarIO TVar (Maybe Text)
gcpAccessToken
  Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
expiry <- Maybe UTCTime
maybeExpiry
    if UTCTime
expiry UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
now
      then Maybe Text
maybeToken
      else Maybe Text
forall a. Maybe a
Nothing

fetchToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
fetchToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
fetchToken GCPAuth{[K8sPathElement]
TVar (Maybe Text)
TVar (Maybe UTCTime)
ProcessConfig () () ()
gcpAccessToken :: GCPAuth -> TVar (Maybe Text)
gcpTokenExpiry :: GCPAuth -> TVar (Maybe UTCTime)
gcpCmd :: GCPAuth -> ProcessConfig () () ()
gcpTokenKey :: GCPAuth -> [K8sPathElement]
gcpExpiryKey :: GCPAuth -> [K8sPathElement]
gcpAccessToken :: TVar (Maybe Text)
gcpTokenExpiry :: TVar (Maybe UTCTime)
gcpCmd :: ProcessConfig () () ()
gcpTokenKey :: [K8sPathElement]
gcpExpiryKey :: [K8sPathElement]
..} = do
  (ByteString
stdOut, ByteString
_) <- ProcessConfig () () () -> IO (ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_ ProcessConfig () () ()
gcpCmd
  case ByteString -> Either GCPGetTokenException (Text, UTCTime)
parseTokenAndExpiry ByteString
stdOut of
    Left GCPGetTokenException
err -> Either GCPGetTokenException Text
-> IO (Either GCPGetTokenException Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GCPGetTokenException Text
 -> IO (Either GCPGetTokenException Text))
-> Either GCPGetTokenException Text
-> IO (Either GCPGetTokenException Text)
forall a b. (a -> b) -> a -> b
$ GCPGetTokenException -> Either GCPGetTokenException Text
forall a b. a -> Either a b
Left GCPGetTokenException
err
    Right (Text
token, UTCTime
expiry) -> do
      STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        TVar (Maybe Text) -> Maybe Text -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Text)
gcpAccessToken (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
token)
        TVar (Maybe UTCTime) -> Maybe UTCTime -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe UTCTime)
gcpTokenExpiry (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
expiry)
      Either GCPGetTokenException Text
-> IO (Either GCPGetTokenException Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GCPGetTokenException Text
 -> IO (Either GCPGetTokenException Text))
-> Either GCPGetTokenException Text
-> IO (Either GCPGetTokenException Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either GCPGetTokenException Text
forall a b. b -> Either a b
Right Text
token
  where
    parseTokenAndExpiry :: ByteString -> Either GCPGetTokenException (Text, UTCTime)
parseTokenAndExpiry ByteString
credsStr = do
      Value
credsJSON <- ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
credsStr
                   Either String Value
-> (Either String Value -> Either GCPGetTokenException Value)
-> Either GCPGetTokenException Value
forall a b. a -> (a -> b) -> b
& (String -> GCPGetTokenException)
-> Either String Value -> Either GCPGetTokenException Value
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> GCPGetTokenException
GCPCmdProducedInvalidJSON
      Text
token <- [K8sPathElement] -> Value -> Either String Text
runJSONPath [K8sPathElement]
gcpTokenKey Value
credsJSON
               Either String Text
-> (Either String Text -> Either GCPGetTokenException Text)
-> Either GCPGetTokenException Text
forall a b. a -> (a -> b) -> b
& (String -> GCPGetTokenException)
-> Either String Text -> Either GCPGetTokenException Text
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> GCPGetTokenException
GCPTokenNotFound
      Text
expText <- [K8sPathElement] -> Value -> Either String Text
runJSONPath [K8sPathElement]
gcpExpiryKey Value
credsJSON
                 Either String Text
-> (Either String Text -> Either GCPGetTokenException Text)
-> Either GCPGetTokenException Text
forall a b. a -> (a -> b) -> b
& (String -> GCPGetTokenException)
-> Either String Text -> Either GCPGetTokenException Text
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> GCPGetTokenException
GCPTokenExpiryNotFound
      UTCTime
expiry <- Text -> Either String UTCTime
parseExpiryTime Text
expText
                Either String UTCTime
-> (Either String UTCTime -> Either GCPGetTokenException UTCTime)
-> Either GCPGetTokenException UTCTime
forall a b. a -> (a -> b) -> b
& (String -> GCPGetTokenException)
-> Either String UTCTime -> Either GCPGetTokenException UTCTime
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> GCPGetTokenException
GCPTokenExpiryInvalid
      (Text, UTCTime) -> Either GCPGetTokenException (Text, UTCTime)
forall a. a -> Either GCPGetTokenException a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
token, UTCTime
expiry)

parseGCPAuthInfo :: Map Text Text -> IO (Either GCPAuthParsingException GCPAuth)
parseGCPAuthInfo :: Map Text Text -> IO (Either GCPAuthParsingException GCPAuth)
parseGCPAuthInfo Map Text Text
authInfo = do
  TVar (Maybe Text)
gcpAccessToken <- 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
"access-token" Map Text Text
authInfo
  Either String (TVar (Maybe UTCTime))
eitherGCPExpiryToken <- Either String (IO (TVar (Maybe UTCTime)))
-> IO (Either String (TVar (Maybe UTCTime)))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
Either String (m a) -> m (Either String a)
sequence (Either String (IO (TVar (Maybe UTCTime)))
 -> IO (Either String (TVar (Maybe UTCTime))))
-> Either String (IO (TVar (Maybe UTCTime)))
-> IO (Either String (TVar (Maybe UTCTime)))
forall a b. (a -> b) -> a -> b
$ (Maybe UTCTime -> IO (TVar (Maybe UTCTime)))
-> Either String (Maybe UTCTime)
-> Either String (IO (TVar (Maybe UTCTime)))
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (STM (TVar (Maybe UTCTime)) -> IO (TVar (Maybe UTCTime))
forall a. STM a -> IO a
atomically (STM (TVar (Maybe UTCTime)) -> IO (TVar (Maybe UTCTime)))
-> (Maybe UTCTime -> STM (TVar (Maybe UTCTime)))
-> Maybe UTCTime
-> IO (TVar (Maybe UTCTime))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UTCTime -> STM (TVar (Maybe UTCTime))
forall a. a -> STM (TVar a)
newTVar) Either String (Maybe UTCTime)
lookupAndParseExpiry
  Either GCPAuthParsingException GCPAuth
-> IO (Either GCPAuthParsingException GCPAuth)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GCPAuthParsingException GCPAuth
 -> IO (Either GCPAuthParsingException GCPAuth))
-> Either GCPAuthParsingException GCPAuth
-> IO (Either GCPAuthParsingException GCPAuth)
forall a b. (a -> b) -> a -> b
$ do
    TVar (Maybe UTCTime)
gcpTokenExpiry <- (String -> GCPAuthParsingException)
-> Either String (TVar (Maybe UTCTime))
-> Either GCPAuthParsingException (TVar (Maybe UTCTime))
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> GCPAuthParsingException
GCPAuthInvalidExpiry Either String (TVar (Maybe UTCTime))
eitherGCPExpiryToken
    String
cmdPath <- Text -> String
Text.unpack (Text -> String)
-> Either GCPAuthParsingException Text
-> Either GCPAuthParsingException String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either GCPAuthParsingException Text
lookupEither Text
"cmd-path"
    [Text]
cmdArgs <- HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
" " (Text -> [Text])
-> Either GCPAuthParsingException Text
-> Either GCPAuthParsingException [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either GCPAuthParsingException Text
lookupEither Text
"cmd-args"
    [K8sPathElement]
gcpTokenKey <- Text -> [K8sPathElement] -> Either String [K8sPathElement]
readJSONPath Text
"token-key" [[JSONPathElement] -> K8sPathElement
JSONPath [Text -> JSONPathElement
KeyChild Text
"token_expiry"]]
                   Either String [K8sPathElement]
-> (Either String [K8sPathElement]
    -> Either GCPAuthParsingException [K8sPathElement])
-> Either GCPAuthParsingException [K8sPathElement]
forall a b. a -> (a -> b) -> b
& (String -> GCPAuthParsingException)
-> Either String [K8sPathElement]
-> Either GCPAuthParsingException [K8sPathElement]
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> GCPAuthParsingException
GCPAuthInvalidTokenJSONPath
    [K8sPathElement]
gcpExpiryKey <- Text -> [K8sPathElement] -> Either String [K8sPathElement]
readJSONPath Text
"expiry-key" [[JSONPathElement] -> K8sPathElement
JSONPath [Text -> JSONPathElement
KeyChild Text
"access_token"]]
                    Either String [K8sPathElement]
-> (Either String [K8sPathElement]
    -> Either GCPAuthParsingException [K8sPathElement])
-> Either GCPAuthParsingException [K8sPathElement]
forall a b. a -> (a -> b) -> b
& (String -> GCPAuthParsingException)
-> Either String [K8sPathElement]
-> Either GCPAuthParsingException [K8sPathElement]
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> GCPAuthParsingException
GCPAuthInvalidExpiryJSONPath
    let gcpCmd :: ProcessConfig () () ()
gcpCmd = String -> [String] -> ProcessConfig () () ()
proc String
cmdPath ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
Text.unpack [Text]
cmdArgs)
    GCPAuth -> Either GCPAuthParsingException GCPAuth
forall a. a -> Either GCPAuthParsingException a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GCPAuth -> Either GCPAuthParsingException GCPAuth)
-> GCPAuth -> Either GCPAuthParsingException GCPAuth
forall a b. (a -> b) -> a -> b
$ GCPAuth{[K8sPathElement]
TVar (Maybe Text)
TVar (Maybe UTCTime)
ProcessConfig () () ()
gcpAccessToken :: TVar (Maybe Text)
gcpTokenExpiry :: TVar (Maybe UTCTime)
gcpCmd :: ProcessConfig () () ()
gcpTokenKey :: [K8sPathElement]
gcpExpiryKey :: [K8sPathElement]
gcpAccessToken :: TVar (Maybe Text)
gcpTokenExpiry :: TVar (Maybe UTCTime)
gcpTokenKey :: [K8sPathElement]
gcpExpiryKey :: [K8sPathElement]
gcpCmd :: ProcessConfig () () ()
..}
  where
    lookupAndParseExpiry :: Either String (Maybe UTCTime)
lookupAndParseExpiry =
      case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"expiry" Map Text Text
authInfo of
        Maybe Text
Nothing         -> Maybe UTCTime -> Either String (Maybe UTCTime)
forall a b. b -> Either a b
Right Maybe UTCTime
forall a. Maybe a
Nothing
        Just Text
expiryText -> UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime)
-> Either String UTCTime -> Either String (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either String UTCTime
parseExpiryTime Text
expiryText
    lookupEither :: Text -> Either GCPAuthParsingException Text
lookupEither Text
key = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key Map Text Text
authInfo
                       Maybe Text
-> (Maybe Text -> Either GCPAuthParsingException Text)
-> Either GCPAuthParsingException Text
forall a b. a -> (a -> b) -> b
& GCPAuthParsingException
-> Maybe Text -> Either GCPAuthParsingException Text
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> GCPAuthParsingException
GCPAuthMissingInformation (String -> GCPAuthParsingException)
-> String -> GCPAuthParsingException
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
key)
    readJSONPath :: Text -> [K8sPathElement] -> Either String [K8sPathElement]
readJSONPath Text
key [K8sPathElement]
defaultPath =
      Either String [K8sPathElement]
-> (Text -> Either String [K8sPathElement])
-> Maybe Text
-> Either String [K8sPathElement]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([K8sPathElement] -> Either String [K8sPathElement]
forall a b. b -> Either a b
Right [K8sPathElement]
defaultPath) Text -> Either String [K8sPathElement]
parseK8sJSONPath (Maybe Text -> Either String [K8sPathElement])
-> Maybe Text -> Either String [K8sPathElement]
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
key Map Text Text
authInfo

parseExpiryTime :: Text -> Either String UTCTime
parseExpiryTime :: Text -> Either String UTCTime
parseExpiryTime Text
expiryText =
  ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime) -> Maybe ZonedTime -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe ZonedTime
forall t. TextualMonoid t => t -> Maybe ZonedTime
parseTimeRFC3339 Text
expiryText
  Maybe UTCTime
-> (Maybe UTCTime -> Either String UTCTime)
-> Either String UTCTime
forall a b. a -> (a -> b) -> b
& String -> Maybe UTCTime -> Either String UTCTime
forall b a. b -> Maybe a -> Either b a
maybeToRight (String
"failed to parse token expiry time " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
expiryText)