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

import Control.Concurrent.STM
import Control.Exception.Safe                (Exception, throwM)
import Data.Attoparsec.Text
import Data.Either.Combinators
import Data.Function                         ((&))
import Data.JSONPath
import Data.Map                              (Map)
import Data.Monoid                           ((<>))
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

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 :: 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 (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. (MonadThrow m, Exception e) => e -> m a
throwM Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    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 []

-- |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. (MonadThrow m, Exception e) => e -> m a
throwM GCPAuthParsingException
err
        Right GCPAuth
gcp -> (ClientParams, KubernetesClientConfig)
-> IO (ClientParams, KubernetesClientConfig)
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
showList :: [GCPAuthParsingException] -> ShowS
$cshowList :: [GCPAuthParsingException] -> ShowS
show :: GCPAuthParsingException -> String
$cshow :: GCPAuthParsingException -> String
showsPrec :: Int -> GCPAuthParsingException -> ShowS
$cshowsPrec :: Int -> 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
showList :: [GCPGetTokenException] -> ShowS
$cshowList :: [GCPGetTokenException] -> ShowS
show :: GCPGetTokenException -> String
$cshow :: GCPGetTokenException -> String
showsPrec :: Int -> GCPGetTokenException -> ShowS
$cshowsPrec :: Int -> GCPGetTokenException -> ShowS
Show
instance Exception GCPGetTokenException

getToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
getToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
getToken auth :: GCPAuth
auth@(GCPAuth{[K8sPathElement]
TVar (Maybe Text)
TVar (Maybe UTCTime)
ProcessConfig () () ()
gcpExpiryKey :: [K8sPathElement]
gcpTokenKey :: [K8sPathElement]
gcpCmd :: ProcessConfig () () ()
gcpTokenExpiry :: TVar (Maybe UTCTime)
gcpAccessToken :: TVar (Maybe Text)
gcpExpiryKey :: GCPAuth -> [K8sPathElement]
gcpTokenKey :: GCPAuth -> [K8sPathElement]
gcpCmd :: GCPAuth -> ProcessConfig () () ()
gcpTokenExpiry :: GCPAuth -> TVar (Maybe UTCTime)
gcpAccessToken :: GCPAuth -> TVar (Maybe Text)
..}) = GCPAuth -> IO (Maybe Text)
getCurrentToken GCPAuth
auth
                              IO (Maybe Text)
-> (Maybe Text -> IO (Either GCPGetTokenException Text))
-> IO (Either GCPGetTokenException Text)
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 (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 () () ()
gcpExpiryKey :: [K8sPathElement]
gcpTokenKey :: [K8sPathElement]
gcpCmd :: ProcessConfig () () ()
gcpTokenExpiry :: TVar (Maybe UTCTime)
gcpAccessToken :: TVar (Maybe Text)
gcpExpiryKey :: GCPAuth -> [K8sPathElement]
gcpTokenKey :: GCPAuth -> [K8sPathElement]
gcpCmd :: GCPAuth -> ProcessConfig () () ()
gcpTokenExpiry :: GCPAuth -> TVar (Maybe UTCTime)
gcpAccessToken :: GCPAuth -> TVar (Maybe Text)
..}) = 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 (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 () () ()
gcpExpiryKey :: [K8sPathElement]
gcpTokenKey :: [K8sPathElement]
gcpCmd :: ProcessConfig () () ()
gcpTokenExpiry :: TVar (Maybe UTCTime)
gcpAccessToken :: TVar (Maybe Text)
gcpExpiryKey :: GCPAuth -> [K8sPathElement]
gcpTokenKey :: GCPAuth -> [K8sPathElement]
gcpCmd :: GCPAuth -> ProcessConfig () () ()
gcpTokenExpiry :: GCPAuth -> TVar (Maybe UTCTime)
gcpAccessToken :: GCPAuth -> TVar (Maybe Text)
..} = 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 (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 (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 (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)
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 (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 (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 <- 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 (f :: * -> *) a. Applicative f => a -> f a
pure (GCPAuth -> Either GCPAuthParsingException GCPAuth)
-> GCPAuth -> Either GCPAuthParsingException GCPAuth
forall a b. (a -> b) -> a -> b
$ GCPAuth :: TVar (Maybe Text)
-> TVar (Maybe UTCTime)
-> ProcessConfig () () ()
-> [K8sPathElement]
-> [K8sPathElement]
-> GCPAuth
GCPAuth{[K8sPathElement]
TVar (Maybe Text)
TVar (Maybe UTCTime)
ProcessConfig () () ()
gcpCmd :: ProcessConfig () () ()
gcpExpiryKey :: [K8sPathElement]
gcpTokenKey :: [K8sPathElement]
gcpTokenExpiry :: TVar (Maybe UTCTime)
gcpAccessToken :: TVar (Maybe Text)
gcpExpiryKey :: [K8sPathElement]
gcpTokenKey :: [K8sPathElement]
gcpCmd :: ProcessConfig () () ()
gcpTokenExpiry :: TVar (Maybe UTCTime)
gcpAccessToken :: TVar (Maybe Text)
..}
  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)
    parseK8sJSONPath :: Text -> Either String [K8sPathElement]
parseK8sJSONPath = Parser [K8sPathElement] -> Text -> Either String [K8sPathElement]
forall a. Parser a -> Text -> Either String a
parseOnly (Parser [K8sPathElement]
k8sJSONPath Parser [K8sPathElement]
-> Parser Text () -> Parser [K8sPathElement]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput)
    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)