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

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

import Autodocodec
import Autodocodec.Extended (fromEnvCodec)
import Control.Concurrent.MVar
import Control.Lens (united)
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.ByteString.Lazy qualified as BL
import Data.Has
import Data.Int qualified as Int
import Data.Scientific (Scientific)
import Data.Text.Encoding qualified as TE
import Data.X509 qualified as X509
import Data.X509.Memory qualified as X509
import Hasura.Prelude

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

instance HasCodec BigQueryProjectId where
  codec :: JSONCodec BigQueryProjectId
codec = (Text -> Either String BigQueryProjectId)
-> (BigQueryProjectId -> Text)
-> Codec Value Text Text
-> JSONCodec BigQueryProjectId
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec (BigQueryProjectId -> Either String BigQueryProjectId
forall a b. b -> Either a b
Right (BigQueryProjectId -> Either String BigQueryProjectId)
-> (Text -> BigQueryProjectId)
-> Text
-> Either String BigQueryProjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BigQueryProjectId
BigQueryProjectId) BigQueryProjectId -> Text
getBigQueryProjectId Codec Value Text Text
textCodec

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

instance HasCodec BigQueryDataset where
  codec :: JSONCodec BigQueryDataset
codec = (Text -> Either String BigQueryDataset)
-> (BigQueryDataset -> Text)
-> Codec Value Text Text
-> JSONCodec BigQueryDataset
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec (BigQueryDataset -> Either String BigQueryDataset
forall a b. b -> Either a b
Right (BigQueryDataset -> Either String BigQueryDataset)
-> (Text -> BigQueryDataset)
-> Text
-> Either String BigQueryDataset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BigQueryDataset
BigQueryDataset) BigQueryDataset -> Text
getBigQueryDataset Codec Value Text Text
textCodec

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
$cshowsPrec :: Int -> PKey -> ShowS
showsPrec :: Int -> PKey -> ShowS
$cshow :: PKey -> String
show :: PKey -> String
$cshowList :: [PKey] -> ShowS
showList :: [PKey] -> ShowS
Show, PKey -> PKey -> Bool
(PKey -> PKey -> Bool) -> (PKey -> PKey -> Bool) -> Eq PKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PKey -> PKey -> Bool
== :: PKey -> PKey -> Bool
$c/= :: PKey -> PKey -> Bool
/= :: PKey -> PKey -> Bool
Eq, Typeable PKey
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 -> Constr
PKey -> DataType
(forall b. Data b => b -> b) -> PKey -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PKey -> c PKey
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PKey -> c PKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PKey
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PKey
$ctoConstr :: PKey -> Constr
toConstr :: PKey -> Constr
$cdataTypeOf :: PKey -> DataType
dataTypeOf :: PKey -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PKey)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PKey)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PKey)
$cgmapT :: (forall b. Data b => b -> b) -> PKey -> PKey
gmapT :: (forall b. Data b => b -> b) -> PKey -> PKey
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PKey -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PKey -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PKey -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PKey -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PKey -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PKey -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PKey -> m PKey
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PKey -> m 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
$cfrom :: forall x. PKey -> Rep PKey x
from :: forall x. PKey -> Rep PKey x
$cto :: forall x. Rep PKey x -> PKey
to :: forall x. Rep PKey x -> PKey
Generic, PKey -> ()
(PKey -> ()) -> NFData PKey
forall a. (a -> ()) -> NFData a
$crnf :: PKey -> ()
rnf :: PKey -> ()
NFData, Eq PKey
Eq PKey -> (Int -> PKey -> Int) -> (PKey -> Int) -> Hashable PKey
Int -> PKey -> Int
PKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> PKey -> Int
hashWithSalt :: Int -> PKey -> Int
$chash :: PKey -> Int
hash :: 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 HasCodec PKey where
  codec :: JSONCodec PKey
codec = (Text -> Either String PKey)
-> (PKey -> Text) -> Codec Value Text Text -> JSONCodec PKey
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Text -> Either String PKey
forall {a}. IsString a => Text -> Either a PKey
dec PKey -> Text
originalBS Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec
    where
      dec :: Text -> Either a PKey
dec 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 -> Either a PKey
forall a b. b -> Either a b
Right (PKey -> Either a PKey) -> PKey -> Either a PKey
forall a b. (a -> b) -> a -> b
$ PrivateKey -> Text -> PKey
PKey PrivateKey
k' Text
k
        [PrivKey]
_ -> a -> Either a PKey
forall a b. a -> Either a b
Left a
"unable to parse private key"

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 a. a -> Parser a
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 a. String -> Parser a
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
unPKey :: PKey -> PrivateKey
originalBS :: PKey -> Text
unPKey :: PrivateKey
originalBS :: Text
..} = Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON Text
originalBS

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

instance HasCodec ServiceAccount where
  codec :: JSONCodec ServiceAccount
codec =
    Text
-> ObjectCodec ServiceAccount ServiceAccount
-> JSONCodec ServiceAccount
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"BigQueryServiceAccount"
      (ObjectCodec ServiceAccount ServiceAccount
 -> JSONCodec ServiceAccount)
-> ObjectCodec ServiceAccount ServiceAccount
-> JSONCodec ServiceAccount
forall a b. (a -> b) -> a -> b
$ Text -> PKey -> BigQueryProjectId -> ServiceAccount
ServiceAccount
      (Text -> PKey -> BigQueryProjectId -> ServiceAccount)
-> Codec Object ServiceAccount Text
-> Codec
     Object ServiceAccount (PKey -> BigQueryProjectId -> ServiceAccount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Text Text
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"client_email"
      ObjectCodec Text Text
-> (ServiceAccount -> Text) -> Codec Object ServiceAccount Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ServiceAccount -> Text
_saClientEmail
        Codec
  Object ServiceAccount (PKey -> BigQueryProjectId -> ServiceAccount)
-> Codec Object ServiceAccount PKey
-> Codec
     Object ServiceAccount (BigQueryProjectId -> ServiceAccount)
forall a b.
Codec Object ServiceAccount (a -> b)
-> Codec Object ServiceAccount a -> Codec Object ServiceAccount b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec PKey PKey
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"private_key"
      ObjectCodec PKey PKey
-> (ServiceAccount -> PKey) -> Codec Object ServiceAccount PKey
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ServiceAccount -> PKey
_saPrivateKey
        Codec Object ServiceAccount (BigQueryProjectId -> ServiceAccount)
-> Codec Object ServiceAccount BigQueryProjectId
-> ObjectCodec ServiceAccount ServiceAccount
forall a b.
Codec Object ServiceAccount (a -> b)
-> Codec Object ServiceAccount a -> Codec Object ServiceAccount b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec BigQueryProjectId BigQueryProjectId
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"project_id"
      ObjectCodec BigQueryProjectId BigQueryProjectId
-> (ServiceAccount -> BigQueryProjectId)
-> Codec Object ServiceAccount BigQueryProjectId
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= ServiceAccount -> BigQueryProjectId
_saProjectId

instance J.FromJSON ServiceAccount where
  parseJSON :: Value -> Parser ServiceAccount
parseJSON = Options -> Value -> Parser ServiceAccount
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON (Int -> ShowS -> Options
J.aesonDrop Int
3 ShowS
J.snakeCase) {omitNothingFields :: Bool
J.omitNothingFields = Bool
False}

instance J.ToJSON ServiceAccount where
  toJSON :: ServiceAccount -> Value
toJSON = Options -> ServiceAccount -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON (Int -> ShowS -> Options
J.aesonDrop Int
3 ShowS
J.snakeCase) {omitNothingFields :: Bool
J.omitNothingFields = Bool
False}
  toEncoding :: ServiceAccount -> Encoding
toEncoding = Options -> ServiceAccount -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding (Int -> ShowS -> Options
J.aesonDrop Int
3 ShowS
J.snakeCase) {omitNothingFields :: Bool
J.omitNothingFields = Bool
False}

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
$cshowsPrec :: forall a. Show a => Int -> ConfigurationJSON a -> ShowS
showsPrec :: Int -> ConfigurationJSON a -> ShowS
$cshow :: forall a. Show a => ConfigurationJSON a -> String
show :: ConfigurationJSON a -> String
$cshowList :: forall a. Show a => [ConfigurationJSON a] -> ShowS
showList :: [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
$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
/= :: 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
$cfrom :: forall a x. ConfigurationJSON a -> Rep (ConfigurationJSON a) x
from :: forall x. ConfigurationJSON a -> Rep (ConfigurationJSON a) x
$cto :: forall a x. Rep (ConfigurationJSON a) x -> ConfigurationJSON a
to :: forall x. Rep (ConfigurationJSON a) x -> ConfigurationJSON a
Generic)
  deriving (ConfigurationJSON a -> ()
(ConfigurationJSON a -> ()) -> NFData (ConfigurationJSON a)
forall a. NFData a => ConfigurationJSON a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => ConfigurationJSON a -> ()
rnf :: ConfigurationJSON a -> ()
NFData, Eq (ConfigurationJSON a)
Eq (ConfigurationJSON a)
-> (Int -> ConfigurationJSON a -> Int)
-> (ConfigurationJSON a -> Int)
-> Hashable (ConfigurationJSON a)
Int -> ConfigurationJSON a -> Int
ConfigurationJSON a -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall {a}. Hashable a => Eq (ConfigurationJSON a)
forall a. Hashable a => Int -> ConfigurationJSON a -> Int
forall a. Hashable a => ConfigurationJSON a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> ConfigurationJSON a -> Int
hashWithSalt :: Int -> ConfigurationJSON a -> Int
$chash :: forall a. Hashable a => ConfigurationJSON a -> Int
hash :: ConfigurationJSON a -> Int
Hashable)

-- This codec has straightforward encoding, but on decoding there is
-- a possibility of receiving a string that contains JSON that is recursively
-- handled by this codec. There is also the issue that decoding the
-- @FromYamlJSON@ case should be attempted last because there is a possibility
-- that the decoding for @a@ is not disjoint from the other decoding cases. This
-- presents some asymmetry that is a little tricky to capture in a codec.
instance (HasCodec a) => HasCodec (ConfigurationJSON a) where
  codec :: JSONCodec (ConfigurationJSON a)
codec = JSONCodec (ConfigurationJSON a)
-> Codec Value a (ConfigurationJSON a)
-> JSONCodec (ConfigurationJSON a)
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative (JSONCodec (ConfigurationJSON a)
-> Codec Value Text (ConfigurationJSON a)
-> JSONCodec (ConfigurationJSON a)
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative JSONCodec (ConfigurationJSON a)
mainCodec Codec Value Text (ConfigurationJSON a)
fromEnvEncodedAsNestedJSON) Codec Value a (ConfigurationJSON a)
yamlJSONCodec
    where
      -- This is the only codec in this implementation that is used for
      -- encoding. It must cover both the @FromEnvJSON@ and @FromYamlJSON@ cases
      -- because Autodocodec does not support codecs that are partial in
      -- encoding.
      mainCodec :: JSONCodec (ConfigurationJSON a)
      mainCodec :: JSONCodec (ConfigurationJSON a)
mainCodec =
        (Either Text a -> ConfigurationJSON a)
-> (ConfigurationJSON a -> Either Text a)
-> Codec Value (Either Text a) (Either Text a)
-> JSONCodec (ConfigurationJSON a)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either Text a -> ConfigurationJSON a
forall {a}. Either Text a -> ConfigurationJSON a
dec ConfigurationJSON a -> Either Text a
forall {b}. ConfigurationJSON b -> Either Text b
enc
          (Codec Value (Either Text a) (Either Text a)
 -> JSONCodec (ConfigurationJSON a))
-> Codec Value (Either Text a) (Either Text a)
-> JSONCodec (ConfigurationJSON a)
forall a b. (a -> b) -> a -> b
$ Codec Value Text Text
-> Codec Value a a -> Codec Value (Either Text a) (Either Text a)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec
            Codec Value Text Text
fromEnvCodec
            ( (a -> Either String a)
-> (a -> a) -> Codec Value a a -> Codec Value a a
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec
                -- Fail parsing at this point because @codec \@a@ should only be
                -- used for parsing after trying @fromEnvEncodedAsNestedJSON@.
                (Either String a -> a -> Either String a
forall a b. a -> b -> a
const (Either String a -> a -> Either String a)
-> Either String a -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left String
"not used for parsing")
                a -> a
forall a. a -> a
id
                (Codec Value a a -> Codec Value a a)
-> Codec Value a a -> Codec Value a a
forall a b. (a -> b) -> a -> b
$ forall value. HasCodec value => JSONCodec value
codec @a
            )
        where
          dec :: Either Text a -> ConfigurationJSON a
dec (Left Text
text) = Text -> ConfigurationJSON a
forall a. Text -> ConfigurationJSON a
FromEnvJSON Text
text
          dec (Right a
a) = a -> ConfigurationJSON a
forall a. a -> ConfigurationJSON a
FromYamlJSON a
a

          enc :: ConfigurationJSON b -> Either Text b
enc (FromEnvJSON Text
i) = Text -> Either Text b
forall a b. a -> Either a b
Left Text
i
          enc (FromYamlJSON b
j) = b -> Either Text b
forall a b. b -> Either a b
Right b
j

      -- The JSON-encoded string case is used as an alternative in
      -- a 'parseAlternative' because we can implement the decoding direction,
      -- but not the encoding direction. (There isn't a good way to implement
      -- @ConfigurationJSON a -> Text@.) Fortunately an alternative in
      -- a 'parseAlternative' is only used for decoding so we don't need to
      -- implement encoding logic here.
      fromEnvEncodedAsNestedJSON :: ValueCodec Text (ConfigurationJSON a)
      fromEnvEncodedAsNestedJSON :: Codec Value Text (ConfigurationJSON a)
fromEnvEncodedAsNestedJSON =
        (Text -> Either String (ConfigurationJSON a))
-> (Text -> Text)
-> Codec Value Text Text
-> Codec Value Text (ConfigurationJSON a)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec
          (ByteString -> Either String (ConfigurationJSON a)
forall a. HasCodec a => ByteString -> Either String a
eitherDecodeJSONViaCodec (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 -> Text
forall a. a -> a
id
          (Codec Value Text Text -> Codec Value Text (ConfigurationJSON a))
-> Codec Value Text Text -> Codec Value Text (ConfigurationJSON a)
forall a b. (a -> b) -> a -> b
$ forall value. HasCodec value => JSONCodec value
codec @Text
          Codec Value Text Text -> Text -> Codec Value Text Text
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
"JSON-encoded string"

      yamlJSONCodec :: ValueCodec a (ConfigurationJSON a)
      yamlJSONCodec :: Codec Value a (ConfigurationJSON a)
yamlJSONCodec = a -> ConfigurationJSON a
forall a. a -> ConfigurationJSON a
FromYamlJSON (a -> ConfigurationJSON a)
-> Codec Value a a -> Codec Value a (ConfigurationJSON a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall value. HasCodec value => JSONCodec value
codec @a

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 a. a -> Parser 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 a. String -> Parser 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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigurationJSON a
sa
    Value
j -> (a -> ConfigurationJSON a)
-> Parser a -> Parser (ConfigurationJSON a)
forall a b. (a -> b) -> Parser a -> Parser b
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
forall v. ToJSON v => Key -> v -> Pair
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 whose 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
$cshowsPrec :: Int -> ConfigurationInputs -> ShowS
showsPrec :: Int -> ConfigurationInputs -> ShowS
$cshow :: ConfigurationInputs -> String
show :: ConfigurationInputs -> String
$cshowList :: [ConfigurationInputs] -> ShowS
showList :: [ConfigurationInputs] -> ShowS
Show, ConfigurationInputs -> ConfigurationInputs -> Bool
(ConfigurationInputs -> ConfigurationInputs -> Bool)
-> (ConfigurationInputs -> ConfigurationInputs -> Bool)
-> Eq ConfigurationInputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigurationInputs -> ConfigurationInputs -> Bool
== :: ConfigurationInputs -> ConfigurationInputs -> Bool
$c/= :: ConfigurationInputs -> ConfigurationInputs -> Bool
/= :: 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
$cfrom :: forall x. ConfigurationInputs -> Rep ConfigurationInputs x
from :: forall x. ConfigurationInputs -> Rep ConfigurationInputs x
$cto :: forall x. Rep ConfigurationInputs x -> ConfigurationInputs
to :: forall x. Rep ConfigurationInputs x -> ConfigurationInputs
Generic)
  deriving (ConfigurationInputs -> ()
(ConfigurationInputs -> ()) -> NFData ConfigurationInputs
forall a. (a -> ()) -> NFData a
$crnf :: ConfigurationInputs -> ()
rnf :: ConfigurationInputs -> ()
NFData, Eq ConfigurationInputs
Eq ConfigurationInputs
-> (Int -> ConfigurationInputs -> Int)
-> (ConfigurationInputs -> Int)
-> Hashable ConfigurationInputs
Int -> ConfigurationInputs -> Int
ConfigurationInputs -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ConfigurationInputs -> Int
hashWithSalt :: Int -> ConfigurationInputs -> Int
$chash :: ConfigurationInputs -> Int
hash :: ConfigurationInputs -> Int
Hashable)

instance HasCodec ConfigurationInputs where
  codec :: JSONCodec ConfigurationInputs
codec =
    (Either [Text] Text -> ConfigurationInputs)
-> (ConfigurationInputs -> Either [Text] Text)
-> Codec Value (Either [Text] Text) (Either [Text] Text)
-> JSONCodec ConfigurationInputs
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec
      (([Text] -> ConfigurationInputs)
-> (Text -> ConfigurationInputs)
-> Either [Text] Text
-> ConfigurationInputs
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Text] -> ConfigurationInputs
FromYamls Text -> ConfigurationInputs
FromEnvs)
      (\case FromYamls [Text]
i -> [Text] -> Either [Text] Text
forall a b. a -> Either a b
Left [Text]
i; FromEnvs Text
i -> Text -> Either [Text] Text
forall a b. b -> Either a b
Right Text
i)
      (Codec Value (Either [Text] Text) (Either [Text] Text)
 -> JSONCodec ConfigurationInputs)
-> Codec Value (Either [Text] Text) (Either [Text] Text)
-> JSONCodec ConfigurationInputs
forall a b. (a -> b) -> a -> b
$ Codec Value [Text] [Text]
-> Codec Value Text Text
-> Codec Value (Either [Text] Text) (Either [Text] Text)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
        (forall value. HasCodec value => JSONCodec value
codec @[Text])
        Codec Value Text Text
fromEnvCodec

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
forall v. ToJSON v => Key -> v -> Pair
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 a. String -> Parser a
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
-- singular 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
$cshowsPrec :: Int -> ConfigurationInput -> ShowS
showsPrec :: Int -> ConfigurationInput -> ShowS
$cshow :: ConfigurationInput -> String
show :: ConfigurationInput -> String
$cshowList :: [ConfigurationInput] -> ShowS
showList :: [ConfigurationInput] -> ShowS
Show, ConfigurationInput -> ConfigurationInput -> Bool
(ConfigurationInput -> ConfigurationInput -> Bool)
-> (ConfigurationInput -> ConfigurationInput -> Bool)
-> Eq ConfigurationInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigurationInput -> ConfigurationInput -> Bool
== :: ConfigurationInput -> ConfigurationInput -> Bool
$c/= :: ConfigurationInput -> ConfigurationInput -> Bool
/= :: 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
$cfrom :: forall x. ConfigurationInput -> Rep ConfigurationInput x
from :: forall x. ConfigurationInput -> Rep ConfigurationInput x
$cto :: forall x. Rep ConfigurationInput x -> ConfigurationInput
to :: forall x. Rep ConfigurationInput x -> ConfigurationInput
Generic)
  deriving (ConfigurationInput -> ()
(ConfigurationInput -> ()) -> NFData ConfigurationInput
forall a. (a -> ()) -> NFData a
$crnf :: ConfigurationInput -> ()
rnf :: ConfigurationInput -> ()
NFData, Eq ConfigurationInput
Eq ConfigurationInput
-> (Int -> ConfigurationInput -> Int)
-> (ConfigurationInput -> Int)
-> Hashable ConfigurationInput
Int -> ConfigurationInput -> Int
ConfigurationInput -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ConfigurationInput -> Int
hashWithSalt :: Int -> ConfigurationInput -> Int
$chash :: ConfigurationInput -> Int
hash :: ConfigurationInput -> Int
Hashable)

instance HasCodec ConfigurationInput where
  codec :: JSONCodec ConfigurationInput
codec =
    (Either Text Text -> ConfigurationInput)
-> (ConfigurationInput -> Either Text Text)
-> Codec Value (Either Text Text) (Either Text Text)
-> JSONCodec ConfigurationInput
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec
      ((Text -> ConfigurationInput)
-> (Text -> ConfigurationInput)
-> Either Text Text
-> ConfigurationInput
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> ConfigurationInput
FromYaml Text -> ConfigurationInput
FromEnv)
      (\case FromYaml Text
i -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
i; FromEnv Text
i -> Text -> Either Text Text
forall a b. b -> Either a b
Right Text
i)
      (Codec Value (Either Text Text) (Either Text Text)
 -> JSONCodec ConfigurationInput)
-> Codec Value (Either Text Text) (Either Text Text)
-> JSONCodec ConfigurationInput
forall a b. (a -> b) -> a -> b
$ Codec Value Text Text
-> Codec Value Text Text
-> Codec Value (Either Text Text) (Either Text Text)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec Codec Value Text Text
fromYamls Codec Value Text Text
fromEnvCodec
    where
      fromYamls :: Codec Value Text Text
fromYamls =
        Codec Value Text Text
-> Codec Value Scientific Text -> Codec Value Text Text
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
          (forall value. HasCodec value => JSONCodec value
codec @Text)
          (Scientific -> Text
forall a. Show a => a -> Text
tshow (Scientific -> Text)
-> Codec Value Scientific Scientific -> Codec Value Scientific Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall value. HasCodec value => JSONCodec value
codec @Scientific)

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
forall v. ToJSON v => Key -> v -> Pair
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 a. String -> Parser a
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, -- we use this projectId instead of the one from the service account as a service account may have access to multiple projects and we wish to choose which one to use
    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
$c== :: BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool
== :: BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool
$c/= :: BigQueryConnSourceConfig -> BigQueryConnSourceConfig -> Bool
/= :: 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
$cfrom :: forall x.
BigQueryConnSourceConfig -> Rep BigQueryConnSourceConfig x
from :: forall x.
BigQueryConnSourceConfig -> Rep BigQueryConnSourceConfig x
$cto :: forall x.
Rep BigQueryConnSourceConfig x -> BigQueryConnSourceConfig
to :: forall x.
Rep BigQueryConnSourceConfig x -> BigQueryConnSourceConfig
Generic, BigQueryConnSourceConfig -> ()
(BigQueryConnSourceConfig -> ()) -> NFData BigQueryConnSourceConfig
forall a. (a -> ()) -> NFData a
$crnf :: BigQueryConnSourceConfig -> ()
rnf :: BigQueryConnSourceConfig -> ()
NFData)

instance J.FromJSON BigQueryConnSourceConfig where
  parseJSON :: Value -> Parser BigQueryConnSourceConfig
parseJSON = Options -> Value -> Parser BigQueryConnSourceConfig
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON (Int -> ShowS -> Options
J.aesonDrop Int
4 ShowS
J.snakeCase) {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

instance J.ToJSON BigQueryConnSourceConfig where
  toJSON :: BigQueryConnSourceConfig -> Value
toJSON = Options -> BigQueryConnSourceConfig -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON (Int -> ShowS -> Options
J.aesonDrop Int
4 ShowS
J.snakeCase) {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}
  toEncoding :: BigQueryConnSourceConfig -> Encoding
toEncoding = Options -> BigQueryConnSourceConfig -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding (Int -> ShowS -> Options
J.aesonDrop Int
4 ShowS
J.snakeCase) {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

-- TODO: Write a proper codec, and use it to derive FromJSON and ToJSON
-- instances.
instance HasCodec BigQueryConnSourceConfig where
  codec :: JSONCodec BigQueryConnSourceConfig
codec =
    Text
-> ObjectCodec BigQueryConnSourceConfig BigQueryConnSourceConfig
-> JSONCodec BigQueryConnSourceConfig
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"BigQueryConnSourceConfig"
      (ObjectCodec BigQueryConnSourceConfig BigQueryConnSourceConfig
 -> JSONCodec BigQueryConnSourceConfig)
-> ObjectCodec BigQueryConnSourceConfig BigQueryConnSourceConfig
-> JSONCodec BigQueryConnSourceConfig
forall a b. (a -> b) -> a -> b
$ ConfigurationJSON ServiceAccount
-> ConfigurationInputs
-> ConfigurationInput
-> Maybe ConfigurationInput
-> Maybe ConfigurationInput
-> Maybe ConfigurationInput
-> BigQueryConnSourceConfig
BigQueryConnSourceConfig
      (ConfigurationJSON ServiceAccount
 -> ConfigurationInputs
 -> ConfigurationInput
 -> Maybe ConfigurationInput
 -> Maybe ConfigurationInput
 -> Maybe ConfigurationInput
 -> BigQueryConnSourceConfig)
-> Codec
     Object BigQueryConnSourceConfig (ConfigurationJSON ServiceAccount)
-> Codec
     Object
     BigQueryConnSourceConfig
     (ConfigurationInputs
      -> ConfigurationInput
      -> Maybe ConfigurationInput
      -> Maybe ConfigurationInput
      -> Maybe ConfigurationInput
      -> BigQueryConnSourceConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ObjectCodec
     (ConfigurationJSON ServiceAccount)
     (ConfigurationJSON ServiceAccount)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"service_account"
      ObjectCodec
  (ConfigurationJSON ServiceAccount)
  (ConfigurationJSON ServiceAccount)
-> (BigQueryConnSourceConfig -> ConfigurationJSON ServiceAccount)
-> Codec
     Object BigQueryConnSourceConfig (ConfigurationJSON ServiceAccount)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BigQueryConnSourceConfig -> ConfigurationJSON ServiceAccount
_cscServiceAccount
        Codec
  Object
  BigQueryConnSourceConfig
  (ConfigurationInputs
   -> ConfigurationInput
   -> Maybe ConfigurationInput
   -> Maybe ConfigurationInput
   -> Maybe ConfigurationInput
   -> BigQueryConnSourceConfig)
-> Codec Object BigQueryConnSourceConfig ConfigurationInputs
-> Codec
     Object
     BigQueryConnSourceConfig
     (ConfigurationInput
      -> Maybe ConfigurationInput
      -> Maybe ConfigurationInput
      -> Maybe ConfigurationInput
      -> BigQueryConnSourceConfig)
forall a b.
Codec Object BigQueryConnSourceConfig (a -> b)
-> Codec Object BigQueryConnSourceConfig a
-> Codec Object BigQueryConnSourceConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ConfigurationInputs ConfigurationInputs
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"datasets"
      ObjectCodec ConfigurationInputs ConfigurationInputs
-> (BigQueryConnSourceConfig -> ConfigurationInputs)
-> Codec Object BigQueryConnSourceConfig ConfigurationInputs
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BigQueryConnSourceConfig -> ConfigurationInputs
_cscDatasets
        Codec
  Object
  BigQueryConnSourceConfig
  (ConfigurationInput
   -> Maybe ConfigurationInput
   -> Maybe ConfigurationInput
   -> Maybe ConfigurationInput
   -> BigQueryConnSourceConfig)
-> Codec Object BigQueryConnSourceConfig ConfigurationInput
-> Codec
     Object
     BigQueryConnSourceConfig
     (Maybe ConfigurationInput
      -> Maybe ConfigurationInput
      -> Maybe ConfigurationInput
      -> BigQueryConnSourceConfig)
forall a b.
Codec Object BigQueryConnSourceConfig (a -> b)
-> Codec Object BigQueryConnSourceConfig a
-> Codec Object BigQueryConnSourceConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ConfigurationInput ConfigurationInput
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"project_id"
      ObjectCodec ConfigurationInput ConfigurationInput
-> (BigQueryConnSourceConfig -> ConfigurationInput)
-> Codec Object BigQueryConnSourceConfig ConfigurationInput
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BigQueryConnSourceConfig -> ConfigurationInput
_cscProjectId
        Codec
  Object
  BigQueryConnSourceConfig
  (Maybe ConfigurationInput
   -> Maybe ConfigurationInput
   -> Maybe ConfigurationInput
   -> BigQueryConnSourceConfig)
-> Codec Object BigQueryConnSourceConfig (Maybe ConfigurationInput)
-> Codec
     Object
     BigQueryConnSourceConfig
     (Maybe ConfigurationInput
      -> Maybe ConfigurationInput -> BigQueryConnSourceConfig)
forall a b.
Codec Object BigQueryConnSourceConfig (a -> b)
-> Codec Object BigQueryConnSourceConfig a
-> Codec Object BigQueryConnSourceConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (Maybe ConfigurationInput) (Maybe ConfigurationInput)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull' Text
"global_select_limit"
      ObjectCodec (Maybe ConfigurationInput) (Maybe ConfigurationInput)
-> (BigQueryConnSourceConfig -> Maybe ConfigurationInput)
-> Codec Object BigQueryConnSourceConfig (Maybe ConfigurationInput)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BigQueryConnSourceConfig -> Maybe ConfigurationInput
_cscGlobalSelectLimit
        Codec
  Object
  BigQueryConnSourceConfig
  (Maybe ConfigurationInput
   -> Maybe ConfigurationInput -> BigQueryConnSourceConfig)
-> Codec Object BigQueryConnSourceConfig (Maybe ConfigurationInput)
-> Codec
     Object
     BigQueryConnSourceConfig
     (Maybe ConfigurationInput -> BigQueryConnSourceConfig)
forall a b.
Codec Object BigQueryConnSourceConfig (a -> b)
-> Codec Object BigQueryConnSourceConfig a
-> Codec Object BigQueryConnSourceConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (Maybe ConfigurationInput) (Maybe ConfigurationInput)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull' Text
"retry_base_delay"
      ObjectCodec (Maybe ConfigurationInput) (Maybe ConfigurationInput)
-> (BigQueryConnSourceConfig -> Maybe ConfigurationInput)
-> Codec Object BigQueryConnSourceConfig (Maybe ConfigurationInput)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BigQueryConnSourceConfig -> Maybe ConfigurationInput
_cscRetryBaseDelay
        Codec
  Object
  BigQueryConnSourceConfig
  (Maybe ConfigurationInput -> BigQueryConnSourceConfig)
-> Codec Object BigQueryConnSourceConfig (Maybe ConfigurationInput)
-> ObjectCodec BigQueryConnSourceConfig BigQueryConnSourceConfig
forall a b.
Codec Object BigQueryConnSourceConfig (a -> b)
-> Codec Object BigQueryConnSourceConfig a
-> Codec Object BigQueryConnSourceConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (Maybe ConfigurationInput) (Maybe ConfigurationInput)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull' Text
"retry_limit"
      ObjectCodec (Maybe ConfigurationInput) (Maybe ConfigurationInput)
-> (BigQueryConnSourceConfig -> Maybe ConfigurationInput)
-> Codec Object BigQueryConnSourceConfig (Maybe ConfigurationInput)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= BigQueryConnSourceConfig -> Maybe ConfigurationInput
_cscRetryLimit

deriving stock instance Show BigQueryConnSourceConfig

deriving instance Hashable BigQueryConnSourceConfig

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
$c== :: RetryOptions -> RetryOptions -> Bool
== :: RetryOptions -> RetryOptions -> Bool
$c/= :: RetryOptions -> RetryOptions -> Bool
/= :: RetryOptions -> RetryOptions -> Bool
Eq)

data BigQueryConnection = BigQueryConnection
  { BigQueryConnection -> ServiceAccount
_bqServiceAccount :: ServiceAccount,
    BigQueryConnection -> BigQueryProjectId
_bqProjectId :: BigQueryProjectId, -- we use this projectId instead of the one from the service account as a service account may have access to multiple projects and we wish to choose which one to use
    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
$c== :: BigQueryConnection -> BigQueryConnection -> Bool
== :: BigQueryConnection -> BigQueryConnection -> Bool
$c/= :: BigQueryConnection -> BigQueryConnection -> Bool
/= :: BigQueryConnection -> BigQueryConnection -> Bool
Eq)

data BigQuerySourceConfig = BigQuerySourceConfig
  { BigQuerySourceConfig -> BigQueryConnection
_scConnection :: BigQueryConnection,
    BigQuerySourceConfig -> [BigQueryDataset]
_scDatasets :: [BigQueryDataset],
    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
$c== :: BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
== :: BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
$c/= :: BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
/= :: BigQuerySourceConfig -> BigQuerySourceConfig -> Bool
Eq)

instance Show BigQuerySourceConfig where
  show :: BigQuerySourceConfig -> String
show BigQuerySourceConfig
_ = String
"(BigQuerySourceConfig <details>)"

instance J.ToJSON BigQuerySourceConfig where
  toJSON :: BigQuerySourceConfig -> Value
toJSON BigQuerySourceConfig {Int64
[BigQueryDataset]
BigQueryConnection
_scConnection :: BigQuerySourceConfig -> BigQueryConnection
_scDatasets :: BigQuerySourceConfig -> [BigQueryDataset]
_scGlobalSelectLimit :: BigQuerySourceConfig -> Int64
_scConnection :: BigQueryConnection
_scDatasets :: [BigQueryDataset]
_scGlobalSelectLimit :: Int64
..} =
    [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
forall v. ToJSON v => Key -> v -> Pair
J..= BigQueryConnection -> ServiceAccount
_bqServiceAccount BigQueryConnection
_scConnection,
          Key
"datasets" Key -> [BigQueryDataset] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= [BigQueryDataset]
_scDatasets,
          Key
"project_id" Key -> BigQueryProjectId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= BigQueryConnection -> BigQueryProjectId
_bqProjectId BigQueryConnection
_scConnection,
          Key
"global_select_limit" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
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
_retryBaseDelay :: RetryOptions -> Microseconds
_retryNumRetries :: RetryOptions -> Int
_retryBaseDelay :: Microseconds
_retryNumRetries :: Int
..} ->
          [ Key
"base_delay" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
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
forall v. ToJSON v => Key -> v -> Pair
J..= Int
_retryNumRetries
          ]
        Maybe RetryOptions
Nothing -> []

-- Note: () ~ ScalarTypeParsingContext 'BigQuery but we can't use the type family instance in the Has instance.
instance Has () BigQuerySourceConfig where
  hasLens :: Lens BigQuerySourceConfig ()
hasLens = (() -> f ()) -> BigQuerySourceConfig -> f BigQuerySourceConfig
forall a (f :: * -> *). Functor f => (() -> f ()) -> a -> f a
united