{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoGeneralisedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Hasura.Backends.BigQuery.Source
  ( BigQueryConnSourceConfig (..),
    RetryOptions (..),
    BigQueryConnection (..),
    BigQuerySourceConfig (..),
    ConfigurationInput (..),
    ConfigurationInputs (..),
    ConfigurationJSON (..),
    GoogleAccessToken (GoogleAccessToken),
    PKey (unPKey),
    ServiceAccount (..),
    TokenResp (..),
  )
where

import Autodocodec (HasCodec, codec, named)
import Control.Concurrent.MVar
import Crypto.PubKey.RSA.Types qualified as Cry
import Data.Aeson qualified as J
import Data.Aeson.Casing qualified as J
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.TH qualified as J
import Data.ByteString.Lazy qualified as BL
import Data.Int qualified as Int
import Data.Text.Encoding qualified as TE
import Data.X509 qualified as X509
import Data.X509.Memory qualified as X509
import Hasura.Incremental (Cacheable (..))
import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
import Hasura.Prelude

data PKey = PKey
  { PKey -> PrivateKey
unPKey :: Cry.PrivateKey,
    PKey -> Text
originalBS :: Text
  }
  deriving (Int -> PKey -> ShowS
[PKey] -> ShowS
PKey -> String
(Int -> PKey -> ShowS)
-> (PKey -> String) -> ([PKey] -> ShowS) -> Show PKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PKey] -> ShowS
$cshowList :: [PKey] -> ShowS
show :: PKey -> String
$cshow :: PKey -> String
showsPrec :: Int -> PKey -> ShowS
$cshowsPrec :: Int -> PKey -> ShowS
Show, PKey -> PKey -> Bool
(PKey -> PKey -> Bool) -> (PKey -> PKey -> Bool) -> Eq PKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PKey -> PKey -> Bool
$c/= :: PKey -> PKey -> Bool
== :: PKey -> PKey -> Bool
$c== :: PKey -> PKey -> Bool
Eq, Typeable PKey
DataType
Constr
Typeable PKey
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PKey -> c PKey)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PKey)
-> (PKey -> Constr)
-> (PKey -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PKey))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PKey))
-> ((forall b. Data b => b -> b) -> PKey -> PKey)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PKey -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PKey -> r)
-> (forall u. (forall d. Data d => d -> u) -> PKey -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PKey -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PKey -> m PKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PKey -> m PKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PKey -> m PKey)
-> Data PKey
PKey -> DataType
PKey -> Constr
(forall b. Data b => b -> b) -> PKey -> PKey
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PKey -> c PKey
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PKey
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PKey -> u
forall u. (forall d. Data d => d -> u) -> PKey -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PKey -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PKey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PKey -> m PKey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKey -> m PKey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PKey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PKey -> c PKey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PKey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PKey)
$cPKey :: Constr
$tPKey :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PKey -> m PKey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKey -> m PKey
gmapMp :: (forall d. Data d => d -> m d) -> PKey -> m PKey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKey -> m PKey
gmapM :: (forall d. Data d => d -> m d) -> PKey -> m PKey
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PKey -> m PKey
gmapQi :: Int -> (forall d. Data d => d -> u) -> PKey -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PKey -> u
gmapQ :: (forall d. Data d => d -> u) -> PKey -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PKey -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PKey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PKey -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PKey -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PKey -> r
gmapT :: (forall b. Data b => b -> b) -> PKey -> PKey
$cgmapT :: (forall b. Data b => b -> b) -> PKey -> PKey
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PKey)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PKey)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PKey)
dataTypeOf :: PKey -> DataType
$cdataTypeOf :: PKey -> DataType
toConstr :: PKey -> Constr
$ctoConstr :: PKey -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PKey
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PKey -> c PKey
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PKey -> c PKey
$cp1Data :: Typeable PKey
Data, (forall x. PKey -> Rep PKey x)
-> (forall x. Rep PKey x -> PKey) -> Generic PKey
forall x. Rep PKey x -> PKey
forall x. PKey -> Rep PKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PKey x -> PKey
$cfrom :: forall x. PKey -> Rep PKey x
Generic, PKey -> ()
(PKey -> ()) -> NFData PKey
forall a. (a -> ()) -> NFData a
rnf :: PKey -> ()
$crnf :: PKey -> ()
NFData, Int -> PKey -> Int
PKey -> Int
(Int -> PKey -> Int) -> (PKey -> Int) -> Hashable PKey
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PKey -> Int
$chash :: PKey -> Int
hashWithSalt :: Int -> PKey -> Int
$chashWithSalt :: Int -> PKey -> Int
Hashable)

deriving instance Generic Cry.PrivateKey -- orphan

deriving instance Generic Cry.PublicKey -- orphan

deriving instance J.ToJSON Cry.PrivateKey -- orphan

deriving instance J.ToJSON Cry.PublicKey -- orphan

deriving instance Hashable Cry.PrivateKey -- orphan

deriving instance Hashable Cry.PublicKey -- orphan

instance J.FromJSON PKey where
  parseJSON :: Value -> Parser PKey
parseJSON = String -> (Text -> Parser PKey) -> Value -> Parser PKey
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"private_key" ((Text -> Parser PKey) -> Value -> Parser PKey)
-> (Text -> Parser PKey) -> Value -> Parser PKey
forall a b. (a -> b) -> a -> b
$ \Text
k ->
    case ByteString -> [PrivKey]
X509.readKeyFileFromMemory (ByteString -> [PrivKey]) -> ByteString -> [PrivKey]
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
k of
      [X509.PrivKeyRSA PrivateKey
k'] -> PKey -> Parser PKey
forall (m :: * -> *) a. Monad m => a -> m a
return (PKey -> Parser PKey) -> PKey -> Parser PKey
forall a b. (a -> b) -> a -> b
$ PrivateKey -> Text -> PKey
PKey PrivateKey
k' Text
k
      [PrivKey]
_ -> String -> Parser PKey
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unable to parse private key"

instance J.ToJSON PKey where
  toJSON :: PKey -> Value
toJSON PKey {Text
PrivateKey
originalBS :: Text
unPKey :: PrivateKey
originalBS :: PKey -> Text
unPKey :: PKey -> PrivateKey
..} = Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON Text
originalBS

newtype GoogleAccessToken
  = GoogleAccessToken Text
  deriving (Int -> GoogleAccessToken -> ShowS
[GoogleAccessToken] -> ShowS
GoogleAccessToken -> String
(Int -> GoogleAccessToken -> ShowS)
-> (GoogleAccessToken -> String)
-> ([GoogleAccessToken] -> ShowS)
-> Show GoogleAccessToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GoogleAccessToken] -> ShowS
$cshowList :: [GoogleAccessToken] -> ShowS
show :: GoogleAccessToken -> String
$cshow :: GoogleAccessToken -> String
showsPrec :: Int -> GoogleAccessToken -> ShowS
$cshowsPrec :: Int -> GoogleAccessToken -> ShowS
Show, GoogleAccessToken -> GoogleAccessToken -> Bool
(GoogleAccessToken -> GoogleAccessToken -> Bool)
-> (GoogleAccessToken -> GoogleAccessToken -> Bool)
-> Eq GoogleAccessToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GoogleAccessToken -> GoogleAccessToken -> Bool
$c/= :: GoogleAccessToken -> GoogleAccessToken -> Bool
== :: GoogleAccessToken -> GoogleAccessToken -> Bool
$c== :: GoogleAccessToken -> GoogleAccessToken -> Bool
Eq, Value -> Parser [GoogleAccessToken]
Value -> Parser GoogleAccessToken
(Value -> Parser GoogleAccessToken)
-> (Value -> Parser [GoogleAccessToken])
-> FromJSON GoogleAccessToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GoogleAccessToken]
$cparseJSONList :: Value -> Parser [GoogleAccessToken]
parseJSON :: Value -> Parser GoogleAccessToken
$cparseJSON :: Value -> Parser GoogleAccessToken
J.FromJSON, [GoogleAccessToken] -> Value
[GoogleAccessToken] -> Encoding
GoogleAccessToken -> Value
GoogleAccessToken -> Encoding
(GoogleAccessToken -> Value)
-> (GoogleAccessToken -> Encoding)
-> ([GoogleAccessToken] -> Value)
-> ([GoogleAccessToken] -> Encoding)
-> ToJSON GoogleAccessToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GoogleAccessToken] -> Encoding
$ctoEncodingList :: [GoogleAccessToken] -> Encoding
toJSONList :: [GoogleAccessToken] -> Value
$ctoJSONList :: [GoogleAccessToken] -> Value
toEncoding :: GoogleAccessToken -> Encoding
$ctoEncoding :: GoogleAccessToken -> Encoding
toJSON :: GoogleAccessToken -> Value
$ctoJSON :: GoogleAccessToken -> Value
J.ToJSON, Int -> GoogleAccessToken -> Int
GoogleAccessToken -> Int
(Int -> GoogleAccessToken -> Int)
-> (GoogleAccessToken -> Int) -> Hashable GoogleAccessToken
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GoogleAccessToken -> Int
$chash :: GoogleAccessToken -> Int
hashWithSalt :: Int -> GoogleAccessToken -> Int
$chashWithSalt :: Int -> GoogleAccessToken -> Int
Hashable, (forall x. GoogleAccessToken -> Rep GoogleAccessToken x)
-> (forall x. Rep GoogleAccessToken x -> GoogleAccessToken)
-> Generic GoogleAccessToken
forall x. Rep GoogleAccessToken x -> GoogleAccessToken
forall x. GoogleAccessToken -> Rep GoogleAccessToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GoogleAccessToken x -> GoogleAccessToken
$cfrom :: forall x. GoogleAccessToken -> Rep GoogleAccessToken x
Generic, Typeable GoogleAccessToken
DataType
Constr
Typeable GoogleAccessToken
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> GoogleAccessToken
    -> c GoogleAccessToken)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GoogleAccessToken)
-> (GoogleAccessToken -> Constr)
-> (GoogleAccessToken -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GoogleAccessToken))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c GoogleAccessToken))
-> ((forall b. Data b => b -> b)
    -> GoogleAccessToken -> GoogleAccessToken)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GoogleAccessToken -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GoogleAccessToken -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> GoogleAccessToken -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GoogleAccessToken -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> GoogleAccessToken -> m GoogleAccessToken)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GoogleAccessToken -> m GoogleAccessToken)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GoogleAccessToken -> m GoogleAccessToken)
-> Data GoogleAccessToken
GoogleAccessToken -> DataType
GoogleAccessToken -> Constr
(forall b. Data b => b -> b)
-> GoogleAccessToken -> GoogleAccessToken
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GoogleAccessToken -> c GoogleAccessToken
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GoogleAccessToken
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> GoogleAccessToken -> u
forall u. (forall d. Data d => d -> u) -> GoogleAccessToken -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GoogleAccessToken -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GoogleAccessToken -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GoogleAccessToken -> m GoogleAccessToken
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GoogleAccessToken -> m GoogleAccessToken
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GoogleAccessToken
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GoogleAccessToken -> c GoogleAccessToken
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GoogleAccessToken)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GoogleAccessToken)
$cGoogleAccessToken :: Constr
$tGoogleAccessToken :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> GoogleAccessToken -> m GoogleAccessToken
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GoogleAccessToken -> m GoogleAccessToken
gmapMp :: (forall d. Data d => d -> m d)
-> GoogleAccessToken -> m GoogleAccessToken
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GoogleAccessToken -> m GoogleAccessToken
gmapM :: (forall d. Data d => d -> m d)
-> GoogleAccessToken -> m GoogleAccessToken
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GoogleAccessToken -> m GoogleAccessToken
gmapQi :: Int -> (forall d. Data d => d -> u) -> GoogleAccessToken -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> GoogleAccessToken -> u
gmapQ :: (forall d. Data d => d -> u) -> GoogleAccessToken -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GoogleAccessToken -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GoogleAccessToken -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GoogleAccessToken -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GoogleAccessToken -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GoogleAccessToken -> r
gmapT :: (forall b. Data b => b -> b)
-> GoogleAccessToken -> GoogleAccessToken
$cgmapT :: (forall b. Data b => b -> b)
-> GoogleAccessToken -> GoogleAccessToken
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GoogleAccessToken)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GoogleAccessToken)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c GoogleAccessToken)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GoogleAccessToken)
dataTypeOf :: GoogleAccessToken -> DataType
$cdataTypeOf :: GoogleAccessToken -> DataType
toConstr :: GoogleAccessToken -> Constr
$ctoConstr :: GoogleAccessToken -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GoogleAccessToken
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GoogleAccessToken
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GoogleAccessToken -> c GoogleAccessToken
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GoogleAccessToken -> c GoogleAccessToken
$cp1Data :: Typeable GoogleAccessToken
Data, GoogleAccessToken -> ()
(GoogleAccessToken -> ()) -> NFData GoogleAccessToken
forall a. (a -> ()) -> NFData a
rnf :: GoogleAccessToken -> ()
$crnf :: GoogleAccessToken -> ()
NFData)

data TokenResp = TokenResp
  { TokenResp -> GoogleAccessToken
_trAccessToken :: GoogleAccessToken,
    TokenResp -> Integer
_trExpiresAt :: Integer -- Number of seconds until expiry from `now`, but we add `now` seconds to this for easy tracking
  }
  deriving (TokenResp -> TokenResp -> Bool
(TokenResp -> TokenResp -> Bool)
-> (TokenResp -> TokenResp -> Bool) -> Eq TokenResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenResp -> TokenResp -> Bool
$c/= :: TokenResp -> TokenResp -> Bool
== :: TokenResp -> TokenResp -> Bool
$c== :: TokenResp -> TokenResp -> Bool
Eq, Int -> TokenResp -> ShowS
[TokenResp] -> ShowS
TokenResp -> String
(Int -> TokenResp -> ShowS)
-> (TokenResp -> String)
-> ([TokenResp] -> ShowS)
-> Show TokenResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenResp] -> ShowS
$cshowList :: [TokenResp] -> ShowS
show :: TokenResp -> String
$cshow :: TokenResp -> String
showsPrec :: Int -> TokenResp -> ShowS
$cshowsPrec :: Int -> TokenResp -> ShowS
Show, Typeable TokenResp
DataType
Constr
Typeable TokenResp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TokenResp -> c TokenResp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TokenResp)
-> (TokenResp -> Constr)
-> (TokenResp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TokenResp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenResp))
-> ((forall b. Data b => b -> b) -> TokenResp -> TokenResp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TokenResp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TokenResp -> r)
-> (forall u. (forall d. Data d => d -> u) -> TokenResp -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TokenResp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TokenResp -> m TokenResp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TokenResp -> m TokenResp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TokenResp -> m TokenResp)
-> Data TokenResp
TokenResp -> DataType
TokenResp -> Constr
(forall b. Data b => b -> b) -> TokenResp -> TokenResp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenResp -> c TokenResp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenResp
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TokenResp -> u
forall u. (forall d. Data d => d -> u) -> TokenResp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenResp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenResp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenResp -> m TokenResp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenResp -> m TokenResp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenResp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenResp -> c TokenResp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenResp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenResp)
$cTokenResp :: Constr
$tTokenResp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> TokenResp -> m TokenResp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenResp -> m TokenResp
gmapMp :: (forall d. Data d => d -> m d) -> TokenResp -> m TokenResp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenResp -> m TokenResp
gmapM :: (forall d. Data d => d -> m d) -> TokenResp -> m TokenResp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenResp -> m TokenResp
gmapQi :: Int -> (forall d. Data d => d -> u) -> TokenResp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenResp -> u
gmapQ :: (forall d. Data d => d -> u) -> TokenResp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TokenResp -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenResp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenResp -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenResp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenResp -> r
gmapT :: (forall b. Data b => b -> b) -> TokenResp -> TokenResp
$cgmapT :: (forall b. Data b => b -> b) -> TokenResp -> TokenResp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenResp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenResp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TokenResp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenResp)
dataTypeOf :: TokenResp -> DataType
$cdataTypeOf :: TokenResp -> DataType
toConstr :: TokenResp -> Constr
$ctoConstr :: TokenResp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenResp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenResp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenResp -> c TokenResp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenResp -> c TokenResp
$cp1Data :: Typeable TokenResp
Data, TokenResp -> ()
(TokenResp -> ()) -> NFData TokenResp
forall a. (a -> ()) -> NFData a
rnf :: TokenResp -> ()
$crnf :: TokenResp -> ()
NFData, (forall x. TokenResp -> Rep TokenResp x)
-> (forall x. Rep TokenResp x -> TokenResp) -> Generic TokenResp
forall x. Rep TokenResp x -> TokenResp
forall x. TokenResp -> Rep TokenResp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenResp x -> TokenResp
$cfrom :: forall x. TokenResp -> Rep TokenResp x
Generic, Int -> TokenResp -> Int
TokenResp -> Int
(Int -> TokenResp -> Int)
-> (TokenResp -> Int) -> Hashable TokenResp
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TokenResp -> Int
$chash :: TokenResp -> Int
hashWithSalt :: Int -> TokenResp -> Int
$chashWithSalt :: Int -> TokenResp -> Int
Hashable)

instance J.FromJSON TokenResp where
  parseJSON :: Value -> Parser TokenResp
parseJSON = String -> (Object -> Parser TokenResp) -> Value -> Parser TokenResp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"TokenResp" ((Object -> Parser TokenResp) -> Value -> Parser TokenResp)
-> (Object -> Parser TokenResp) -> Value -> Parser TokenResp
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    GoogleAccessToken -> Integer -> TokenResp
TokenResp
      (GoogleAccessToken -> Integer -> TokenResp)
-> Parser GoogleAccessToken -> Parser (Integer -> TokenResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser GoogleAccessToken
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"access_token"
      Parser (Integer -> TokenResp) -> Parser Integer -> Parser TokenResp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"expires_in"

data ServiceAccount = ServiceAccount
  { ServiceAccount -> Text
_saClientEmail :: Text,
    ServiceAccount -> PKey
_saPrivateKey :: PKey,
    ServiceAccount -> Text
_saProjectId :: Text
  }
  deriving (ServiceAccount -> ServiceAccount -> Bool
(ServiceAccount -> ServiceAccount -> Bool)
-> (ServiceAccount -> ServiceAccount -> Bool) -> Eq ServiceAccount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceAccount -> ServiceAccount -> Bool
$c/= :: ServiceAccount -> ServiceAccount -> Bool
== :: ServiceAccount -> ServiceAccount -> Bool
$c== :: ServiceAccount -> ServiceAccount -> Bool
Eq, Int -> ServiceAccount -> ShowS
[ServiceAccount] -> ShowS
ServiceAccount -> String
(Int -> ServiceAccount -> ShowS)
-> (ServiceAccount -> String)
-> ([ServiceAccount] -> ShowS)
-> Show ServiceAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceAccount] -> ShowS
$cshowList :: [ServiceAccount] -> ShowS
show :: ServiceAccount -> String
$cshow :: ServiceAccount -> String
showsPrec :: Int -> ServiceAccount -> ShowS
$cshowsPrec :: Int -> ServiceAccount -> ShowS
Show, Typeable ServiceAccount
DataType
Constr
Typeable ServiceAccount
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ServiceAccount -> c ServiceAccount)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ServiceAccount)
-> (ServiceAccount -> Constr)
-> (ServiceAccount -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ServiceAccount))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ServiceAccount))
-> ((forall b. Data b => b -> b)
    -> ServiceAccount -> ServiceAccount)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ServiceAccount -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ServiceAccount -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ServiceAccount -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ServiceAccount -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ServiceAccount -> m ServiceAccount)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ServiceAccount -> m ServiceAccount)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ServiceAccount -> m ServiceAccount)
-> Data ServiceAccount
ServiceAccount -> DataType
ServiceAccount -> Constr
(forall b. Data b => b -> b) -> ServiceAccount -> ServiceAccount
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ServiceAccount -> c ServiceAccount
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ServiceAccount
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ServiceAccount -> u
forall u. (forall d. Data d => d -> u) -> ServiceAccount -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ServiceAccount -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ServiceAccount -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ServiceAccount -> m ServiceAccount
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ServiceAccount -> m ServiceAccount
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ServiceAccount
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ServiceAccount -> c ServiceAccount
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ServiceAccount)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ServiceAccount)
$cServiceAccount :: Constr
$tServiceAccount :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ServiceAccount -> m ServiceAccount
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ServiceAccount -> m ServiceAccount
gmapMp :: (forall d. Data d => d -> m d)
-> ServiceAccount -> m ServiceAccount
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ServiceAccount -> m ServiceAccount
gmapM :: (forall d. Data d => d -> m d)
-> ServiceAccount -> m ServiceAccount
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ServiceAccount -> m ServiceAccount
gmapQi :: Int -> (forall d. Data d => d -> u) -> ServiceAccount -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ServiceAccount -> u
gmapQ :: (forall d. Data d => d -> u) -> ServiceAccount -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ServiceAccount -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ServiceAccount -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ServiceAccount -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ServiceAccount -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ServiceAccount -> r
gmapT :: (forall b. Data b => b -> b) -> ServiceAccount -> ServiceAccount
$cgmapT :: (forall b. Data b => b -> b) -> ServiceAccount -> ServiceAccount
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ServiceAccount)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ServiceAccount)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ServiceAccount)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ServiceAccount)
dataTypeOf :: ServiceAccount -> DataType
$cdataTypeOf :: ServiceAccount -> DataType
toConstr :: ServiceAccount -> Constr
$ctoConstr :: ServiceAccount -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ServiceAccount
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ServiceAccount
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ServiceAccount -> c ServiceAccount
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ServiceAccount -> c ServiceAccount
$cp1Data :: Typeable ServiceAccount
Data, ServiceAccount -> ()
(ServiceAccount -> ()) -> NFData ServiceAccount
forall a. (a -> ()) -> NFData a
rnf :: ServiceAccount -> ()
$crnf :: ServiceAccount -> ()
NFData, (forall x. ServiceAccount -> Rep ServiceAccount x)
-> (forall x. Rep ServiceAccount x -> ServiceAccount)
-> Generic ServiceAccount
forall x. Rep ServiceAccount x -> ServiceAccount
forall x. ServiceAccount -> Rep ServiceAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ServiceAccount x -> ServiceAccount
$cfrom :: forall x. ServiceAccount -> Rep ServiceAccount x
Generic, Int -> ServiceAccount -> Int
ServiceAccount -> Int
(Int -> ServiceAccount -> Int)
-> (ServiceAccount -> Int) -> Hashable ServiceAccount
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ServiceAccount -> Int
$chash :: ServiceAccount -> Int
hashWithSalt :: Int -> ServiceAccount -> Int
$chashWithSalt :: Int -> ServiceAccount -> Int
Hashable)

$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) {J.omitNothingFields = False} ''ServiceAccount)

data ConfigurationJSON a
  = FromEnvJSON Text
  | FromYamlJSON a
  deriving stock (Int -> ConfigurationJSON a -> ShowS
[ConfigurationJSON a] -> ShowS
ConfigurationJSON a -> String
(Int -> ConfigurationJSON a -> ShowS)
-> (ConfigurationJSON a -> String)
-> ([ConfigurationJSON a] -> ShowS)
-> Show (ConfigurationJSON a)
forall a. Show a => Int -> ConfigurationJSON a -> ShowS
forall a. Show a => [ConfigurationJSON a] -> ShowS
forall a. Show a => ConfigurationJSON a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationJSON a] -> ShowS
$cshowList :: forall a. Show a => [ConfigurationJSON a] -> ShowS
show :: ConfigurationJSON a -> String
$cshow :: forall a. Show a => ConfigurationJSON a -> String
showsPrec :: Int -> ConfigurationJSON a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ConfigurationJSON a -> ShowS
Show, ConfigurationJSON a -> ConfigurationJSON a -> Bool
(ConfigurationJSON a -> ConfigurationJSON a -> Bool)
-> (ConfigurationJSON a -> ConfigurationJSON a -> Bool)
-> Eq (ConfigurationJSON a)
forall a.
Eq a =>
ConfigurationJSON a -> ConfigurationJSON a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationJSON a -> ConfigurationJSON a -> Bool
$c/= :: forall a.
Eq a =>
ConfigurationJSON a -> ConfigurationJSON a -> Bool
== :: ConfigurationJSON a -> ConfigurationJSON a -> Bool
$c== :: forall a.
Eq a =>
ConfigurationJSON a -> ConfigurationJSON a -> Bool
Eq, (forall x. ConfigurationJSON a -> Rep (ConfigurationJSON a) x)
-> (forall x. Rep (ConfigurationJSON a) x -> ConfigurationJSON a)
-> Generic (ConfigurationJSON a)
forall x. Rep (ConfigurationJSON a) x -> ConfigurationJSON a
forall x. ConfigurationJSON a -> Rep (ConfigurationJSON a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ConfigurationJSON a) x -> ConfigurationJSON a
forall a x. ConfigurationJSON a -> Rep (ConfigurationJSON a) x
$cto :: forall a x. Rep (ConfigurationJSON a) x -> ConfigurationJSON a
$cfrom :: forall a x. ConfigurationJSON a -> Rep (ConfigurationJSON a) x
Generic)
  deriving (ConfigurationJSON a -> ()
(ConfigurationJSON a -> ()) -> NFData (ConfigurationJSON a)
forall a. NFData a => ConfigurationJSON a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ConfigurationJSON a -> ()
$crnf :: forall a. NFData a => ConfigurationJSON a -> ()
NFData, Int -> ConfigurationJSON a -> Int
ConfigurationJSON a -> Int
(Int -> ConfigurationJSON a -> Int)
-> (ConfigurationJSON a -> Int) -> Hashable (ConfigurationJSON a)
forall a. Hashable a => Int -> ConfigurationJSON a -> Int
forall a. Hashable a => ConfigurationJSON a -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ConfigurationJSON a -> Int
$chash :: forall a. Hashable a => ConfigurationJSON a -> Int
hashWithSalt :: Int -> ConfigurationJSON a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> ConfigurationJSON a -> Int
Hashable)

instance J.FromJSON a => J.FromJSON (ConfigurationJSON a) where
  parseJSON :: Value -> Parser (ConfigurationJSON a)
parseJSON = \case
    J.Object Object
o | Just (J.String Text
text) <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"from_env" Object
o -> ConfigurationJSON a -> Parser (ConfigurationJSON a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ConfigurationJSON a
forall a. Text -> ConfigurationJSON a
FromEnvJSON Text
text)
    J.String Text
s -> case ByteString -> Either String (ConfigurationJSON a)
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode (ByteString -> Either String (ConfigurationJSON a))
-> (Text -> ByteString)
-> Text
-> Either String (ConfigurationJSON a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> Either String (ConfigurationJSON a))
-> Text -> Either String (ConfigurationJSON a)
forall a b. (a -> b) -> a -> b
$ Text
s of
      Left {} -> String -> Parser (ConfigurationJSON a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error parsing configuration json"
      Right ConfigurationJSON a
sa -> ConfigurationJSON a -> Parser (ConfigurationJSON a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigurationJSON a
sa
    Value
j -> (a -> ConfigurationJSON a)
-> Parser a -> Parser (ConfigurationJSON a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ConfigurationJSON a
forall a. a -> ConfigurationJSON a
FromYamlJSON (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
j)

instance J.ToJSON a => J.ToJSON (ConfigurationJSON a) where
  toJSON :: ConfigurationJSON a -> Value
toJSON = \case
    FromEnvJSON Text
i -> [Pair] -> Value
J.object [Key
"from_env" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Text
i]
    FromYamlJSON a
j -> a -> Value
forall a. ToJSON a => a -> Value
J.toJSON a
j

-- | Configuration inputs when they are a YAML array or an Env var whos value is
-- a comma-separated string
data ConfigurationInputs
  = FromYamls [Text]
  | FromEnvs Text
  deriving stock (Int -> ConfigurationInputs -> ShowS
[ConfigurationInputs] -> ShowS
ConfigurationInputs -> String
(Int -> ConfigurationInputs -> ShowS)
-> (ConfigurationInputs -> String)
-> ([ConfigurationInputs] -> ShowS)
-> Show ConfigurationInputs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationInputs] -> ShowS
$cshowList :: [ConfigurationInputs] -> ShowS
show :: ConfigurationInputs -> String
$cshow :: ConfigurationInputs -> String
showsPrec :: Int -> ConfigurationInputs -> ShowS
$cshowsPrec :: Int -> ConfigurationInputs -> ShowS
Show, ConfigurationInputs -> ConfigurationInputs -> Bool
(ConfigurationInputs -> ConfigurationInputs -> Bool)
-> (ConfigurationInputs -> ConfigurationInputs -> Bool)
-> Eq ConfigurationInputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationInputs -> ConfigurationInputs -> Bool
$c/= :: ConfigurationInputs -> ConfigurationInputs -> Bool
== :: ConfigurationInputs -> ConfigurationInputs -> Bool
$c== :: ConfigurationInputs -> ConfigurationInputs -> Bool
Eq, (forall x. ConfigurationInputs -> Rep ConfigurationInputs x)
-> (forall x. Rep ConfigurationInputs x -> ConfigurationInputs)
-> Generic ConfigurationInputs
forall x. Rep ConfigurationInputs x -> ConfigurationInputs
forall x. ConfigurationInputs -> Rep ConfigurationInputs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigurationInputs x -> ConfigurationInputs
$cfrom :: forall x. ConfigurationInputs -> Rep ConfigurationInputs x
Generic)
  deriving (ConfigurationInputs -> ()
(ConfigurationInputs -> ()) -> NFData ConfigurationInputs
forall a. (a -> ()) -> NFData a
rnf :: ConfigurationInputs -> ()
$crnf :: ConfigurationInputs -> ()
NFData, Int -> ConfigurationInputs -> Int
ConfigurationInputs -> Int
(Int -> ConfigurationInputs -> Int)
-> (ConfigurationInputs -> Int) -> Hashable ConfigurationInputs
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ConfigurationInputs -> Int
$chash :: ConfigurationInputs -> Int
hashWithSalt :: Int -> ConfigurationInputs -> Int
$chashWithSalt :: Int -> ConfigurationInputs -> Int
Hashable)

instance J.ToJSON ConfigurationInputs where
  toJSON :: ConfigurationInputs -> Value
toJSON = \case
    FromYamls [Text]
i -> [Text] -> Value
forall a. ToJSON a => a -> Value
J.toJSON [Text]
i
    FromEnvs Text
i -> [Pair] -> Value
J.object [Key
"from_env" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Text
i]

instance J.FromJSON ConfigurationInputs where
  parseJSON :: Value -> Parser ConfigurationInputs
parseJSON = \case
    J.Object Object
o -> Text -> ConfigurationInputs
FromEnvs (Text -> ConfigurationInputs)
-> Parser Text -> Parser ConfigurationInputs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"from_env"
    s :: Value
s@(J.Array Array
_) -> [Text] -> ConfigurationInputs
FromYamls ([Text] -> ConfigurationInputs)
-> Parser [Text] -> Parser ConfigurationInputs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Text]
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
s
    Value
_ -> String -> Parser ConfigurationInputs
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"one of array or object must be provided"

-- | Configuration input when the YAML value as well as the Env var have
-- singlular values
data ConfigurationInput
  = FromYaml Text
  | FromEnv Text
  deriving stock (Int -> ConfigurationInput -> ShowS
[ConfigurationInput] -> ShowS
ConfigurationInput -> String
(Int -> ConfigurationInput -> ShowS)
-> (ConfigurationInput -> String)
-> ([ConfigurationInput] -> ShowS)
-> Show ConfigurationInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationInput] -> ShowS
$cshowList :: [ConfigurationInput] -> ShowS
show :: ConfigurationInput -> String
$cshow :: ConfigurationInput -> String
showsPrec :: Int -> ConfigurationInput -> ShowS
$cshowsPrec :: Int -> ConfigurationInput -> ShowS
Show, ConfigurationInput -> ConfigurationInput -> Bool
(ConfigurationInput -> ConfigurationInput -> Bool)
-> (ConfigurationInput -> ConfigurationInput -> Bool)
-> Eq ConfigurationInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationInput -> ConfigurationInput -> Bool
$c/= :: ConfigurationInput -> ConfigurationInput -> Bool
== :: ConfigurationInput -> ConfigurationInput -> Bool
$c== :: ConfigurationInput -> ConfigurationInput -> Bool
Eq, (forall x. ConfigurationInput -> Rep ConfigurationInput x)
-> (forall x. Rep ConfigurationInput x -> ConfigurationInput)
-> Generic ConfigurationInput
forall x. Rep ConfigurationInput x -> ConfigurationInput
forall x. ConfigurationInput -> Rep ConfigurationInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigurationInput x -> ConfigurationInput
$cfrom :: forall x. ConfigurationInput -> Rep ConfigurationInput x
Generic)
  deriving (ConfigurationInput -> ()
(ConfigurationInput -> ()) -> NFData ConfigurationInput
forall a. (a -> ()) -> NFData a
rnf :: ConfigurationInput -> ()
$crnf :: ConfigurationInput -> ()
NFData, Int -> ConfigurationInput -> Int
ConfigurationInput -> Int
(Int -> ConfigurationInput -> Int)
-> (ConfigurationInput -> Int) -> Hashable ConfigurationInput
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ConfigurationInput -> Int
$chash :: ConfigurationInput -> Int
hashWithSalt :: Int -> ConfigurationInput -> Int
$chashWithSalt :: Int -> ConfigurationInput -> Int
Hashable)

instance J.ToJSON ConfigurationInput where
  toJSON :: ConfigurationInput -> Value
toJSON = \case
    FromYaml Text
i -> Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON Text
i
    FromEnv Text
i -> [Pair] -> Value
J.object [Key
"from_env" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Text
i]

instance J.FromJSON ConfigurationInput where
  parseJSON :: Value -> Parser ConfigurationInput
parseJSON = \case
    J.Object Object
o -> Text -> ConfigurationInput
FromEnv (Text -> ConfigurationInput)
-> Parser Text -> Parser ConfigurationInput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"from_env"
    s :: Value
s@(J.String Text
_) -> Text -> ConfigurationInput
FromYaml (Text -> ConfigurationInput)
-> Parser Text -> Parser ConfigurationInput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
s
    (J.Number Scientific
n) -> Text -> ConfigurationInput
FromYaml (Text -> ConfigurationInput)
-> Parser Text -> Parser ConfigurationInput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Text -> Value
J.String (Scientific -> Text
forall a. Show a => a -> Text
tshow Scientific
n))
    Value
_ -> String -> Parser ConfigurationInput
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"one of string or number or object must be provided"

data BigQueryConnSourceConfig = BigQueryConnSourceConfig
  { BigQueryConnSourceConfig -> ConfigurationJSON ServiceAccount
_cscServiceAccount :: ConfigurationJSON ServiceAccount,
    BigQueryConnSourceConfig -> ConfigurationInputs
_cscDatasets :: ConfigurationInputs,
    BigQueryConnSourceConfig -> ConfigurationInput
_cscProjectId :: ConfigurationInput, -- this is part of service-account.json, but we put it here on purpose
    BigQueryConnSourceConfig -> Maybe ConfigurationInput
_cscGlobalSelectLimit :: Maybe ConfigurationInput,
    BigQueryConnSourceConfig -> Maybe ConfigurationInput
_cscRetryBaseDelay :: Maybe ConfigurationInput,
    BigQueryConnSourceConfig -> Maybe ConfigurationInput
_cscRetryLimit :: Maybe ConfigurationInput
  }
  deriving (BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool
(BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool)
-> (BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool)
-> Eq BigQueryConnSourceConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool
$c/= :: BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool
== :: BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool
$c== :: BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool
Eq, (forall x.
 BigQueryConnSourceConfig -> Rep BigQueryConnSourceConfig x)
-> (forall x.
    Rep BigQueryConnSourceConfig x -> BigQueryConnSourceConfig)
-> Generic BigQueryConnSourceConfig
forall x.
Rep BigQueryConnSourceConfig x -> BigQueryConnSourceConfig
forall x.
BigQueryConnSourceConfig -> Rep BigQueryConnSourceConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BigQueryConnSourceConfig x -> BigQueryConnSourceConfig
$cfrom :: forall x.
BigQueryConnSourceConfig -> Rep BigQueryConnSourceConfig x
Generic, BigQueryConnSourceConfig -> ()
(BigQueryConnSourceConfig -> ()) -> NFData BigQueryConnSourceConfig
forall a. (a -> ()) -> NFData a
rnf :: BigQueryConnSourceConfig -> ()
$crnf :: BigQueryConnSourceConfig -> ()
NFData)

$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) {J.omitNothingFields = True} ''BigQueryConnSourceConfig)

-- TODO: Write a proper codec, and use it to derive FromJSON and ToJSON
-- instances.
instance HasCodec BigQueryConnSourceConfig where
  codec :: JSONCodec BigQueryConnSourceConfig
codec = Text
-> JSONCodec BigQueryConnSourceConfig
-> JSONCodec BigQueryConnSourceConfig
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"BigQueryConnSourceConfig" (JSONCodec BigQueryConnSourceConfig
 -> JSONCodec BigQueryConnSourceConfig)
-> JSONCodec BigQueryConnSourceConfig
-> JSONCodec BigQueryConnSourceConfig
forall a b. (a -> b) -> a -> b
$ JSONCodec BigQueryConnSourceConfig
forall a. (FromJSON a, ToJSON a) => JSONCodec a
placeholderCodecViaJSON

deriving instance Show BigQueryConnSourceConfig

deriving instance Hashable BigQueryConnSourceConfig

instance Cacheable BigQueryConnSourceConfig where
  unchanged :: Accesses
-> BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool
unchanged Accesses
_ = BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool
forall a. Eq a => a -> a -> Bool
(==)

data RetryOptions = RetryOptions
  { RetryOptions -> Microseconds
_retryBaseDelay :: Microseconds,
    RetryOptions -> Int
_retryNumRetries :: Int
  }
  deriving (RetryOptions -> RetryOptions -> Bool
(RetryOptions -> RetryOptions -> Bool)
-> (RetryOptions -> RetryOptions -> Bool) -> Eq RetryOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetryOptions -> RetryOptions -> Bool
$c/= :: RetryOptions -> RetryOptions -> Bool
== :: RetryOptions -> RetryOptions -> Bool
$c== :: RetryOptions -> RetryOptions -> Bool
Eq)

data BigQueryConnection = BigQueryConnection
  { BigQueryConnection -> ServiceAccount
_bqServiceAccount :: ServiceAccount,
    BigQueryConnection -> Text
_bqProjectId :: Text, -- this is part of service-account.json, but we put it here on purpose
    BigQueryConnection -> Maybe RetryOptions
_bqRetryOptions :: Maybe RetryOptions,
    BigQueryConnection -> MVar (Maybe TokenResp)
_bqAccessTokenMVar :: MVar (Maybe TokenResp)
  }
  deriving (BigQueryConnection -> BigQueryConnection -> Bool
(BigQueryConnection -> BigQueryConnection -> Bool)
-> (BigQueryConnection -> BigQueryConnection -> Bool)
-> Eq BigQueryConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BigQueryConnection -> BigQueryConnection -> Bool
$c/= :: BigQueryConnection -> BigQueryConnection -> Bool
== :: BigQueryConnection -> BigQueryConnection -> Bool
$c== :: BigQueryConnection -> BigQueryConnection -> Bool
Eq)

data BigQuerySourceConfig = BigQuerySourceConfig
  { BigQuerySourceConfig -> BigQueryConnection
_scConnection :: BigQueryConnection,
    BigQuerySourceConfig -> [Text]
_scDatasets :: [Text],
    BigQuerySourceConfig -> Int64
_scGlobalSelectLimit :: Int.Int64
  }
  deriving (BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
(BigQuerySourceConfig -> BigQuerySourceConfig -> Bool)
-> (BigQuerySourceConfig -> BigQuerySourceConfig -> Bool)
-> Eq BigQuerySourceConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
$c/= :: BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
== :: BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
$c== :: BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
Eq)

instance Cacheable BigQuerySourceConfig where
  unchanged :: Accesses -> BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
unchanged Accesses
_ = BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance J.ToJSON BigQuerySourceConfig where
  toJSON :: BigQuerySourceConfig -> Value
toJSON BigQuerySourceConfig {Int64
[Text]
BigQueryConnection
_scGlobalSelectLimit :: Int64
_scDatasets :: [Text]
_scConnection :: BigQueryConnection
_scGlobalSelectLimit :: BigQuerySourceConfig -> Int64
_scDatasets :: BigQuerySourceConfig -> [Text]
_scConnection :: BigQuerySourceConfig -> BigQueryConnection
..} =
    [Pair] -> Value
J.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"service_account" Key -> ServiceAccount -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= BigQueryConnection -> ServiceAccount
_bqServiceAccount BigQueryConnection
_scConnection,
        Key
"datasets" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= [Text]
_scDatasets,
        Key
"project_id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= BigQueryConnection -> Text
_bqProjectId BigQueryConnection
_scConnection,
        Key
"global_select_limit" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Int64
_scGlobalSelectLimit
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> case BigQueryConnection -> Maybe RetryOptions
_bqRetryOptions BigQueryConnection
_scConnection of
          Just RetryOptions {Int
Microseconds
_retryNumRetries :: Int
_retryBaseDelay :: Microseconds
_retryNumRetries :: RetryOptions -> Int
_retryBaseDelay :: RetryOptions -> Microseconds
..} ->
            [ Key
"base_delay" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= DiffTime -> Integer
diffTimeToMicroSeconds (Microseconds -> DiffTime
microseconds Microseconds
_retryBaseDelay),
              Key
"retry_limit" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Int
_retryNumRetries
            ]
          Maybe RetryOptions
Nothing -> []