{-# LANGUAGE OverloadedLists #-}

module Hasura.RQL.Types.Common
  ( RelName (..),
    relNameToTxt,
    fromRemoteRelationship,
    RelType (..),
    relTypeToTxt,
    OID (..),
    FieldName (..),
    Fields,
    InsertOrder (..),
    ToAesonPairs (..),
    InpValInfo (..),
    SystemDefined (..),
    isSystemDefined,
    SQLGenCtx (..),
    successMsg,
    failureMsg,
    InputWebhook (..),
    ResolvedWebhook (..),
    ResolveWebhookError (..),
    resolveWebhook,
    resolveWebhookEither,
    Timeout (..),
    defaultActionTimeoutSecs,
    UrlConf (..),
    resolveUrlConf,
    getEnv,
    getEnvEither,
    SourceName (..),
    defaultSource,
    sourceNameToText,
    JsonAggSelect (..),
    MetricsConfig (..),
    emptyMetricsConfig,
    PGConnectionParams (..),
    getPGConnectionStringFromParams,
    getConnOptionsFromConnParams,
    Comment (..),
    commentToMaybeText,
    commentFromMaybeText,
    EnvRecord (..),
    ApolloFederationConfig (..),
    ApolloFederationVersion (..),
    isApolloFedV1enabled,
    RemoteRelationshipG (..),
    remoteRelationshipCodec,
    rrDefinition,
    rrName,
    TriggerOnReplication (..),
  )
where

import Autodocodec
  ( HasCodec (codec),
    JSONCodec,
    bimapCodec,
    boundedIntegralCodec,
    dimapCodec,
    disjointEitherCodec,
    optionalFieldOrNull',
    requiredField,
    requiredField',
    requiredFieldWith',
    stringConstCodec,
  )
import Autodocodec qualified as AC
import Autodocodec.Extended (boolConstCodec, fromEnvCodec, typeableName)
import Control.Lens (Lens)
import Control.Lens qualified as Lens
import Data.Aeson
import Data.Aeson qualified as J
import Data.Aeson.Types (Parser, prependFailure, typeMismatch)
import Data.Bifunctor (bimap)
import Data.Environment qualified as Env
import Data.Scientific (toBoundedInteger)
import Data.Text qualified as T
import Data.Text.Extended
import Data.Text.NonEmpty
import Data.Typeable (Typeable)
import Data.URL.Template
import Database.PG.Query qualified as PG
import Hasura.Base.Error
import Hasura.Base.ErrorValue qualified as ErrorValue
import Hasura.Base.Instances ()
import Hasura.Base.ToErrorValue
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.Types.Schema.Options qualified as Options
import Language.GraphQL.Draft.Syntax qualified as G
import Language.Haskell.TH.Syntax qualified as TH
import Network.URI
import PostgreSQL.Binary.Decoding qualified as PD

newtype RelName = RelName {RelName -> NonEmptyText
getRelTxt :: NonEmptyText}
  deriving
    ( Int -> RelName -> ShowS
[RelName] -> ShowS
RelName -> String
(Int -> RelName -> ShowS)
-> (RelName -> String) -> ([RelName] -> ShowS) -> Show RelName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelName -> ShowS
showsPrec :: Int -> RelName -> ShowS
$cshow :: RelName -> String
show :: RelName -> String
$cshowList :: [RelName] -> ShowS
showList :: [RelName] -> ShowS
Show,
      RelName -> RelName -> Bool
(RelName -> RelName -> Bool)
-> (RelName -> RelName -> Bool) -> Eq RelName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelName -> RelName -> Bool
== :: RelName -> RelName -> Bool
$c/= :: RelName -> RelName -> Bool
/= :: RelName -> RelName -> Bool
Eq,
      Eq RelName
Eq RelName
-> (RelName -> RelName -> Ordering)
-> (RelName -> RelName -> Bool)
-> (RelName -> RelName -> Bool)
-> (RelName -> RelName -> Bool)
-> (RelName -> RelName -> Bool)
-> (RelName -> RelName -> RelName)
-> (RelName -> RelName -> RelName)
-> Ord RelName
RelName -> RelName -> Bool
RelName -> RelName -> Ordering
RelName -> RelName -> RelName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RelName -> RelName -> Ordering
compare :: RelName -> RelName -> Ordering
$c< :: RelName -> RelName -> Bool
< :: RelName -> RelName -> Bool
$c<= :: RelName -> RelName -> Bool
<= :: RelName -> RelName -> Bool
$c> :: RelName -> RelName -> Bool
> :: RelName -> RelName -> Bool
$c>= :: RelName -> RelName -> Bool
>= :: RelName -> RelName -> Bool
$cmax :: RelName -> RelName -> RelName
max :: RelName -> RelName -> RelName
$cmin :: RelName -> RelName -> RelName
min :: RelName -> RelName -> RelName
Ord,
      Eq RelName
Eq RelName
-> (Int -> RelName -> Int) -> (RelName -> Int) -> Hashable RelName
Int -> RelName -> Int
RelName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> RelName -> Int
hashWithSalt :: Int -> RelName -> Int
$chash :: RelName -> Int
hash :: RelName -> Int
Hashable,
      Value -> Parser [RelName]
Value -> Parser RelName
(Value -> Parser RelName)
-> (Value -> Parser [RelName]) -> FromJSON RelName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RelName
parseJSON :: Value -> Parser RelName
$cparseJSONList :: Value -> Parser [RelName]
parseJSONList :: Value -> Parser [RelName]
FromJSON,
      FromJSONKeyFunction [RelName]
FromJSONKeyFunction RelName
FromJSONKeyFunction RelName
-> FromJSONKeyFunction [RelName] -> FromJSONKey RelName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction RelName
fromJSONKey :: FromJSONKeyFunction RelName
$cfromJSONKeyList :: FromJSONKeyFunction [RelName]
fromJSONKeyList :: FromJSONKeyFunction [RelName]
FromJSONKey,
      [RelName] -> Value
[RelName] -> Encoding
RelName -> Value
RelName -> Encoding
(RelName -> Value)
-> (RelName -> Encoding)
-> ([RelName] -> Value)
-> ([RelName] -> Encoding)
-> ToJSON RelName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RelName -> Value
toJSON :: RelName -> Value
$ctoEncoding :: RelName -> Encoding
toEncoding :: RelName -> Encoding
$ctoJSONList :: [RelName] -> Value
toJSONList :: [RelName] -> Value
$ctoEncodingList :: [RelName] -> Encoding
toEncodingList :: [RelName] -> Encoding
ToJSON,
      ToJSONKeyFunction [RelName]
ToJSONKeyFunction RelName
ToJSONKeyFunction RelName
-> ToJSONKeyFunction [RelName] -> ToJSONKey RelName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction RelName
toJSONKey :: ToJSONKeyFunction RelName
$ctoJSONKeyList :: ToJSONKeyFunction [RelName]
toJSONKeyList :: ToJSONKeyFunction [RelName]
ToJSONKey,
      RelName -> PrepArg
(RelName -> PrepArg) -> ToPrepArg RelName
forall a. (a -> PrepArg) -> ToPrepArg a
$ctoPrepVal :: RelName -> PrepArg
toPrepVal :: RelName -> PrepArg
PG.ToPrepArg,
      Maybe ByteString -> Either Text RelName
(Maybe ByteString -> Either Text RelName) -> FromCol RelName
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text RelName
fromCol :: Maybe ByteString -> Either Text RelName
PG.FromCol,
      (forall x. RelName -> Rep RelName x)
-> (forall x. Rep RelName x -> RelName) -> Generic RelName
forall x. Rep RelName x -> RelName
forall x. RelName -> Rep RelName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RelName -> Rep RelName x
from :: forall x. RelName -> Rep RelName x
$cto :: forall x. Rep RelName x -> RelName
to :: forall x. Rep RelName x -> RelName
Generic,
      RelName -> ()
(RelName -> ()) -> NFData RelName
forall a. (a -> ()) -> NFData a
$crnf :: RelName -> ()
rnf :: RelName -> ()
NFData
    )

instance ToTxt RelName where
  toTxt :: RelName -> Text
toTxt = RelName -> Text
relNameToTxt

instance HasCodec RelName where
  codec :: JSONCodec RelName
codec = (NonEmptyText -> RelName)
-> (RelName -> NonEmptyText)
-> Codec Value NonEmptyText NonEmptyText
-> JSONCodec RelName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec NonEmptyText -> RelName
RelName RelName -> NonEmptyText
getRelTxt Codec Value NonEmptyText NonEmptyText
forall value. HasCodec value => JSONCodec value
codec

relNameToTxt :: RelName -> Text
relNameToTxt :: RelName -> Text
relNameToTxt = NonEmptyText -> Text
unNonEmptyText (NonEmptyText -> Text)
-> (RelName -> NonEmptyText) -> RelName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelName -> NonEmptyText
getRelTxt

fromRemoteRelationship :: RelName -> FieldName
fromRemoteRelationship :: RelName -> FieldName
fromRemoteRelationship = Text -> FieldName
FieldName (Text -> FieldName) -> (RelName -> Text) -> RelName -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelName -> Text
relNameToTxt

data RelType
  = ObjRel
  | ArrRel
  deriving (Int -> RelType -> ShowS
[RelType] -> ShowS
RelType -> String
(Int -> RelType -> ShowS)
-> (RelType -> String) -> ([RelType] -> ShowS) -> Show RelType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelType -> ShowS
showsPrec :: Int -> RelType -> ShowS
$cshow :: RelType -> String
show :: RelType -> String
$cshowList :: [RelType] -> ShowS
showList :: [RelType] -> ShowS
Show, RelType -> RelType -> Bool
(RelType -> RelType -> Bool)
-> (RelType -> RelType -> Bool) -> Eq RelType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelType -> RelType -> Bool
== :: RelType -> RelType -> Bool
$c/= :: RelType -> RelType -> Bool
/= :: RelType -> RelType -> Bool
Eq, Eq RelType
Eq RelType
-> (RelType -> RelType -> Ordering)
-> (RelType -> RelType -> Bool)
-> (RelType -> RelType -> Bool)
-> (RelType -> RelType -> Bool)
-> (RelType -> RelType -> Bool)
-> (RelType -> RelType -> RelType)
-> (RelType -> RelType -> RelType)
-> Ord RelType
RelType -> RelType -> Bool
RelType -> RelType -> Ordering
RelType -> RelType -> RelType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RelType -> RelType -> Ordering
compare :: RelType -> RelType -> Ordering
$c< :: RelType -> RelType -> Bool
< :: RelType -> RelType -> Bool
$c<= :: RelType -> RelType -> Bool
<= :: RelType -> RelType -> Bool
$c> :: RelType -> RelType -> Bool
> :: RelType -> RelType -> Bool
$c>= :: RelType -> RelType -> Bool
>= :: RelType -> RelType -> Bool
$cmax :: RelType -> RelType -> RelType
max :: RelType -> RelType -> RelType
$cmin :: RelType -> RelType -> RelType
min :: RelType -> RelType -> RelType
Ord, (forall x. RelType -> Rep RelType x)
-> (forall x. Rep RelType x -> RelType) -> Generic RelType
forall x. Rep RelType x -> RelType
forall x. RelType -> Rep RelType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RelType -> Rep RelType x
from :: forall x. RelType -> Rep RelType x
$cto :: forall x. Rep RelType x -> RelType
to :: forall x. Rep RelType x -> RelType
Generic, Typeable RelType
Typeable RelType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RelType -> c RelType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RelType)
-> (RelType -> Constr)
-> (RelType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RelType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RelType))
-> ((forall b. Data b => b -> b) -> RelType -> RelType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RelType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RelType -> r)
-> (forall u. (forall d. Data d => d -> u) -> RelType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RelType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RelType -> m RelType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RelType -> m RelType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RelType -> m RelType)
-> Data RelType
RelType -> Constr
RelType -> DataType
(forall b. Data b => b -> b) -> RelType -> RelType
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) -> RelType -> u
forall u. (forall d. Data d => d -> u) -> RelType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RelType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RelType -> c RelType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RelType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RelType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RelType -> c RelType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RelType -> c RelType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RelType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RelType
$ctoConstr :: RelType -> Constr
toConstr :: RelType -> Constr
$cdataTypeOf :: RelType -> DataType
dataTypeOf :: RelType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RelType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RelType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RelType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RelType)
$cgmapT :: (forall b. Data b => b -> b) -> RelType -> RelType
gmapT :: (forall b. Data b => b -> b) -> RelType -> RelType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RelType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RelType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RelType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RelType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
Data)

instance NFData RelType

instance Hashable RelType

instance HasCodec RelType where
  codec :: JSONCodec RelType
codec =
    NonEmpty (RelType, Text) -> JSONCodec RelType
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec
      [ (RelType
ObjRel, RelType -> Text
relTypeToTxt RelType
ObjRel),
        (RelType
ArrRel, RelType -> Text
relTypeToTxt RelType
ArrRel)
      ]

instance ToJSON RelType where
  toJSON :: RelType -> Value
toJSON = Text -> Value
String (Text -> Value) -> (RelType -> Text) -> RelType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelType -> Text
relTypeToTxt

instance FromJSON RelType where
  parseJSON :: Value -> Parser RelType
parseJSON (String Text
"object") = RelType -> Parser RelType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return RelType
ObjRel
  parseJSON (String Text
"array") = RelType -> Parser RelType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return RelType
ArrRel
  parseJSON Value
_ = String -> Parser RelType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting either 'object' or 'array' for rel_type"

instance PG.FromCol RelType where
  fromCol :: Maybe ByteString -> Either Text RelType
fromCol Maybe ByteString
bs = (Value RelType -> Maybe ByteString -> Either Text RelType)
-> Maybe ByteString -> Value RelType -> Either Text RelType
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value RelType -> Maybe ByteString -> Either Text RelType
forall a. Value a -> Maybe ByteString -> Either Text a
PG.fromColHelper Maybe ByteString
bs
    (Value RelType -> Either Text RelType)
-> Value RelType -> Either Text RelType
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe RelType) -> Value RelType
forall a. (Text -> Maybe a) -> Value a
PD.enum
    ((Text -> Maybe RelType) -> Value RelType)
-> (Text -> Maybe RelType) -> Value RelType
forall a b. (a -> b) -> a -> b
$ \case
      Text
"object" -> RelType -> Maybe RelType
forall a. a -> Maybe a
Just RelType
ObjRel
      Text
"array" -> RelType -> Maybe RelType
forall a. a -> Maybe a
Just RelType
ArrRel
      Text
_ -> Maybe RelType
forall a. Maybe a
Nothing

relTypeToTxt :: RelType -> Text
relTypeToTxt :: RelType -> Text
relTypeToTxt RelType
ObjRel = Text
"object"
relTypeToTxt RelType
ArrRel = Text
"array"

data JsonAggSelect
  = JASMultipleRows
  | JASSingleObject
  deriving (Int -> JsonAggSelect -> ShowS
[JsonAggSelect] -> ShowS
JsonAggSelect -> String
(Int -> JsonAggSelect -> ShowS)
-> (JsonAggSelect -> String)
-> ([JsonAggSelect] -> ShowS)
-> Show JsonAggSelect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonAggSelect -> ShowS
showsPrec :: Int -> JsonAggSelect -> ShowS
$cshow :: JsonAggSelect -> String
show :: JsonAggSelect -> String
$cshowList :: [JsonAggSelect] -> ShowS
showList :: [JsonAggSelect] -> ShowS
Show, JsonAggSelect -> JsonAggSelect -> Bool
(JsonAggSelect -> JsonAggSelect -> Bool)
-> (JsonAggSelect -> JsonAggSelect -> Bool) -> Eq JsonAggSelect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonAggSelect -> JsonAggSelect -> Bool
== :: JsonAggSelect -> JsonAggSelect -> Bool
$c/= :: JsonAggSelect -> JsonAggSelect -> Bool
/= :: JsonAggSelect -> JsonAggSelect -> Bool
Eq, (forall x. JsonAggSelect -> Rep JsonAggSelect x)
-> (forall x. Rep JsonAggSelect x -> JsonAggSelect)
-> Generic JsonAggSelect
forall x. Rep JsonAggSelect x -> JsonAggSelect
forall x. JsonAggSelect -> Rep JsonAggSelect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonAggSelect -> Rep JsonAggSelect x
from :: forall x. JsonAggSelect -> Rep JsonAggSelect x
$cto :: forall x. Rep JsonAggSelect x -> JsonAggSelect
to :: forall x. Rep JsonAggSelect x -> JsonAggSelect
Generic)

instance Hashable JsonAggSelect

instance ToJSON JsonAggSelect where
  toJSON :: JsonAggSelect -> Value
toJSON = \case
    JsonAggSelect
JASMultipleRows -> Value
"multiple_rows"
    JsonAggSelect
JASSingleObject -> Value
"single_row"

data InsertOrder = BeforeParent | AfterParent
  deriving (Int -> InsertOrder -> ShowS
[InsertOrder] -> ShowS
InsertOrder -> String
(Int -> InsertOrder -> ShowS)
-> (InsertOrder -> String)
-> ([InsertOrder] -> ShowS)
-> Show InsertOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertOrder -> ShowS
showsPrec :: Int -> InsertOrder -> ShowS
$cshow :: InsertOrder -> String
show :: InsertOrder -> String
$cshowList :: [InsertOrder] -> ShowS
showList :: [InsertOrder] -> ShowS
Show, InsertOrder -> InsertOrder -> Bool
(InsertOrder -> InsertOrder -> Bool)
-> (InsertOrder -> InsertOrder -> Bool) -> Eq InsertOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InsertOrder -> InsertOrder -> Bool
== :: InsertOrder -> InsertOrder -> Bool
$c/= :: InsertOrder -> InsertOrder -> Bool
/= :: InsertOrder -> InsertOrder -> Bool
Eq, Eq InsertOrder
Eq InsertOrder
-> (InsertOrder -> InsertOrder -> Ordering)
-> (InsertOrder -> InsertOrder -> Bool)
-> (InsertOrder -> InsertOrder -> Bool)
-> (InsertOrder -> InsertOrder -> Bool)
-> (InsertOrder -> InsertOrder -> Bool)
-> (InsertOrder -> InsertOrder -> InsertOrder)
-> (InsertOrder -> InsertOrder -> InsertOrder)
-> Ord InsertOrder
InsertOrder -> InsertOrder -> Bool
InsertOrder -> InsertOrder -> Ordering
InsertOrder -> InsertOrder -> InsertOrder
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InsertOrder -> InsertOrder -> Ordering
compare :: InsertOrder -> InsertOrder -> Ordering
$c< :: InsertOrder -> InsertOrder -> Bool
< :: InsertOrder -> InsertOrder -> Bool
$c<= :: InsertOrder -> InsertOrder -> Bool
<= :: InsertOrder -> InsertOrder -> Bool
$c> :: InsertOrder -> InsertOrder -> Bool
> :: InsertOrder -> InsertOrder -> Bool
$c>= :: InsertOrder -> InsertOrder -> Bool
>= :: InsertOrder -> InsertOrder -> Bool
$cmax :: InsertOrder -> InsertOrder -> InsertOrder
max :: InsertOrder -> InsertOrder -> InsertOrder
$cmin :: InsertOrder -> InsertOrder -> InsertOrder
min :: InsertOrder -> InsertOrder -> InsertOrder
Ord, (forall x. InsertOrder -> Rep InsertOrder x)
-> (forall x. Rep InsertOrder x -> InsertOrder)
-> Generic InsertOrder
forall x. Rep InsertOrder x -> InsertOrder
forall x. InsertOrder -> Rep InsertOrder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InsertOrder -> Rep InsertOrder x
from :: forall x. InsertOrder -> Rep InsertOrder x
$cto :: forall x. Rep InsertOrder x -> InsertOrder
to :: forall x. Rep InsertOrder x -> InsertOrder
Generic)

instance NFData InsertOrder

instance Hashable InsertOrder

instance HasCodec InsertOrder where
  codec :: JSONCodec InsertOrder
codec =
    NonEmpty (InsertOrder, Text) -> JSONCodec InsertOrder
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec
      [ (InsertOrder
BeforeParent, Text
"before_parent"),
        (InsertOrder
AfterParent, Text
"after_parent")
      ]

instance FromJSON InsertOrder where
  parseJSON :: Value -> Parser InsertOrder
parseJSON (String Text
t)
    | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"before_parent" = InsertOrder -> Parser InsertOrder
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InsertOrder
BeforeParent
    | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"after_parent" = InsertOrder -> Parser InsertOrder
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InsertOrder
AfterParent
  parseJSON Value
_ =
    String -> Parser InsertOrder
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"insertion_order should be 'before_parent' or 'after_parent'"

instance ToJSON InsertOrder where
  toJSON :: InsertOrder -> Value
toJSON = \case
    InsertOrder
BeforeParent -> Text -> Value
String Text
"before_parent"
    InsertOrder
AfterParent -> Text -> Value
String Text
"after_parent"

-- | Postgres OIDs. <https://www.postgresql.org/docs/12/datatype-oid.html>
newtype OID = OID {OID -> Int
unOID :: Int}
  deriving (Int -> OID -> ShowS
[OID] -> ShowS
OID -> String
(Int -> OID -> ShowS)
-> (OID -> String) -> ([OID] -> ShowS) -> Show OID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OID -> ShowS
showsPrec :: Int -> OID -> ShowS
$cshow :: OID -> String
show :: OID -> String
$cshowList :: [OID] -> ShowS
showList :: [OID] -> ShowS
Show, OID -> OID -> Bool
(OID -> OID -> Bool) -> (OID -> OID -> Bool) -> Eq OID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OID -> OID -> Bool
== :: OID -> OID -> Bool
$c/= :: OID -> OID -> Bool
/= :: OID -> OID -> Bool
Eq, OID -> ()
(OID -> ()) -> NFData OID
forall a. (a -> ()) -> NFData a
$crnf :: OID -> ()
rnf :: OID -> ()
NFData, Eq OID
Eq OID -> (Int -> OID -> Int) -> (OID -> Int) -> Hashable OID
Int -> OID -> Int
OID -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> OID -> Int
hashWithSalt :: Int -> OID -> Int
$chash :: OID -> Int
hash :: OID -> Int
Hashable, [OID] -> Value
[OID] -> Encoding
OID -> Value
OID -> Encoding
(OID -> Value)
-> (OID -> Encoding)
-> ([OID] -> Value)
-> ([OID] -> Encoding)
-> ToJSON OID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OID -> Value
toJSON :: OID -> Value
$ctoEncoding :: OID -> Encoding
toEncoding :: OID -> Encoding
$ctoJSONList :: [OID] -> Value
toJSONList :: [OID] -> Value
$ctoEncodingList :: [OID] -> Encoding
toEncodingList :: [OID] -> Encoding
ToJSON, Value -> Parser [OID]
Value -> Parser OID
(Value -> Parser OID) -> (Value -> Parser [OID]) -> FromJSON OID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OID
parseJSON :: Value -> Parser OID
$cparseJSONList :: Value -> Parser [OID]
parseJSONList :: Value -> Parser [OID]
FromJSON, Maybe ByteString -> Either Text OID
(Maybe ByteString -> Either Text OID) -> FromCol OID
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text OID
fromCol :: Maybe ByteString -> Either Text OID
PG.FromCol)

newtype FieldName = FieldName {FieldName -> Text
getFieldNameTxt :: Text}
  deriving
    ( Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
(Int -> FieldName -> ShowS)
-> (FieldName -> String)
-> ([FieldName] -> ShowS)
-> Show FieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldName -> ShowS
showsPrec :: Int -> FieldName -> ShowS
$cshow :: FieldName -> String
show :: FieldName -> String
$cshowList :: [FieldName] -> ShowS
showList :: [FieldName] -> ShowS
Show,
      FieldName -> FieldName -> Bool
(FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool) -> Eq FieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldName -> FieldName -> Bool
== :: FieldName -> FieldName -> Bool
$c/= :: FieldName -> FieldName -> Bool
/= :: FieldName -> FieldName -> Bool
Eq,
      Eq FieldName
Eq FieldName
-> (FieldName -> FieldName -> Ordering)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> FieldName)
-> (FieldName -> FieldName -> FieldName)
-> Ord FieldName
FieldName -> FieldName -> Bool
FieldName -> FieldName -> Ordering
FieldName -> FieldName -> FieldName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FieldName -> FieldName -> Ordering
compare :: FieldName -> FieldName -> Ordering
$c< :: FieldName -> FieldName -> Bool
< :: FieldName -> FieldName -> Bool
$c<= :: FieldName -> FieldName -> Bool
<= :: FieldName -> FieldName -> Bool
$c> :: FieldName -> FieldName -> Bool
> :: FieldName -> FieldName -> Bool
$c>= :: FieldName -> FieldName -> Bool
>= :: FieldName -> FieldName -> Bool
$cmax :: FieldName -> FieldName -> FieldName
max :: FieldName -> FieldName -> FieldName
$cmin :: FieldName -> FieldName -> FieldName
min :: FieldName -> FieldName -> FieldName
Ord,
      Eq FieldName
Eq FieldName
-> (Int -> FieldName -> Int)
-> (FieldName -> Int)
-> Hashable FieldName
Int -> FieldName -> Int
FieldName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FieldName -> Int
hashWithSalt :: Int -> FieldName -> Int
$chash :: FieldName -> Int
hash :: FieldName -> Int
Hashable,
      Value -> Parser [FieldName]
Value -> Parser FieldName
(Value -> Parser FieldName)
-> (Value -> Parser [FieldName]) -> FromJSON FieldName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FieldName
parseJSON :: Value -> Parser FieldName
$cparseJSONList :: Value -> Parser [FieldName]
parseJSONList :: Value -> Parser [FieldName]
FromJSON,
      [FieldName] -> Value
[FieldName] -> Encoding
FieldName -> Value
FieldName -> Encoding
(FieldName -> Value)
-> (FieldName -> Encoding)
-> ([FieldName] -> Value)
-> ([FieldName] -> Encoding)
-> ToJSON FieldName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FieldName -> Value
toJSON :: FieldName -> Value
$ctoEncoding :: FieldName -> Encoding
toEncoding :: FieldName -> Encoding
$ctoJSONList :: [FieldName] -> Value
toJSONList :: [FieldName] -> Value
$ctoEncodingList :: [FieldName] -> Encoding
toEncodingList :: [FieldName] -> Encoding
ToJSON,
      FromJSONKeyFunction [FieldName]
FromJSONKeyFunction FieldName
FromJSONKeyFunction FieldName
-> FromJSONKeyFunction [FieldName] -> FromJSONKey FieldName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction FieldName
fromJSONKey :: FromJSONKeyFunction FieldName
$cfromJSONKeyList :: FromJSONKeyFunction [FieldName]
fromJSONKeyList :: FromJSONKeyFunction [FieldName]
FromJSONKey,
      ToJSONKeyFunction [FieldName]
ToJSONKeyFunction FieldName
ToJSONKeyFunction FieldName
-> ToJSONKeyFunction [FieldName] -> ToJSONKey FieldName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction FieldName
toJSONKey :: ToJSONKeyFunction FieldName
$ctoJSONKeyList :: ToJSONKeyFunction [FieldName]
toJSONKeyList :: ToJSONKeyFunction [FieldName]
ToJSONKey,
      Typeable FieldName
Typeable FieldName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FieldName -> c FieldName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FieldName)
-> (FieldName -> Constr)
-> (FieldName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FieldName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName))
-> ((forall b. Data b => b -> b) -> FieldName -> FieldName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldName -> r)
-> (forall u. (forall d. Data d => d -> u) -> FieldName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FieldName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FieldName -> m FieldName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FieldName -> m FieldName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FieldName -> m FieldName)
-> Data FieldName
FieldName -> Constr
FieldName -> DataType
(forall b. Data b => b -> b) -> FieldName -> FieldName
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) -> FieldName -> u
forall u. (forall d. Data d => d -> u) -> FieldName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldName -> c FieldName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldName -> c FieldName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldName -> c FieldName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldName
$ctoConstr :: FieldName -> Constr
toConstr :: FieldName -> Constr
$cdataTypeOf :: FieldName -> DataType
dataTypeOf :: FieldName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName)
$cgmapT :: (forall b. Data b => b -> b) -> FieldName -> FieldName
gmapT :: (forall b. Data b => b -> b) -> FieldName -> FieldName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FieldName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FieldName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FieldName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FieldName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
Data,
      (forall x. FieldName -> Rep FieldName x)
-> (forall x. Rep FieldName x -> FieldName) -> Generic FieldName
forall x. Rep FieldName x -> FieldName
forall x. FieldName -> Rep FieldName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FieldName -> Rep FieldName x
from :: forall x. FieldName -> Rep FieldName x
$cto :: forall x. Rep FieldName x -> FieldName
to :: forall x. Rep FieldName x -> FieldName
Generic,
      String -> FieldName
(String -> FieldName) -> IsString FieldName
forall a. (String -> a) -> IsString a
$cfromString :: String -> FieldName
fromString :: String -> FieldName
IsString,
      FieldName -> ()
(FieldName -> ()) -> NFData FieldName
forall a. (a -> ()) -> NFData a
$crnf :: FieldName -> ()
rnf :: FieldName -> ()
NFData,
      NonEmpty FieldName -> FieldName
FieldName -> FieldName -> FieldName
(FieldName -> FieldName -> FieldName)
-> (NonEmpty FieldName -> FieldName)
-> (forall b. Integral b => b -> FieldName -> FieldName)
-> Semigroup FieldName
forall b. Integral b => b -> FieldName -> FieldName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: FieldName -> FieldName -> FieldName
<> :: FieldName -> FieldName -> FieldName
$csconcat :: NonEmpty FieldName -> FieldName
sconcat :: NonEmpty FieldName -> FieldName
$cstimes :: forall b. Integral b => b -> FieldName -> FieldName
stimes :: forall b. Integral b => b -> FieldName -> FieldName
Semigroup
    )

instance ToTxt FieldName where
  toTxt :: FieldName -> Text
toTxt (FieldName Text
c) = Text
c

instance HasCodec FieldName where
  codec :: JSONCodec FieldName
codec = (Text -> FieldName)
-> (FieldName -> Text)
-> Codec Value Text Text
-> JSONCodec FieldName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> FieldName
FieldName FieldName -> Text
getFieldNameTxt Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

-- The field name here is the GraphQL alias, i.e, the name with which the field
-- should appear in the response
type Fields a = [(FieldName, a)]

class ToAesonPairs a where
  toAesonPairs :: (KeyValue v) => a -> [v]

data SourceName
  = SNDefault
  | SNName NonEmptyText
  deriving (Int -> SourceName -> ShowS
[SourceName] -> ShowS
SourceName -> String
(Int -> SourceName -> ShowS)
-> (SourceName -> String)
-> ([SourceName] -> ShowS)
-> Show SourceName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceName -> ShowS
showsPrec :: Int -> SourceName -> ShowS
$cshow :: SourceName -> String
show :: SourceName -> String
$cshowList :: [SourceName] -> ShowS
showList :: [SourceName] -> ShowS
Show, SourceName -> SourceName -> Bool
(SourceName -> SourceName -> Bool)
-> (SourceName -> SourceName -> Bool) -> Eq SourceName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceName -> SourceName -> Bool
== :: SourceName -> SourceName -> Bool
$c/= :: SourceName -> SourceName -> Bool
/= :: SourceName -> SourceName -> Bool
Eq, Eq SourceName
Eq SourceName
-> (SourceName -> SourceName -> Ordering)
-> (SourceName -> SourceName -> Bool)
-> (SourceName -> SourceName -> Bool)
-> (SourceName -> SourceName -> Bool)
-> (SourceName -> SourceName -> Bool)
-> (SourceName -> SourceName -> SourceName)
-> (SourceName -> SourceName -> SourceName)
-> Ord SourceName
SourceName -> SourceName -> Bool
SourceName -> SourceName -> Ordering
SourceName -> SourceName -> SourceName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SourceName -> SourceName -> Ordering
compare :: SourceName -> SourceName -> Ordering
$c< :: SourceName -> SourceName -> Bool
< :: SourceName -> SourceName -> Bool
$c<= :: SourceName -> SourceName -> Bool
<= :: SourceName -> SourceName -> Bool
$c> :: SourceName -> SourceName -> Bool
> :: SourceName -> SourceName -> Bool
$c>= :: SourceName -> SourceName -> Bool
>= :: SourceName -> SourceName -> Bool
$cmax :: SourceName -> SourceName -> SourceName
max :: SourceName -> SourceName -> SourceName
$cmin :: SourceName -> SourceName -> SourceName
min :: SourceName -> SourceName -> SourceName
Ord, (forall x. SourceName -> Rep SourceName x)
-> (forall x. Rep SourceName x -> SourceName) -> Generic SourceName
forall x. Rep SourceName x -> SourceName
forall x. SourceName -> Rep SourceName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourceName -> Rep SourceName x
from :: forall x. SourceName -> Rep SourceName x
$cto :: forall x. Rep SourceName x -> SourceName
to :: forall x. Rep SourceName x -> SourceName
Generic)

sourceNameParser :: Text -> Parser SourceName
sourceNameParser :: Text -> Parser SourceName
sourceNameParser = \case
  Text
"default" -> SourceName -> Parser SourceName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceName
SNDefault
  Text
t -> NonEmptyText -> SourceName
SNName (NonEmptyText -> SourceName)
-> Parser NonEmptyText -> Parser SourceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NonEmptyText
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
String Text
t)

instance FromJSON SourceName where
  parseJSON :: Value -> Parser SourceName
parseJSON = String -> (Text -> Parser SourceName) -> Value -> Parser SourceName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"String" Text -> Parser SourceName
sourceNameParser

instance FromJSONKey SourceName

instance HasCodec SourceName where
  codec :: JSONCodec SourceName
codec = (NonEmptyText -> SourceName)
-> (SourceName -> NonEmptyText)
-> Codec Value NonEmptyText NonEmptyText
-> JSONCodec SourceName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec NonEmptyText -> SourceName
dec SourceName -> NonEmptyText
enc Codec Value NonEmptyText NonEmptyText
nonEmptyTextCodec
    where
      dec :: NonEmptyText -> SourceName
dec NonEmptyText
t
        | NonEmptyText
t NonEmptyText -> NonEmptyText -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmptyText
defaultSourceName = SourceName
SNDefault
        | Bool
otherwise = NonEmptyText -> SourceName
SNName NonEmptyText
t

      enc :: SourceName -> NonEmptyText
enc SourceName
SNDefault = NonEmptyText
defaultSourceName
      enc (SNName NonEmptyText
t) = NonEmptyText
t

sourceNameToText :: SourceName -> Text
sourceNameToText :: SourceName -> Text
sourceNameToText = \case
  SourceName
SNDefault -> NonEmptyText -> Text
unNonEmptyText NonEmptyText
defaultSourceName
  SNName NonEmptyText
t -> NonEmptyText -> Text
unNonEmptyText NonEmptyText
t

instance ToJSON SourceName where
  toJSON :: SourceName -> Value
toJSON = Text -> Value
String (Text -> Value) -> (SourceName -> Text) -> SourceName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> Text
sourceNameToText

instance ToTxt SourceName where
  toTxt :: SourceName -> Text
toTxt = SourceName -> Text
sourceNameToText

instance ToErrorValue SourceName where
  toErrorValue :: SourceName -> ErrorMessage
toErrorValue = \case
    SourceName
SNDefault -> ErrorMessage
"default"
    SNName NonEmptyText
t -> Text -> ErrorMessage
ErrorValue.squote (NonEmptyText -> Text
unNonEmptyText NonEmptyText
t)

instance ToJSONKey SourceName

instance Hashable SourceName

instance NFData SourceName

defaultSource :: SourceName
defaultSource :: SourceName
defaultSource = SourceName
SNDefault

defaultSourceName :: NonEmptyText
defaultSourceName :: NonEmptyText
defaultSourceName = Text -> NonEmptyText
mkNonEmptyTextUnsafe Text
"default"

data InpValInfo = InpValInfo
  { InpValInfo -> Maybe Description
_iviDesc :: Maybe G.Description,
    InpValInfo -> Name
_iviName :: G.Name,
    InpValInfo -> Maybe (Value Void)
_iviDefVal :: Maybe (G.Value Void),
    InpValInfo -> GType
_iviType :: G.GType
  }
  deriving (Int -> InpValInfo -> ShowS
[InpValInfo] -> ShowS
InpValInfo -> String
(Int -> InpValInfo -> ShowS)
-> (InpValInfo -> String)
-> ([InpValInfo] -> ShowS)
-> Show InpValInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InpValInfo -> ShowS
showsPrec :: Int -> InpValInfo -> ShowS
$cshow :: InpValInfo -> String
show :: InpValInfo -> String
$cshowList :: [InpValInfo] -> ShowS
showList :: [InpValInfo] -> ShowS
Show, InpValInfo -> InpValInfo -> Bool
(InpValInfo -> InpValInfo -> Bool)
-> (InpValInfo -> InpValInfo -> Bool) -> Eq InpValInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InpValInfo -> InpValInfo -> Bool
== :: InpValInfo -> InpValInfo -> Bool
$c/= :: InpValInfo -> InpValInfo -> Bool
/= :: InpValInfo -> InpValInfo -> Bool
Eq, (forall (m :: * -> *). Quote m => InpValInfo -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    InpValInfo -> Code m InpValInfo)
-> Lift InpValInfo
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => InpValInfo -> m Exp
forall (m :: * -> *). Quote m => InpValInfo -> Code m InpValInfo
$clift :: forall (m :: * -> *). Quote m => InpValInfo -> m Exp
lift :: forall (m :: * -> *). Quote m => InpValInfo -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => InpValInfo -> Code m InpValInfo
liftTyped :: forall (m :: * -> *). Quote m => InpValInfo -> Code m InpValInfo
TH.Lift, (forall x. InpValInfo -> Rep InpValInfo x)
-> (forall x. Rep InpValInfo x -> InpValInfo) -> Generic InpValInfo
forall x. Rep InpValInfo x -> InpValInfo
forall x. InpValInfo -> Rep InpValInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InpValInfo -> Rep InpValInfo x
from :: forall x. InpValInfo -> Rep InpValInfo x
$cto :: forall x. Rep InpValInfo x -> InpValInfo
to :: forall x. Rep InpValInfo x -> InpValInfo
Generic)

newtype SystemDefined = SystemDefined {SystemDefined -> Bool
unSystemDefined :: Bool}
  deriving (Int -> SystemDefined -> ShowS
[SystemDefined] -> ShowS
SystemDefined -> String
(Int -> SystemDefined -> ShowS)
-> (SystemDefined -> String)
-> ([SystemDefined] -> ShowS)
-> Show SystemDefined
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SystemDefined -> ShowS
showsPrec :: Int -> SystemDefined -> ShowS
$cshow :: SystemDefined -> String
show :: SystemDefined -> String
$cshowList :: [SystemDefined] -> ShowS
showList :: [SystemDefined] -> ShowS
Show, SystemDefined -> SystemDefined -> Bool
(SystemDefined -> SystemDefined -> Bool)
-> (SystemDefined -> SystemDefined -> Bool) -> Eq SystemDefined
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SystemDefined -> SystemDefined -> Bool
== :: SystemDefined -> SystemDefined -> Bool
$c/= :: SystemDefined -> SystemDefined -> Bool
/= :: SystemDefined -> SystemDefined -> Bool
Eq, Value -> Parser [SystemDefined]
Value -> Parser SystemDefined
(Value -> Parser SystemDefined)
-> (Value -> Parser [SystemDefined]) -> FromJSON SystemDefined
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SystemDefined
parseJSON :: Value -> Parser SystemDefined
$cparseJSONList :: Value -> Parser [SystemDefined]
parseJSONList :: Value -> Parser [SystemDefined]
FromJSON, [SystemDefined] -> Value
[SystemDefined] -> Encoding
SystemDefined -> Value
SystemDefined -> Encoding
(SystemDefined -> Value)
-> (SystemDefined -> Encoding)
-> ([SystemDefined] -> Value)
-> ([SystemDefined] -> Encoding)
-> ToJSON SystemDefined
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SystemDefined -> Value
toJSON :: SystemDefined -> Value
$ctoEncoding :: SystemDefined -> Encoding
toEncoding :: SystemDefined -> Encoding
$ctoJSONList :: [SystemDefined] -> Value
toJSONList :: [SystemDefined] -> Value
$ctoEncodingList :: [SystemDefined] -> Encoding
toEncodingList :: [SystemDefined] -> Encoding
ToJSON, SystemDefined -> PrepArg
(SystemDefined -> PrepArg) -> ToPrepArg SystemDefined
forall a. (a -> PrepArg) -> ToPrepArg a
$ctoPrepVal :: SystemDefined -> PrepArg
toPrepVal :: SystemDefined -> PrepArg
PG.ToPrepArg, SystemDefined -> ()
(SystemDefined -> ()) -> NFData SystemDefined
forall a. (a -> ()) -> NFData a
$crnf :: SystemDefined -> ()
rnf :: SystemDefined -> ()
NFData, (forall x. SystemDefined -> Rep SystemDefined x)
-> (forall x. Rep SystemDefined x -> SystemDefined)
-> Generic SystemDefined
forall x. Rep SystemDefined x -> SystemDefined
forall x. SystemDefined -> Rep SystemDefined x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SystemDefined -> Rep SystemDefined x
from :: forall x. SystemDefined -> Rep SystemDefined x
$cto :: forall x. Rep SystemDefined x -> SystemDefined
to :: forall x. Rep SystemDefined x -> SystemDefined
Generic)

isSystemDefined :: SystemDefined -> Bool
isSystemDefined :: SystemDefined -> Bool
isSystemDefined = SystemDefined -> Bool
unSystemDefined

data SQLGenCtx = SQLGenCtx
  { SQLGenCtx -> StringifyNumbers
stringifyNum :: Options.StringifyNumbers,
    SQLGenCtx -> DangerouslyCollapseBooleans
dangerousBooleanCollapse :: Options.DangerouslyCollapseBooleans,
    SQLGenCtx -> OptimizePermissionFilters
optimizePermissionFilters :: Options.OptimizePermissionFilters,
    SQLGenCtx -> BigQueryStringNumericInput
bigqueryStringNumericInput :: Options.BigQueryStringNumericInput
  }
  deriving (Int -> SQLGenCtx -> ShowS
[SQLGenCtx] -> ShowS
SQLGenCtx -> String
(Int -> SQLGenCtx -> ShowS)
-> (SQLGenCtx -> String)
-> ([SQLGenCtx] -> ShowS)
-> Show SQLGenCtx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SQLGenCtx -> ShowS
showsPrec :: Int -> SQLGenCtx -> ShowS
$cshow :: SQLGenCtx -> String
show :: SQLGenCtx -> String
$cshowList :: [SQLGenCtx] -> ShowS
showList :: [SQLGenCtx] -> ShowS
Show, SQLGenCtx -> SQLGenCtx -> Bool
(SQLGenCtx -> SQLGenCtx -> Bool)
-> (SQLGenCtx -> SQLGenCtx -> Bool) -> Eq SQLGenCtx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SQLGenCtx -> SQLGenCtx -> Bool
== :: SQLGenCtx -> SQLGenCtx -> Bool
$c/= :: SQLGenCtx -> SQLGenCtx -> Bool
/= :: SQLGenCtx -> SQLGenCtx -> Bool
Eq)

successMsg :: EncJSON
successMsg :: EncJSON
successMsg = Builder -> EncJSON
encJFromBuilder Builder
"{\"message\":\"success\"}"

failureMsg :: EncJSON
failureMsg :: EncJSON
failureMsg = Builder -> EncJSON
encJFromBuilder Builder
"{\"message\":\"failure\"}"

newtype ResolvedWebhook = ResolvedWebhook {ResolvedWebhook -> Text
unResolvedWebhook :: Text}
  deriving (Int -> ResolvedWebhook -> ShowS
[ResolvedWebhook] -> ShowS
ResolvedWebhook -> String
(Int -> ResolvedWebhook -> ShowS)
-> (ResolvedWebhook -> String)
-> ([ResolvedWebhook] -> ShowS)
-> Show ResolvedWebhook
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResolvedWebhook -> ShowS
showsPrec :: Int -> ResolvedWebhook -> ShowS
$cshow :: ResolvedWebhook -> String
show :: ResolvedWebhook -> String
$cshowList :: [ResolvedWebhook] -> ShowS
showList :: [ResolvedWebhook] -> ShowS
Show, ResolvedWebhook -> ResolvedWebhook -> Bool
(ResolvedWebhook -> ResolvedWebhook -> Bool)
-> (ResolvedWebhook -> ResolvedWebhook -> Bool)
-> Eq ResolvedWebhook
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResolvedWebhook -> ResolvedWebhook -> Bool
== :: ResolvedWebhook -> ResolvedWebhook -> Bool
$c/= :: ResolvedWebhook -> ResolvedWebhook -> Bool
/= :: ResolvedWebhook -> ResolvedWebhook -> Bool
Eq, Value -> Parser [ResolvedWebhook]
Value -> Parser ResolvedWebhook
(Value -> Parser ResolvedWebhook)
-> (Value -> Parser [ResolvedWebhook]) -> FromJSON ResolvedWebhook
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ResolvedWebhook
parseJSON :: Value -> Parser ResolvedWebhook
$cparseJSONList :: Value -> Parser [ResolvedWebhook]
parseJSONList :: Value -> Parser [ResolvedWebhook]
FromJSON, [ResolvedWebhook] -> Value
[ResolvedWebhook] -> Encoding
ResolvedWebhook -> Value
ResolvedWebhook -> Encoding
(ResolvedWebhook -> Value)
-> (ResolvedWebhook -> Encoding)
-> ([ResolvedWebhook] -> Value)
-> ([ResolvedWebhook] -> Encoding)
-> ToJSON ResolvedWebhook
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ResolvedWebhook -> Value
toJSON :: ResolvedWebhook -> Value
$ctoEncoding :: ResolvedWebhook -> Encoding
toEncoding :: ResolvedWebhook -> Encoding
$ctoJSONList :: [ResolvedWebhook] -> Value
toJSONList :: [ResolvedWebhook] -> Value
$ctoEncodingList :: [ResolvedWebhook] -> Encoding
toEncodingList :: [ResolvedWebhook] -> Encoding
ToJSON, Eq ResolvedWebhook
Eq ResolvedWebhook
-> (Int -> ResolvedWebhook -> Int)
-> (ResolvedWebhook -> Int)
-> Hashable ResolvedWebhook
Int -> ResolvedWebhook -> Int
ResolvedWebhook -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ResolvedWebhook -> Int
hashWithSalt :: Int -> ResolvedWebhook -> Int
$chash :: ResolvedWebhook -> Int
hash :: ResolvedWebhook -> Int
Hashable, ResolvedWebhook -> Text
(ResolvedWebhook -> Text) -> ToTxt ResolvedWebhook
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: ResolvedWebhook -> Text
toTxt :: ResolvedWebhook -> Text
ToTxt, (forall x. ResolvedWebhook -> Rep ResolvedWebhook x)
-> (forall x. Rep ResolvedWebhook x -> ResolvedWebhook)
-> Generic ResolvedWebhook
forall x. Rep ResolvedWebhook x -> ResolvedWebhook
forall x. ResolvedWebhook -> Rep ResolvedWebhook x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResolvedWebhook -> Rep ResolvedWebhook x
from :: forall x. ResolvedWebhook -> Rep ResolvedWebhook x
$cto :: forall x. Rep ResolvedWebhook x -> ResolvedWebhook
to :: forall x. Rep ResolvedWebhook x -> ResolvedWebhook
Generic)

instance NFData ResolvedWebhook

newtype InputWebhook = InputWebhook {InputWebhook -> Template
unInputWebhook :: Template}
  deriving (Int -> InputWebhook -> ShowS
[InputWebhook] -> ShowS
InputWebhook -> String
(Int -> InputWebhook -> ShowS)
-> (InputWebhook -> String)
-> ([InputWebhook] -> ShowS)
-> Show InputWebhook
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputWebhook -> ShowS
showsPrec :: Int -> InputWebhook -> ShowS
$cshow :: InputWebhook -> String
show :: InputWebhook -> String
$cshowList :: [InputWebhook] -> ShowS
showList :: [InputWebhook] -> ShowS
Show, InputWebhook -> InputWebhook -> Bool
(InputWebhook -> InputWebhook -> Bool)
-> (InputWebhook -> InputWebhook -> Bool) -> Eq InputWebhook
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputWebhook -> InputWebhook -> Bool
== :: InputWebhook -> InputWebhook -> Bool
$c/= :: InputWebhook -> InputWebhook -> Bool
/= :: InputWebhook -> InputWebhook -> Bool
Eq, (forall x. InputWebhook -> Rep InputWebhook x)
-> (forall x. Rep InputWebhook x -> InputWebhook)
-> Generic InputWebhook
forall x. Rep InputWebhook x -> InputWebhook
forall x. InputWebhook -> Rep InputWebhook x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputWebhook -> Rep InputWebhook x
from :: forall x. InputWebhook -> Rep InputWebhook x
$cto :: forall x. Rep InputWebhook x -> InputWebhook
to :: forall x. Rep InputWebhook x -> InputWebhook
Generic)

instance NFData InputWebhook

instance Hashable InputWebhook

instance HasCodec InputWebhook where
  codec :: JSONCodec InputWebhook
codec = (Template -> InputWebhook)
-> (InputWebhook -> Template)
-> Codec Value Template Template
-> JSONCodec InputWebhook
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Template -> InputWebhook
InputWebhook InputWebhook -> Template
unInputWebhook Codec Value Template Template
urlTemplateCodec
    where
      urlTemplateCodec :: Codec Value Template Template
urlTemplateCodec =
        (Text -> Either String Template)
-> (Template -> Text)
-> Codec Value Text Text
-> Codec Value Template Template
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec
          (ShowS -> Either String Template -> Either String Template
forall e1 e2 a. (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft (String
"Parsing URL template failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++) (Either String Template -> Either String Template)
-> (Text -> Either String Template)
-> Text
-> Either String Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Template
parseTemplate)
          Template -> Text
printTemplate
          Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

instance ToJSON InputWebhook where
  toJSON :: InputWebhook -> Value
toJSON = Text -> Value
String (Text -> Value) -> (InputWebhook -> Text) -> InputWebhook -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> Text
printTemplate (Template -> Text)
-> (InputWebhook -> Template) -> InputWebhook -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputWebhook -> Template
unInputWebhook

instance FromJSON InputWebhook where
  parseJSON :: Value -> Parser InputWebhook
parseJSON = String
-> (Text -> Parser InputWebhook) -> Value -> Parser InputWebhook
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"String" ((Text -> Parser InputWebhook) -> Value -> Parser InputWebhook)
-> (Text -> Parser InputWebhook) -> Value -> Parser InputWebhook
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text -> Either String Template
parseTemplate Text
t of
      Left String
e -> String -> Parser InputWebhook
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser InputWebhook) -> String -> Parser InputWebhook
forall a b. (a -> b) -> a -> b
$ String
"Parsing URL template failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
      Right Template
v -> InputWebhook -> Parser InputWebhook
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputWebhook -> Parser InputWebhook)
-> InputWebhook -> Parser InputWebhook
forall a b. (a -> b) -> a -> b
$ Template -> InputWebhook
InputWebhook Template
v

instance PG.FromCol InputWebhook where
  fromCol :: Maybe ByteString -> Either Text InputWebhook
fromCol Maybe ByteString
bs = do
    Either String Template
urlTemplate <- Text -> Either String Template
parseTemplate (Text -> Either String Template)
-> Either Text Text -> Either Text (Either String Template)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString -> Either Text Text
forall a. FromCol a => Maybe ByteString -> Either Text a
PG.fromCol Maybe ByteString
bs
    (String -> Text)
-> (Template -> InputWebhook)
-> Either String Template
-> Either Text InputWebhook
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (\String
e -> Text
"Parsing URL template failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Template -> InputWebhook
InputWebhook Either String Template
urlTemplate

-- Consists of the environment variable name with missing/invalid value
newtype ResolveWebhookError = ResolveWebhookError {ResolveWebhookError -> Text
unResolveWebhookError :: Text} deriving (Int -> ResolveWebhookError -> ShowS
[ResolveWebhookError] -> ShowS
ResolveWebhookError -> String
(Int -> ResolveWebhookError -> ShowS)
-> (ResolveWebhookError -> String)
-> ([ResolveWebhookError] -> ShowS)
-> Show ResolveWebhookError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResolveWebhookError -> ShowS
showsPrec :: Int -> ResolveWebhookError -> ShowS
$cshow :: ResolveWebhookError -> String
show :: ResolveWebhookError -> String
$cshowList :: [ResolveWebhookError] -> ShowS
showList :: [ResolveWebhookError] -> ShowS
Show, ResolveWebhookError -> Text
(ResolveWebhookError -> Text) -> ToTxt ResolveWebhookError
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: ResolveWebhookError -> Text
toTxt :: ResolveWebhookError -> Text
ToTxt)

resolveWebhook :: (QErrM m) => Env.Environment -> InputWebhook -> m ResolvedWebhook
resolveWebhook :: forall (m :: * -> *).
QErrM m =>
Environment -> InputWebhook -> m ResolvedWebhook
resolveWebhook Environment
env InputWebhook
inputWebhook = do
  let eitherRenderedTemplate :: Either ResolveWebhookError ResolvedWebhook
eitherRenderedTemplate = Environment
-> InputWebhook -> Either ResolveWebhookError ResolvedWebhook
resolveWebhookEither Environment
env InputWebhook
inputWebhook
  Either ResolveWebhookError ResolvedWebhook
-> (ResolveWebhookError -> m ResolvedWebhook) -> m ResolvedWebhook
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft
    Either ResolveWebhookError ResolvedWebhook
eitherRenderedTemplate
    (Code -> Text -> m ResolvedWebhook
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
Unexpected (Text -> m ResolvedWebhook)
-> (ResolveWebhookError -> Text)
-> ResolveWebhookError
-> m ResolvedWebhook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"Value for environment variables not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> (ResolveWebhookError -> Text) -> ResolveWebhookError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolveWebhookError -> Text
unResolveWebhookError)

-- This is similar to `resolveWebhook` but it doesn't fail when an env var is invalid
resolveWebhookEither :: Env.Environment -> InputWebhook -> Either ResolveWebhookError ResolvedWebhook
resolveWebhookEither :: Environment
-> InputWebhook -> Either ResolveWebhookError ResolvedWebhook
resolveWebhookEither Environment
env (InputWebhook Template
urlTemplate) =
  (Text -> ResolveWebhookError)
-> (Text -> ResolvedWebhook)
-> Either Text Text
-> Either ResolveWebhookError ResolvedWebhook
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> ResolveWebhookError
ResolveWebhookError Text -> ResolvedWebhook
ResolvedWebhook (Environment -> Template -> Either Text Text
renderTemplate Environment
env Template
urlTemplate)

newtype Timeout = Timeout {Timeout -> Int
unTimeout :: Int}
  deriving (Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timeout -> ShowS
showsPrec :: Int -> Timeout -> ShowS
$cshow :: Timeout -> String
show :: Timeout -> String
$cshowList :: [Timeout] -> ShowS
showList :: [Timeout] -> ShowS
Show, Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
/= :: Timeout -> Timeout -> Bool
Eq, [Timeout] -> Value
[Timeout] -> Encoding
Timeout -> Value
Timeout -> Encoding
(Timeout -> Value)
-> (Timeout -> Encoding)
-> ([Timeout] -> Value)
-> ([Timeout] -> Encoding)
-> ToJSON Timeout
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Timeout -> Value
toJSON :: Timeout -> Value
$ctoEncoding :: Timeout -> Encoding
toEncoding :: Timeout -> Encoding
$ctoJSONList :: [Timeout] -> Value
toJSONList :: [Timeout] -> Value
$ctoEncodingList :: [Timeout] -> Encoding
toEncodingList :: [Timeout] -> Encoding
ToJSON, (forall x. Timeout -> Rep Timeout x)
-> (forall x. Rep Timeout x -> Timeout) -> Generic Timeout
forall x. Rep Timeout x -> Timeout
forall x. Timeout -> Rep Timeout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Timeout -> Rep Timeout x
from :: forall x. Timeout -> Rep Timeout x
$cto :: forall x. Rep Timeout x -> Timeout
to :: forall x. Rep Timeout x -> Timeout
Generic, Timeout -> ()
(Timeout -> ()) -> NFData Timeout
forall a. (a -> ()) -> NFData a
$crnf :: Timeout -> ()
rnf :: Timeout -> ()
NFData)

instance HasCodec Timeout where
  codec :: JSONCodec Timeout
codec = (Int -> Either String Timeout)
-> (Timeout -> Int) -> Codec Value Int Int -> JSONCodec Timeout
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Int -> Either String Timeout
forall {a}. IsString a => Int -> Either a Timeout
dec Timeout -> Int
enc Codec Value Int Int
forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec
    where
      dec :: Int -> Either a Timeout
dec Int
timeout = case Int
timeout Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 of
        Bool
True -> Timeout -> Either a Timeout
forall a b. b -> Either a b
Right (Timeout -> Either a Timeout) -> Timeout -> Either a Timeout
forall a b. (a -> b) -> a -> b
$ Int -> Timeout
Timeout Int
timeout
        Bool
False -> a -> Either a Timeout
forall a b. a -> Either a b
Left a
"timeout value cannot be negative"
      enc :: Timeout -> Int
enc (Timeout Int
n) = Int
n

instance FromJSON Timeout where
  parseJSON :: Value -> Parser Timeout
parseJSON = String -> (Scientific -> Parser Timeout) -> Value -> Parser Timeout
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"Timeout" ((Scientific -> Parser Timeout) -> Value -> Parser Timeout)
-> (Scientific -> Parser Timeout) -> Value -> Parser Timeout
forall a b. (a -> b) -> a -> b
$ \Scientific
t -> do
    Int
timeout <- Maybe Int -> Parser Int -> Parser Int
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
t) (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Parser Int
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Scientific -> String
forall a. Show a => a -> String
show Scientific
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is out of bounds")
    case Int
timeout Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 of
      Bool
True -> Timeout -> Parser Timeout
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Timeout -> Parser Timeout) -> Timeout -> Parser Timeout
forall a b. (a -> b) -> a -> b
$ Int -> Timeout
Timeout Int
timeout
      Bool
False -> String -> Parser Timeout
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"timeout value cannot be negative"

defaultActionTimeoutSecs :: Timeout
defaultActionTimeoutSecs :: Timeout
defaultActionTimeoutSecs = Int -> Timeout
Timeout Int
30

-- | See API reference here:
--   https://hasura.io/docs/latest/graphql/core/api-reference/syntax-defs.html#pgconnectionparameters
data PGConnectionParams = PGConnectionParams
  { PGConnectionParams -> Text
_pgcpHost :: Text,
    PGConnectionParams -> Text
_pgcpUsername :: Text,
    PGConnectionParams -> Maybe Text
_pgcpPassword :: Maybe Text,
    PGConnectionParams -> Int
_pgcpPort :: Int,
    PGConnectionParams -> Text
_pgcpDatabase :: Text
  }
  deriving (Int -> PGConnectionParams -> ShowS
[PGConnectionParams] -> ShowS
PGConnectionParams -> String
(Int -> PGConnectionParams -> ShowS)
-> (PGConnectionParams -> String)
-> ([PGConnectionParams] -> ShowS)
-> Show PGConnectionParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGConnectionParams -> ShowS
showsPrec :: Int -> PGConnectionParams -> ShowS
$cshow :: PGConnectionParams -> String
show :: PGConnectionParams -> String
$cshowList :: [PGConnectionParams] -> ShowS
showList :: [PGConnectionParams] -> ShowS
Show, PGConnectionParams -> PGConnectionParams -> Bool
(PGConnectionParams -> PGConnectionParams -> Bool)
-> (PGConnectionParams -> PGConnectionParams -> Bool)
-> Eq PGConnectionParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGConnectionParams -> PGConnectionParams -> Bool
== :: PGConnectionParams -> PGConnectionParams -> Bool
$c/= :: PGConnectionParams -> PGConnectionParams -> Bool
/= :: PGConnectionParams -> PGConnectionParams -> Bool
Eq, (forall x. PGConnectionParams -> Rep PGConnectionParams x)
-> (forall x. Rep PGConnectionParams x -> PGConnectionParams)
-> Generic PGConnectionParams
forall x. Rep PGConnectionParams x -> PGConnectionParams
forall x. PGConnectionParams -> Rep PGConnectionParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PGConnectionParams -> Rep PGConnectionParams x
from :: forall x. PGConnectionParams -> Rep PGConnectionParams x
$cto :: forall x. Rep PGConnectionParams x -> PGConnectionParams
to :: forall x. Rep PGConnectionParams x -> PGConnectionParams
Generic)

instance NFData PGConnectionParams

instance Hashable PGConnectionParams

instance HasCodec PGConnectionParams where
  codec :: JSONCodec PGConnectionParams
codec =
    Text
-> ObjectCodec PGConnectionParams PGConnectionParams
-> JSONCodec PGConnectionParams
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"PGConnectionParams"
      (ObjectCodec PGConnectionParams PGConnectionParams
 -> JSONCodec PGConnectionParams)
-> ObjectCodec PGConnectionParams PGConnectionParams
-> JSONCodec PGConnectionParams
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text -> Int -> Text -> PGConnectionParams
PGConnectionParams
      (Text -> Text -> Maybe Text -> Int -> Text -> PGConnectionParams)
-> Codec Object PGConnectionParams Text
-> Codec
     Object
     PGConnectionParams
     (Text -> Maybe Text -> Int -> Text -> PGConnectionParams)
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
"host"
      ObjectCodec Text Text
-> (PGConnectionParams -> Text)
-> Codec Object PGConnectionParams Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= PGConnectionParams -> Text
_pgcpHost
        Codec
  Object
  PGConnectionParams
  (Text -> Maybe Text -> Int -> Text -> PGConnectionParams)
-> Codec Object PGConnectionParams Text
-> Codec
     Object
     PGConnectionParams
     (Maybe Text -> Int -> Text -> PGConnectionParams)
forall a b.
Codec Object PGConnectionParams (a -> b)
-> Codec Object PGConnectionParams a
-> Codec Object PGConnectionParams b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Text Text
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"username"
      ObjectCodec Text Text
-> (PGConnectionParams -> Text)
-> Codec Object PGConnectionParams Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= PGConnectionParams -> Text
_pgcpUsername
        Codec
  Object
  PGConnectionParams
  (Maybe Text -> Int -> Text -> PGConnectionParams)
-> Codec Object PGConnectionParams (Maybe Text)
-> Codec
     Object PGConnectionParams (Int -> Text -> PGConnectionParams)
forall a b.
Codec Object PGConnectionParams (a -> b)
-> Codec Object PGConnectionParams a
-> Codec Object PGConnectionParams b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Text) (Maybe Text)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull' Text
"password"
      ObjectCodec (Maybe Text) (Maybe Text)
-> (PGConnectionParams -> Maybe Text)
-> Codec Object PGConnectionParams (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= PGConnectionParams -> Maybe Text
_pgcpPassword
        Codec Object PGConnectionParams (Int -> Text -> PGConnectionParams)
-> Codec Object PGConnectionParams Int
-> Codec Object PGConnectionParams (Text -> PGConnectionParams)
forall a b.
Codec Object PGConnectionParams (a -> b)
-> Codec Object PGConnectionParams a
-> Codec Object PGConnectionParams b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Int Int
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"port"
      ObjectCodec Int Int
-> (PGConnectionParams -> Int)
-> Codec Object PGConnectionParams Int
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= PGConnectionParams -> Int
_pgcpPort
        Codec Object PGConnectionParams (Text -> PGConnectionParams)
-> Codec Object PGConnectionParams Text
-> ObjectCodec PGConnectionParams PGConnectionParams
forall a b.
Codec Object PGConnectionParams (a -> b)
-> Codec Object PGConnectionParams a
-> Codec Object PGConnectionParams b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Text Text
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"database"
      ObjectCodec Text Text
-> (PGConnectionParams -> Text)
-> Codec Object PGConnectionParams Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= PGConnectionParams -> Text
_pgcpDatabase

-- TODO: Use HasCodec to define Aeson instances?
instance ToJSON PGConnectionParams where
  toJSON :: PGConnectionParams -> Value
toJSON PGConnectionParams {Int
Maybe Text
Text
_pgcpHost :: PGConnectionParams -> Text
_pgcpUsername :: PGConnectionParams -> Text
_pgcpPassword :: PGConnectionParams -> Maybe Text
_pgcpPort :: PGConnectionParams -> Int
_pgcpDatabase :: PGConnectionParams -> Text
_pgcpHost :: Text
_pgcpUsername :: Text
_pgcpPassword :: Maybe Text
_pgcpPort :: Int
_pgcpDatabase :: Text
..} =
    [Pair] -> Value
J.object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Key
"host" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_pgcpHost,
          Key
"username" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_pgcpUsername,
          Key
"port" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Int
_pgcpPort,
          Key
"database" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_pgcpDatabase
        ]
      [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"password" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Text
_pgcpPassword | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
_pgcpPassword]

instance FromJSON PGConnectionParams where
  parseJSON :: Value -> Parser PGConnectionParams
parseJSON = String
-> (Object -> Parser PGConnectionParams)
-> Value
-> Parser PGConnectionParams
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PGConnectionParams" ((Object -> Parser PGConnectionParams)
 -> Value -> Parser PGConnectionParams)
-> (Object -> Parser PGConnectionParams)
-> Value
-> Parser PGConnectionParams
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Maybe Text -> Int -> Text -> PGConnectionParams
PGConnectionParams
      (Text -> Text -> Maybe Text -> Int -> Text -> PGConnectionParams)
-> Parser Text
-> Parser (Text -> Maybe Text -> Int -> Text -> PGConnectionParams)
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
.: Key
"host"
      Parser (Text -> Maybe Text -> Int -> Text -> PGConnectionParams)
-> Parser Text
-> Parser (Maybe Text -> Int -> Text -> PGConnectionParams)
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"username"
      Parser (Maybe Text -> Int -> Text -> PGConnectionParams)
-> Parser (Maybe Text)
-> Parser (Int -> Text -> PGConnectionParams)
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 (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"password"
      Parser (Int -> Text -> PGConnectionParams)
-> Parser Int -> Parser (Text -> PGConnectionParams)
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 Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"port"
      Parser (Text -> PGConnectionParams)
-> Parser Text -> Parser PGConnectionParams
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"database"

data UrlConf
  = -- | the database connection string
    UrlValue InputWebhook
  | -- | the name of environment variable containing the connection string
    UrlFromEnv T.Text
  | -- | the minimum required `connection parameters` to construct a valid connection string
    UrlFromParams PGConnectionParams
  deriving (Int -> UrlConf -> ShowS
[UrlConf] -> ShowS
UrlConf -> String
(Int -> UrlConf -> ShowS)
-> (UrlConf -> String) -> ([UrlConf] -> ShowS) -> Show UrlConf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UrlConf -> ShowS
showsPrec :: Int -> UrlConf -> ShowS
$cshow :: UrlConf -> String
show :: UrlConf -> String
$cshowList :: [UrlConf] -> ShowS
showList :: [UrlConf] -> ShowS
Show, UrlConf -> UrlConf -> Bool
(UrlConf -> UrlConf -> Bool)
-> (UrlConf -> UrlConf -> Bool) -> Eq UrlConf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UrlConf -> UrlConf -> Bool
== :: UrlConf -> UrlConf -> Bool
$c/= :: UrlConf -> UrlConf -> Bool
/= :: UrlConf -> UrlConf -> Bool
Eq, (forall x. UrlConf -> Rep UrlConf x)
-> (forall x. Rep UrlConf x -> UrlConf) -> Generic UrlConf
forall x. Rep UrlConf x -> UrlConf
forall x. UrlConf -> Rep UrlConf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UrlConf -> Rep UrlConf x
from :: forall x. UrlConf -> Rep UrlConf x
$cto :: forall x. Rep UrlConf x -> UrlConf
to :: forall x. Rep UrlConf x -> UrlConf
Generic)

instance NFData UrlConf

instance Hashable UrlConf

instance HasCodec UrlConf where
  codec :: JSONCodec UrlConf
codec =
    (Either InputWebhook (Either Text PGConnectionParams) -> UrlConf)
-> (UrlConf
    -> Either InputWebhook (Either Text PGConnectionParams))
-> Codec
     Value
     (Either InputWebhook (Either Text PGConnectionParams))
     (Either InputWebhook (Either Text PGConnectionParams))
-> JSONCodec UrlConf
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either InputWebhook (Either Text PGConnectionParams) -> UrlConf
dec UrlConf -> Either InputWebhook (Either Text PGConnectionParams)
enc
      (Codec
   Value
   (Either InputWebhook (Either Text PGConnectionParams))
   (Either InputWebhook (Either Text PGConnectionParams))
 -> JSONCodec UrlConf)
-> Codec
     Value
     (Either InputWebhook (Either Text PGConnectionParams))
     (Either InputWebhook (Either Text PGConnectionParams))
-> JSONCodec UrlConf
forall a b. (a -> b) -> a -> b
$ JSONCodec InputWebhook
-> Codec
     Value
     (Either Text PGConnectionParams)
     (Either Text PGConnectionParams)
-> Codec
     Value
     (Either InputWebhook (Either Text PGConnectionParams))
     (Either InputWebhook (Either Text PGConnectionParams))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec JSONCodec InputWebhook
valCodec
      (Codec
   Value
   (Either Text PGConnectionParams)
   (Either Text PGConnectionParams)
 -> Codec
      Value
      (Either InputWebhook (Either Text PGConnectionParams))
      (Either InputWebhook (Either Text PGConnectionParams)))
-> Codec
     Value
     (Either Text PGConnectionParams)
     (Either Text PGConnectionParams)
-> Codec
     Value
     (Either InputWebhook (Either Text PGConnectionParams))
     (Either InputWebhook (Either Text PGConnectionParams))
forall a b. (a -> b) -> a -> b
$ Codec Value Text Text
-> JSONCodec PGConnectionParams
-> Codec
     Value
     (Either Text PGConnectionParams)
     (Either Text PGConnectionParams)
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
fromEnvCodec JSONCodec PGConnectionParams
fromParamsCodec
    where
      valCodec :: JSONCodec InputWebhook
valCodec = JSONCodec InputWebhook
forall value. HasCodec value => JSONCodec value
codec
      fromParamsCodec :: JSONCodec PGConnectionParams
fromParamsCodec = Text
-> ObjectCodec PGConnectionParams PGConnectionParams
-> JSONCodec PGConnectionParams
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"UrlConfFromParams" (ObjectCodec PGConnectionParams PGConnectionParams
 -> JSONCodec PGConnectionParams)
-> ObjectCodec PGConnectionParams PGConnectionParams
-> JSONCodec PGConnectionParams
forall a b. (a -> b) -> a -> b
$ Text -> ObjectCodec PGConnectionParams PGConnectionParams
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"connection_parameters"

      dec :: Either InputWebhook (Either Text PGConnectionParams) -> UrlConf
dec (Left InputWebhook
w) = InputWebhook -> UrlConf
UrlValue InputWebhook
w
      dec (Right (Left Text
wEnv)) = Text -> UrlConf
UrlFromEnv Text
wEnv
      dec (Right (Right PGConnectionParams
wParams)) = PGConnectionParams -> UrlConf
UrlFromParams PGConnectionParams
wParams

      enc :: UrlConf -> Either InputWebhook (Either Text PGConnectionParams)
enc (UrlValue InputWebhook
w) = InputWebhook
-> Either InputWebhook (Either Text PGConnectionParams)
forall a b. a -> Either a b
Left InputWebhook
w
      enc (UrlFromEnv Text
wEnv) = Either Text PGConnectionParams
-> Either InputWebhook (Either Text PGConnectionParams)
forall a b. b -> Either a b
Right (Either Text PGConnectionParams
 -> Either InputWebhook (Either Text PGConnectionParams))
-> Either Text PGConnectionParams
-> Either InputWebhook (Either Text PGConnectionParams)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text PGConnectionParams
forall a b. a -> Either a b
Left Text
wEnv
      enc (UrlFromParams PGConnectionParams
wParams) = Either Text PGConnectionParams
-> Either InputWebhook (Either Text PGConnectionParams)
forall a b. b -> Either a b
Right (Either Text PGConnectionParams
 -> Either InputWebhook (Either Text PGConnectionParams))
-> Either Text PGConnectionParams
-> Either InputWebhook (Either Text PGConnectionParams)
forall a b. (a -> b) -> a -> b
$ PGConnectionParams -> Either Text PGConnectionParams
forall a b. b -> Either a b
Right PGConnectionParams
wParams

instance ToJSON UrlConf where
  toJSON :: UrlConf -> Value
toJSON (UrlValue InputWebhook
w) = InputWebhook -> Value
forall a. ToJSON a => a -> Value
toJSON InputWebhook
w
  toJSON (UrlFromEnv Text
wEnv) = [Pair] -> Value
object [Key
"from_env" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
wEnv]
  toJSON (UrlFromParams PGConnectionParams
wParams) = [Pair] -> Value
object [Key
"connection_parameters" Key -> PGConnectionParams -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= PGConnectionParams
wParams]

instance FromJSON UrlConf where
  parseJSON :: Value -> Parser UrlConf
parseJSON (Object Object
o) = do
    Maybe UrlConf
mFromEnv <- ((Maybe Text -> Maybe UrlConf)
-> Parser (Maybe Text) -> Parser (Maybe UrlConf)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe Text -> Maybe UrlConf)
 -> Parser (Maybe Text) -> Parser (Maybe UrlConf))
-> ((Text -> UrlConf) -> Maybe Text -> Maybe UrlConf)
-> (Text -> UrlConf)
-> Parser (Maybe Text)
-> Parser (Maybe UrlConf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> UrlConf) -> Maybe Text -> Maybe UrlConf
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Text -> UrlConf
UrlFromEnv (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"from_env")
    Maybe UrlConf
mFromParams <- ((Maybe PGConnectionParams -> Maybe UrlConf)
-> Parser (Maybe PGConnectionParams) -> Parser (Maybe UrlConf)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe PGConnectionParams -> Maybe UrlConf)
 -> Parser (Maybe PGConnectionParams) -> Parser (Maybe UrlConf))
-> ((PGConnectionParams -> UrlConf)
    -> Maybe PGConnectionParams -> Maybe UrlConf)
-> (PGConnectionParams -> UrlConf)
-> Parser (Maybe PGConnectionParams)
-> Parser (Maybe UrlConf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGConnectionParams -> UrlConf)
-> Maybe PGConnectionParams -> Maybe UrlConf
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) PGConnectionParams -> UrlConf
UrlFromParams (Object
o Object -> Key -> Parser (Maybe PGConnectionParams)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"connection_parameters")
    case (Maybe UrlConf
mFromEnv, Maybe UrlConf
mFromParams) of
      (Just UrlConf
fromEnv, Maybe UrlConf
Nothing) -> UrlConf -> Parser UrlConf
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UrlConf
fromEnv
      (Maybe UrlConf
Nothing, Just UrlConf
fromParams) -> UrlConf -> Parser UrlConf
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UrlConf
fromParams
      (Just UrlConf
_, Just UrlConf
_) -> String -> Parser UrlConf
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser UrlConf) -> String -> Parser UrlConf
forall a b. (a -> b) -> a -> b
$ ShowS
commonJSONParseErrorMessage String
"Only one of "
      (Maybe UrlConf
Nothing, Maybe UrlConf
Nothing) -> String -> Parser UrlConf
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser UrlConf) -> String -> Parser UrlConf
forall a b. (a -> b) -> a -> b
$ ShowS
commonJSONParseErrorMessage String
"Either "
    where
      -- NOTE(Sam): Maybe this could be put with other string manipulation utils
      -- helper to apply `dquote` for values of type `String`
      dquoteStr :: String -> String
      dquoteStr :: ShowS
dquoteStr = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall t. ToTxt t => t -> Text
dquote (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

      -- helper for formatting error messages within this instance
      commonJSONParseErrorMessage :: String -> String
      commonJSONParseErrorMessage :: ShowS
commonJSONParseErrorMessage String
strToBePrepended =
        String
strToBePrepended
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
dquoteStr String
"from_env"
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" or "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
dquoteStr String
"connection_parameters"
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" should be provided"
  parseJSON t :: Value
t@(String Text
_) =
    case (Value -> Result InputWebhook
forall a. FromJSON a => Value -> Result a
fromJSON Value
t) of
      Error String
s -> String -> Parser UrlConf
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s
      Success InputWebhook
a -> UrlConf -> Parser UrlConf
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UrlConf -> Parser UrlConf) -> UrlConf -> Parser UrlConf
forall a b. (a -> b) -> a -> b
$ InputWebhook -> UrlConf
UrlValue InputWebhook
a
  parseJSON Value
_ = String -> Parser UrlConf
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"one of string or object must be provided for url/webhook"

getConnOptionsFromConnParams :: PGConnectionParams -> PG.ConnOptions
getConnOptionsFromConnParams :: PGConnectionParams -> ConnOptions
getConnOptionsFromConnParams PGConnectionParams {Int
Maybe Text
Text
_pgcpHost :: PGConnectionParams -> Text
_pgcpUsername :: PGConnectionParams -> Text
_pgcpPassword :: PGConnectionParams -> Maybe Text
_pgcpPort :: PGConnectionParams -> Int
_pgcpDatabase :: PGConnectionParams -> Text
_pgcpHost :: Text
_pgcpUsername :: Text
_pgcpPassword :: Maybe Text
_pgcpPort :: Int
_pgcpDatabase :: Text
..} =
  PG.ConnOptions
    { connHost :: String
connHost = Text -> String
T.unpack Text
_pgcpHost,
      connUser :: String
connUser = Text -> String
T.unpack Text
_pgcpUsername,
      connPort :: Int
connPort = Int
_pgcpPort,
      connDatabase :: String
connDatabase = Text -> String
T.unpack Text
_pgcpDatabase,
      connPassword :: String
connPassword = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
_pgcpPassword,
      connOptions :: Maybe String
connOptions = Maybe String
forall a. Maybe a
Nothing
    }

-- | Construct a Postgres connection URI as a String from 'PGConnectionParams'.
--
-- NOTE: This function takes care to properly escape all URI components, as
-- Postgres requires that a connection URI is percent-encoded if it includes
-- symbols with "special meaning".
--
-- See the @libpq@ documentation for details: https://www.postgresql.org/docs/13/libpq-connect.html#id-1.7.3.8.3.6
getPGConnectionStringFromParams :: PGConnectionParams -> String
getPGConnectionStringFromParams :: PGConnectionParams -> String
getPGConnectionStringFromParams PGConnectionParams {Int
Maybe Text
Text
_pgcpHost :: PGConnectionParams -> Text
_pgcpUsername :: PGConnectionParams -> Text
_pgcpPassword :: PGConnectionParams -> Maybe Text
_pgcpPort :: PGConnectionParams -> Int
_pgcpDatabase :: PGConnectionParams -> Text
_pgcpHost :: Text
_pgcpUsername :: Text
_pgcpPassword :: Maybe Text
_pgcpPort :: Int
_pgcpDatabase :: Text
..} =
  let uriAuth :: URIAuth
uriAuth =
        URIAuth -> URIAuth
rectifyAuth
          (URIAuth -> URIAuth) -> URIAuth -> URIAuth
forall a b. (a -> b) -> a -> b
$ URIAuth
            { uriUserInfo :: String
uriUserInfo = Text -> Maybe Text -> String
getURIAuthUserInfo Text
_pgcpUsername Maybe Text
_pgcpPassword,
              uriRegName :: String
uriRegName = Text -> String
unpackEscape Text
_pgcpHost,
              uriPort :: String
uriPort = Int -> String
forall a. Show a => a -> String
show Int
_pgcpPort
            }
      pgConnectionURI :: URI
pgConnectionURI =
        URI -> URI
rectify
          (URI -> URI) -> URI -> URI
forall a b. (a -> b) -> a -> b
$ URI
            { uriScheme :: String
uriScheme = String
"postgresql",
              uriAuthority :: Maybe URIAuth
uriAuthority = URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just URIAuth
uriAuth,
              uriPath :: String
uriPath = String
"/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpackEscape Text
_pgcpDatabase,
              uriQuery :: String
uriQuery = String
"",
              uriFragment :: String
uriFragment = String
""
            }
   in ShowS -> URI -> ShowS
uriToString ShowS
forall a. a -> a
id URI
pgConnectionURI ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"" -- NOTE: this is done because uriToString returns a value of type ShowS
  where
    -- Helper to manage proper escaping in URI components.
    unpackEscape :: Text -> String
unpackEscape = (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
isUnescapedInURIComponent ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

    -- Construct the 'URIAuth' 'uriUserInfo' component string from a username
    -- and optional password provided by 'PGConnectionParams'.
    getURIAuthUserInfo :: Text -> Maybe Text -> String
    getURIAuthUserInfo :: Text -> Maybe Text -> String
getURIAuthUserInfo Text
username Maybe Text
mPassword = case Maybe Text
mPassword of
      Maybe Text
Nothing -> Text -> String
unpackEscape Text
username
      Just Text
password -> Text -> String
unpackEscape Text
username String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpackEscape Text
password

resolveUrlConf :: (MonadError QErr m) => Env.Environment -> UrlConf -> m Text
resolveUrlConf :: forall (m :: * -> *).
MonadError QErr m =>
Environment -> UrlConf -> m Text
resolveUrlConf Environment
env = \case
  UrlValue InputWebhook
v -> ResolvedWebhook -> Text
unResolvedWebhook (ResolvedWebhook -> Text) -> m ResolvedWebhook -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Environment -> InputWebhook -> m ResolvedWebhook
forall (m :: * -> *).
QErrM m =>
Environment -> InputWebhook -> m ResolvedWebhook
resolveWebhook Environment
env InputWebhook
v
  UrlFromEnv Text
envVar -> Environment -> Text -> m Text
forall (m :: * -> *). QErrM m => Environment -> Text -> m Text
getEnv Environment
env Text
envVar
  UrlFromParams PGConnectionParams
connParams ->
    Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> (String -> Text) -> String -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> m Text) -> String -> m Text
forall a b. (a -> b) -> a -> b
$ PGConnectionParams -> String
getPGConnectionStringFromParams PGConnectionParams
connParams

getEnv :: (QErrM m) => Env.Environment -> Text -> m Text
getEnv :: forall (m :: * -> *). QErrM m => Environment -> Text -> m Text
getEnv Environment
env Text
k = do
  let eitherEnv :: Either Text Text
eitherEnv = Environment -> Text -> Either Text Text
getEnvEither Environment
env Text
k
  Either Text Text -> (Text -> m Text) -> m Text
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft
    Either Text Text
eitherEnv
    (\Text
_ -> Code -> Text -> m Text
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text
"environment variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' not set")

-- This is similar to `getEnv` but it doesn't fail when the env var is invalid
getEnvEither :: Env.Environment -> Text -> Either Text Text
getEnvEither :: Environment -> Text -> Either Text Text
getEnvEither Environment
env Text
k =
  case Environment -> String -> Maybe String
Env.lookupEnv Environment
env (Text -> String
T.unpack Text
k) of
    Maybe String
Nothing -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
k
    Just String
envVal -> Text -> Either Text Text
forall a b. b -> Either a b
Right (String -> Text
T.pack String
envVal)

-- | Various user-controlled configuration for metrics used by Pro
data MetricsConfig = MetricsConfig
  { -- | should the query-variables be logged and analyzed for metrics
    MetricsConfig -> Bool
_mcAnalyzeQueryVariables :: Bool,
    -- | should the response-body be analyzed for empty and null responses
    MetricsConfig -> Bool
_mcAnalyzeResponseBody :: Bool
  }
  deriving (Int -> MetricsConfig -> ShowS
[MetricsConfig] -> ShowS
MetricsConfig -> String
(Int -> MetricsConfig -> ShowS)
-> (MetricsConfig -> String)
-> ([MetricsConfig] -> ShowS)
-> Show MetricsConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetricsConfig -> ShowS
showsPrec :: Int -> MetricsConfig -> ShowS
$cshow :: MetricsConfig -> String
show :: MetricsConfig -> String
$cshowList :: [MetricsConfig] -> ShowS
showList :: [MetricsConfig] -> ShowS
Show, MetricsConfig -> MetricsConfig -> Bool
(MetricsConfig -> MetricsConfig -> Bool)
-> (MetricsConfig -> MetricsConfig -> Bool) -> Eq MetricsConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetricsConfig -> MetricsConfig -> Bool
== :: MetricsConfig -> MetricsConfig -> Bool
$c/= :: MetricsConfig -> MetricsConfig -> Bool
/= :: MetricsConfig -> MetricsConfig -> Bool
Eq, (forall x. MetricsConfig -> Rep MetricsConfig x)
-> (forall x. Rep MetricsConfig x -> MetricsConfig)
-> Generic MetricsConfig
forall x. Rep MetricsConfig x -> MetricsConfig
forall x. MetricsConfig -> Rep MetricsConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MetricsConfig -> Rep MetricsConfig x
from :: forall x. MetricsConfig -> Rep MetricsConfig x
$cto :: forall x. Rep MetricsConfig x -> MetricsConfig
to :: forall x. Rep MetricsConfig x -> MetricsConfig
Generic)

instance HasCodec MetricsConfig where
  codec :: JSONCodec MetricsConfig
codec =
    Text
-> ObjectCodec MetricsConfig MetricsConfig
-> JSONCodec MetricsConfig
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"MetricsConfig"
      (ObjectCodec MetricsConfig MetricsConfig
 -> JSONCodec MetricsConfig)
-> ObjectCodec MetricsConfig MetricsConfig
-> JSONCodec MetricsConfig
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> MetricsConfig
MetricsConfig
      (Bool -> Bool -> MetricsConfig)
-> Codec Object MetricsConfig Bool
-> Codec Object MetricsConfig (Bool -> MetricsConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Bool Bool
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"analyze_query_variables"
      ObjectCodec Bool Bool
-> (MetricsConfig -> Bool) -> Codec Object MetricsConfig Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= MetricsConfig -> Bool
_mcAnalyzeQueryVariables
        Codec Object MetricsConfig (Bool -> MetricsConfig)
-> Codec Object MetricsConfig Bool
-> ObjectCodec MetricsConfig MetricsConfig
forall a b.
Codec Object MetricsConfig (a -> b)
-> Codec Object MetricsConfig a -> Codec Object MetricsConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec Bool Bool
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"analyze_response_body"
      ObjectCodec Bool Bool
-> (MetricsConfig -> Bool) -> Codec Object MetricsConfig Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= MetricsConfig -> Bool
_mcAnalyzeResponseBody

instance FromJSON MetricsConfig where
  parseJSON :: Value -> Parser MetricsConfig
parseJSON = String
-> (Object -> Parser MetricsConfig)
-> Value
-> Parser MetricsConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"MetricsConfig" ((Object -> Parser MetricsConfig) -> Value -> Parser MetricsConfig)
-> (Object -> Parser MetricsConfig)
-> Value
-> Parser MetricsConfig
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Bool
_mcAnalyzeQueryVariables <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"analyze_query_variables"
    Bool
_mcAnalyzeResponseBody <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"analyze_response_body"
    MetricsConfig -> Parser MetricsConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetricsConfig {Bool
_mcAnalyzeQueryVariables :: Bool
_mcAnalyzeResponseBody :: Bool
_mcAnalyzeQueryVariables :: Bool
_mcAnalyzeResponseBody :: Bool
..}

instance ToJSON MetricsConfig where
  toJSON :: MetricsConfig -> Value
toJSON MetricsConfig {Bool
_mcAnalyzeQueryVariables :: MetricsConfig -> Bool
_mcAnalyzeResponseBody :: MetricsConfig -> Bool
_mcAnalyzeQueryVariables :: Bool
_mcAnalyzeResponseBody :: Bool
..} =
    [Pair] -> Value
J.object
      [ Key
"analyze_query_variables" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_mcAnalyzeQueryVariables,
        Key
"analyze_response_body" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_mcAnalyzeResponseBody
      ]

emptyMetricsConfig :: MetricsConfig
emptyMetricsConfig :: MetricsConfig
emptyMetricsConfig = Bool -> Bool -> MetricsConfig
MetricsConfig Bool
False Bool
False

data Comment
  = -- | Automatically generate a comment (derive it from DB comments, or a sensible default describing the source of the data)
    Automatic
  | -- | The user's explicitly provided comment, or explicitly no comment (ie. leave it blank, do not autogenerate one)
    Explicit (Maybe NonEmptyText)
  deriving (Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
/= :: Comment -> Comment -> Bool
Eq, Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Comment -> ShowS
showsPrec :: Int -> Comment -> ShowS
$cshow :: Comment -> String
show :: Comment -> String
$cshowList :: [Comment] -> ShowS
showList :: [Comment] -> ShowS
Show, (forall x. Comment -> Rep Comment x)
-> (forall x. Rep Comment x -> Comment) -> Generic Comment
forall x. Rep Comment x -> Comment
forall x. Comment -> Rep Comment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Comment -> Rep Comment x
from :: forall x. Comment -> Rep Comment x
$cto :: forall x. Rep Comment x -> Comment
to :: forall x. Rep Comment x -> Comment
Generic)

instance NFData Comment

instance Hashable Comment

instance HasCodec Comment where
  codec :: JSONCodec Comment
codec = (Maybe Text -> Comment)
-> (Comment -> Maybe Text)
-> Codec Value (Maybe Text) (Maybe Text)
-> JSONCodec Comment
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Maybe Text -> Comment
dec Comment -> Maybe Text
enc (forall value. HasCodec value => JSONCodec value
codec @(Maybe Text))
    where
      dec :: Maybe Text -> Comment
dec Maybe Text
Nothing = Comment
Automatic
      dec (Just Text
text) = Maybe NonEmptyText -> Comment
Explicit (Maybe NonEmptyText -> Comment) -> Maybe NonEmptyText -> Comment
forall a b. (a -> b) -> a -> b
$ Text -> Maybe NonEmptyText
mkNonEmptyText Text
text

      enc :: Comment -> Maybe Text
enc Comment
Automatic = Maybe Text
forall a. Maybe a
Nothing
      enc (Explicit (Just NonEmptyText
text)) = Text -> Maybe Text
forall a. a -> Maybe a
Just (NonEmptyText -> Text
forall t. ToTxt t => t -> Text
toTxt NonEmptyText
text)
      enc (Explicit Maybe NonEmptyText
Nothing) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""

instance FromJSON Comment where
  parseJSON :: Value -> Parser Comment
parseJSON = \case
    Value
Null -> Comment -> Parser Comment
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
Automatic
    String Text
text -> Comment -> Parser Comment
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Comment -> Parser Comment)
-> (Maybe NonEmptyText -> Comment)
-> Maybe NonEmptyText
-> Parser Comment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe NonEmptyText -> Comment
Explicit (Maybe NonEmptyText -> Parser Comment)
-> Maybe NonEmptyText -> Parser Comment
forall a b. (a -> b) -> a -> b
$ Text -> Maybe NonEmptyText
mkNonEmptyText Text
text
    Value
val -> String -> Parser Comment -> Parser Comment
forall a. String -> Parser a -> Parser a
prependFailure String
"parsing Comment failed, " (String -> Value -> Parser Comment
forall a. String -> Value -> Parser a
typeMismatch String
"String or Null" Value
val)

instance ToJSON Comment where
  toJSON :: Comment -> Value
toJSON Comment
Automatic = Value
Null
  toJSON (Explicit (Just NonEmptyText
value)) = Text -> Value
String (NonEmptyText -> Text
forall t. ToTxt t => t -> Text
toTxt NonEmptyText
value)
  toJSON (Explicit Maybe NonEmptyText
Nothing) = Text -> Value
String Text
""

commentToMaybeText :: Comment -> Maybe Text
commentToMaybeText :: Comment -> Maybe Text
commentToMaybeText Comment
Automatic = Maybe Text
forall a. Maybe a
Nothing
commentToMaybeText (Explicit Maybe NonEmptyText
Nothing) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
commentToMaybeText (Explicit (Just NonEmptyText
val)) = Text -> Maybe Text
forall a. a -> Maybe a
Just (NonEmptyText -> Text
forall t. ToTxt t => t -> Text
toTxt NonEmptyText
val)

commentFromMaybeText :: Maybe Text -> Comment
commentFromMaybeText :: Maybe Text -> Comment
commentFromMaybeText Maybe Text
Nothing = Comment
Automatic
commentFromMaybeText (Just Text
val) = Maybe NonEmptyText -> Comment
Explicit (Maybe NonEmptyText -> Comment) -> Maybe NonEmptyText -> Comment
forall a b. (a -> b) -> a -> b
$ Text -> Maybe NonEmptyText
mkNonEmptyText Text
val

-- | We use the following type, after we resolve the env var.
-- | This will store both the env var name and the resolved value.
data EnvRecord a = EnvRecord
  { forall a. EnvRecord a -> Text
_envVarName :: Text,
    forall a. EnvRecord a -> a
_envVarValue :: a
  }
  deriving (Int -> EnvRecord a -> ShowS
[EnvRecord a] -> ShowS
EnvRecord a -> String
(Int -> EnvRecord a -> ShowS)
-> (EnvRecord a -> String)
-> ([EnvRecord a] -> ShowS)
-> Show (EnvRecord a)
forall a. Show a => Int -> EnvRecord a -> ShowS
forall a. Show a => [EnvRecord a] -> ShowS
forall a. Show a => EnvRecord a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> EnvRecord a -> ShowS
showsPrec :: Int -> EnvRecord a -> ShowS
$cshow :: forall a. Show a => EnvRecord a -> String
show :: EnvRecord a -> String
$cshowList :: forall a. Show a => [EnvRecord a] -> ShowS
showList :: [EnvRecord a] -> ShowS
Show, EnvRecord a -> EnvRecord a -> Bool
(EnvRecord a -> EnvRecord a -> Bool)
-> (EnvRecord a -> EnvRecord a -> Bool) -> Eq (EnvRecord a)
forall a. Eq a => EnvRecord a -> EnvRecord a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => EnvRecord a -> EnvRecord a -> Bool
== :: EnvRecord a -> EnvRecord a -> Bool
$c/= :: forall a. Eq a => EnvRecord a -> EnvRecord a -> Bool
/= :: EnvRecord a -> EnvRecord a -> Bool
Eq, (forall x. EnvRecord a -> Rep (EnvRecord a) x)
-> (forall x. Rep (EnvRecord a) x -> EnvRecord a)
-> Generic (EnvRecord a)
forall x. Rep (EnvRecord a) x -> EnvRecord a
forall x. EnvRecord a -> Rep (EnvRecord a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (EnvRecord a) x -> EnvRecord a
forall a x. EnvRecord a -> Rep (EnvRecord a) x
$cfrom :: forall a x. EnvRecord a -> Rep (EnvRecord a) x
from :: forall x. EnvRecord a -> Rep (EnvRecord a) x
$cto :: forall a x. Rep (EnvRecord a) x -> EnvRecord a
to :: forall x. Rep (EnvRecord a) x -> EnvRecord a
Generic)

instance (NFData a) => NFData (EnvRecord a)

instance (Hashable a) => Hashable (EnvRecord a)

instance (ToJSON a) => ToJSON (EnvRecord a) where
  toJSON :: EnvRecord a -> Value
toJSON (EnvRecord Text
envVar a
_envValue) = [Pair] -> Value
object [Key
"env_var" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
envVar]

instance (FromJSON a) => FromJSON (EnvRecord a)

data ApolloFederationVersion = V1 deriving (Int -> ApolloFederationVersion -> ShowS
[ApolloFederationVersion] -> ShowS
ApolloFederationVersion -> String
(Int -> ApolloFederationVersion -> ShowS)
-> (ApolloFederationVersion -> String)
-> ([ApolloFederationVersion] -> ShowS)
-> Show ApolloFederationVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApolloFederationVersion -> ShowS
showsPrec :: Int -> ApolloFederationVersion -> ShowS
$cshow :: ApolloFederationVersion -> String
show :: ApolloFederationVersion -> String
$cshowList :: [ApolloFederationVersion] -> ShowS
showList :: [ApolloFederationVersion] -> ShowS
Show, ApolloFederationVersion -> ApolloFederationVersion -> Bool
(ApolloFederationVersion -> ApolloFederationVersion -> Bool)
-> (ApolloFederationVersion -> ApolloFederationVersion -> Bool)
-> Eq ApolloFederationVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApolloFederationVersion -> ApolloFederationVersion -> Bool
== :: ApolloFederationVersion -> ApolloFederationVersion -> Bool
$c/= :: ApolloFederationVersion -> ApolloFederationVersion -> Bool
/= :: ApolloFederationVersion -> ApolloFederationVersion -> Bool
Eq, (forall x.
 ApolloFederationVersion -> Rep ApolloFederationVersion x)
-> (forall x.
    Rep ApolloFederationVersion x -> ApolloFederationVersion)
-> Generic ApolloFederationVersion
forall x. Rep ApolloFederationVersion x -> ApolloFederationVersion
forall x. ApolloFederationVersion -> Rep ApolloFederationVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ApolloFederationVersion -> Rep ApolloFederationVersion x
from :: forall x. ApolloFederationVersion -> Rep ApolloFederationVersion x
$cto :: forall x. Rep ApolloFederationVersion x -> ApolloFederationVersion
to :: forall x. Rep ApolloFederationVersion x -> ApolloFederationVersion
Generic)

instance HasCodec ApolloFederationVersion where
  codec :: JSONCodec ApolloFederationVersion
codec = NonEmpty (ApolloFederationVersion, Text)
-> JSONCodec ApolloFederationVersion
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec [(ApolloFederationVersion
V1, Text
"v1")]

instance ToJSON ApolloFederationVersion where
  toJSON :: ApolloFederationVersion -> Value
toJSON ApolloFederationVersion
V1 = Text -> Value
J.String Text
"v1"

instance FromJSON ApolloFederationVersion where
  parseJSON :: Value -> Parser ApolloFederationVersion
parseJSON = String
-> (Text -> Parser ApolloFederationVersion)
-> Value
-> Parser ApolloFederationVersion
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ApolloFederationVersion"
    ((Text -> Parser ApolloFederationVersion)
 -> Value -> Parser ApolloFederationVersion)
-> (Text -> Parser ApolloFederationVersion)
-> Value
-> Parser ApolloFederationVersion
forall a b. (a -> b) -> a -> b
$ \case
      Text
"v1" -> ApolloFederationVersion -> Parser ApolloFederationVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApolloFederationVersion
V1
      Text
_ -> String -> Parser ApolloFederationVersion
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"enable takes the version of apollo federation. Supported value is v1 only."

instance NFData ApolloFederationVersion

data ApolloFederationConfig = ApolloFederationConfig
  { ApolloFederationConfig -> ApolloFederationVersion
enable :: ApolloFederationVersion
  }
  deriving (Int -> ApolloFederationConfig -> ShowS
[ApolloFederationConfig] -> ShowS
ApolloFederationConfig -> String
(Int -> ApolloFederationConfig -> ShowS)
-> (ApolloFederationConfig -> String)
-> ([ApolloFederationConfig] -> ShowS)
-> Show ApolloFederationConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApolloFederationConfig -> ShowS
showsPrec :: Int -> ApolloFederationConfig -> ShowS
$cshow :: ApolloFederationConfig -> String
show :: ApolloFederationConfig -> String
$cshowList :: [ApolloFederationConfig] -> ShowS
showList :: [ApolloFederationConfig] -> ShowS
Show, ApolloFederationConfig -> ApolloFederationConfig -> Bool
(ApolloFederationConfig -> ApolloFederationConfig -> Bool)
-> (ApolloFederationConfig -> ApolloFederationConfig -> Bool)
-> Eq ApolloFederationConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApolloFederationConfig -> ApolloFederationConfig -> Bool
== :: ApolloFederationConfig -> ApolloFederationConfig -> Bool
$c/= :: ApolloFederationConfig -> ApolloFederationConfig -> Bool
/= :: ApolloFederationConfig -> ApolloFederationConfig -> Bool
Eq, (forall x. ApolloFederationConfig -> Rep ApolloFederationConfig x)
-> (forall x.
    Rep ApolloFederationConfig x -> ApolloFederationConfig)
-> Generic ApolloFederationConfig
forall x. Rep ApolloFederationConfig x -> ApolloFederationConfig
forall x. ApolloFederationConfig -> Rep ApolloFederationConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ApolloFederationConfig -> Rep ApolloFederationConfig x
from :: forall x. ApolloFederationConfig -> Rep ApolloFederationConfig x
$cto :: forall x. Rep ApolloFederationConfig x -> ApolloFederationConfig
to :: forall x. Rep ApolloFederationConfig x -> ApolloFederationConfig
Generic)

instance HasCodec ApolloFederationConfig where
  codec :: JSONCodec ApolloFederationConfig
codec =
    Text
-> ObjectCodec ApolloFederationConfig ApolloFederationConfig
-> JSONCodec ApolloFederationConfig
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"ApolloFederationConfig"
      (ObjectCodec ApolloFederationConfig ApolloFederationConfig
 -> JSONCodec ApolloFederationConfig)
-> ObjectCodec ApolloFederationConfig ApolloFederationConfig
-> JSONCodec ApolloFederationConfig
forall a b. (a -> b) -> a -> b
$ ApolloFederationVersion -> ApolloFederationConfig
ApolloFederationConfig
      (ApolloFederationVersion -> ApolloFederationConfig)
-> Codec Object ApolloFederationConfig ApolloFederationVersion
-> ObjectCodec ApolloFederationConfig ApolloFederationConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Text
-> ObjectCodec ApolloFederationVersion ApolloFederationVersion
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"enable" Text
enableDoc
      ObjectCodec ApolloFederationVersion ApolloFederationVersion
-> (ApolloFederationConfig -> ApolloFederationVersion)
-> Codec Object ApolloFederationConfig ApolloFederationVersion
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ApolloFederationConfig -> ApolloFederationVersion
enable
    where
      enableDoc :: Text
enableDoc = Text
"enable takes the version of apollo federation. Supported value is v1 only."

instance ToJSON ApolloFederationConfig

instance FromJSON ApolloFederationConfig

instance NFData ApolloFederationConfig

isApolloFedV1enabled :: Maybe ApolloFederationConfig -> Bool
isApolloFedV1enabled :: Maybe ApolloFederationConfig -> Bool
isApolloFedV1enabled = Maybe ApolloFederationConfig -> Bool
forall a. Maybe a -> Bool
isJust

-- | Type to indicate if the SQL trigger should be enabled
--   when data is inserted into a table through replication.
data TriggerOnReplication
  = TOREnableTrigger
  | TORDisableTrigger
  deriving (Int -> TriggerOnReplication -> ShowS
[TriggerOnReplication] -> ShowS
TriggerOnReplication -> String
(Int -> TriggerOnReplication -> ShowS)
-> (TriggerOnReplication -> String)
-> ([TriggerOnReplication] -> ShowS)
-> Show TriggerOnReplication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TriggerOnReplication -> ShowS
showsPrec :: Int -> TriggerOnReplication -> ShowS
$cshow :: TriggerOnReplication -> String
show :: TriggerOnReplication -> String
$cshowList :: [TriggerOnReplication] -> ShowS
showList :: [TriggerOnReplication] -> ShowS
Show, TriggerOnReplication -> TriggerOnReplication -> Bool
(TriggerOnReplication -> TriggerOnReplication -> Bool)
-> (TriggerOnReplication -> TriggerOnReplication -> Bool)
-> Eq TriggerOnReplication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TriggerOnReplication -> TriggerOnReplication -> Bool
== :: TriggerOnReplication -> TriggerOnReplication -> Bool
$c/= :: TriggerOnReplication -> TriggerOnReplication -> Bool
/= :: TriggerOnReplication -> TriggerOnReplication -> Bool
Eq, (forall x. TriggerOnReplication -> Rep TriggerOnReplication x)
-> (forall x. Rep TriggerOnReplication x -> TriggerOnReplication)
-> Generic TriggerOnReplication
forall x. Rep TriggerOnReplication x -> TriggerOnReplication
forall x. TriggerOnReplication -> Rep TriggerOnReplication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TriggerOnReplication -> Rep TriggerOnReplication x
from :: forall x. TriggerOnReplication -> Rep TriggerOnReplication x
$cto :: forall x. Rep TriggerOnReplication x -> TriggerOnReplication
to :: forall x. Rep TriggerOnReplication x -> TriggerOnReplication
Generic)

instance NFData TriggerOnReplication

instance HasCodec TriggerOnReplication where
  codec :: JSONCodec TriggerOnReplication
codec = TriggerOnReplication
-> TriggerOnReplication -> JSONCodec TriggerOnReplication
forall a. Eq a => a -> a -> JSONCodec a
boolConstCodec TriggerOnReplication
TOREnableTrigger TriggerOnReplication
TORDisableTrigger

instance FromJSON TriggerOnReplication where
  parseJSON :: Value -> Parser TriggerOnReplication
parseJSON = String
-> (Bool -> Parser TriggerOnReplication)
-> Value
-> Parser TriggerOnReplication
forall a. String -> (Bool -> Parser a) -> Value -> Parser a
withBool String
"TriggerOnReplication" ((Bool -> Parser TriggerOnReplication)
 -> Value -> Parser TriggerOnReplication)
-> (Bool -> Parser TriggerOnReplication)
-> Value
-> Parser TriggerOnReplication
forall a b. (a -> b) -> a -> b
$ \case
    Bool
True -> TriggerOnReplication -> Parser TriggerOnReplication
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TriggerOnReplication
TOREnableTrigger
    Bool
False -> TriggerOnReplication -> Parser TriggerOnReplication
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TriggerOnReplication
TORDisableTrigger

instance ToJSON TriggerOnReplication where
  toJSON :: TriggerOnReplication -> Value
toJSON = \case
    TriggerOnReplication
TOREnableTrigger -> Bool -> Value
Bool Bool
True
    TriggerOnReplication
TORDisableTrigger -> Bool -> Value
Bool Bool
False

--------------------------------------------------------------------------------
-- metadata

-- | Metadata representation of a generic remote relationship, regardless of the
-- source: all sources use this same agnostic definition. The internal
-- definition field is where we differentiate between different targets.
--
-- TODO: This needs to be moved to an appropriate module, maybe something
-- like Hasura.RemoteRelationships.Metadata.
data RemoteRelationshipG definition = RemoteRelationship
  { forall definition. RemoteRelationshipG definition -> RelName
_rrName :: RelName,
    forall definition. RemoteRelationshipG definition -> definition
_rrDefinition :: definition
  }
  deriving (Int -> RemoteRelationshipG definition -> ShowS
[RemoteRelationshipG definition] -> ShowS
RemoteRelationshipG definition -> String
(Int -> RemoteRelationshipG definition -> ShowS)
-> (RemoteRelationshipG definition -> String)
-> ([RemoteRelationshipG definition] -> ShowS)
-> Show (RemoteRelationshipG definition)
forall definition.
Show definition =>
Int -> RemoteRelationshipG definition -> ShowS
forall definition.
Show definition =>
[RemoteRelationshipG definition] -> ShowS
forall definition.
Show definition =>
RemoteRelationshipG definition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall definition.
Show definition =>
Int -> RemoteRelationshipG definition -> ShowS
showsPrec :: Int -> RemoteRelationshipG definition -> ShowS
$cshow :: forall definition.
Show definition =>
RemoteRelationshipG definition -> String
show :: RemoteRelationshipG definition -> String
$cshowList :: forall definition.
Show definition =>
[RemoteRelationshipG definition] -> ShowS
showList :: [RemoteRelationshipG definition] -> ShowS
Show, RemoteRelationshipG definition
-> RemoteRelationshipG definition -> Bool
(RemoteRelationshipG definition
 -> RemoteRelationshipG definition -> Bool)
-> (RemoteRelationshipG definition
    -> RemoteRelationshipG definition -> Bool)
-> Eq (RemoteRelationshipG definition)
forall definition.
Eq definition =>
RemoteRelationshipG definition
-> RemoteRelationshipG definition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall definition.
Eq definition =>
RemoteRelationshipG definition
-> RemoteRelationshipG definition -> Bool
== :: RemoteRelationshipG definition
-> RemoteRelationshipG definition -> Bool
$c/= :: forall definition.
Eq definition =>
RemoteRelationshipG definition
-> RemoteRelationshipG definition -> Bool
/= :: RemoteRelationshipG definition
-> RemoteRelationshipG definition -> Bool
Eq, (forall x.
 RemoteRelationshipG definition
 -> Rep (RemoteRelationshipG definition) x)
-> (forall x.
    Rep (RemoteRelationshipG definition) x
    -> RemoteRelationshipG definition)
-> Generic (RemoteRelationshipG definition)
forall x.
Rep (RemoteRelationshipG definition) x
-> RemoteRelationshipG definition
forall x.
RemoteRelationshipG definition
-> Rep (RemoteRelationshipG definition) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall definition x.
Rep (RemoteRelationshipG definition) x
-> RemoteRelationshipG definition
forall definition x.
RemoteRelationshipG definition
-> Rep (RemoteRelationshipG definition) x
$cfrom :: forall definition x.
RemoteRelationshipG definition
-> Rep (RemoteRelationshipG definition) x
from :: forall x.
RemoteRelationshipG definition
-> Rep (RemoteRelationshipG definition) x
$cto :: forall definition x.
Rep (RemoteRelationshipG definition) x
-> RemoteRelationshipG definition
to :: forall x.
Rep (RemoteRelationshipG definition) x
-> RemoteRelationshipG definition
Generic)

instance (ToJSON definition) => ToJSON (RemoteRelationshipG definition) where
  toJSON :: RemoteRelationshipG definition -> Value
toJSON RemoteRelationship {definition
RelName
_rrName :: forall definition. RemoteRelationshipG definition -> RelName
_rrDefinition :: forall definition. RemoteRelationshipG definition -> definition
_rrName :: RelName
_rrDefinition :: definition
..} =
    [Pair] -> Value
J.object
      [ Key
"name" Key -> RelName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= RelName
_rrName,
        Key
"definition" Key -> definition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= definition
_rrDefinition
      ]

rrName :: Lens (RemoteRelationshipG def) (RemoteRelationshipG def) RelName RelName
rrName :: forall def (f :: * -> *).
Functor f =>
(RelName -> f RelName)
-> RemoteRelationshipG def -> f (RemoteRelationshipG def)
rrName = (RemoteRelationshipG def -> RelName)
-> (RemoteRelationshipG def -> RelName -> RemoteRelationshipG def)
-> Lens
     (RemoteRelationshipG def) (RemoteRelationshipG def) RelName RelName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens RemoteRelationshipG def -> RelName
forall definition. RemoteRelationshipG definition -> RelName
_rrName (\RemoteRelationshipG def
rrg RelName
a -> RemoteRelationshipG def
rrg {_rrName :: RelName
_rrName = RelName
a})

rrDefinition :: Lens (RemoteRelationshipG def) (RemoteRelationshipG def') def def'
rrDefinition :: forall def def' (f :: * -> *).
Functor f =>
(def -> f def')
-> RemoteRelationshipG def -> f (RemoteRelationshipG def')
rrDefinition = (RemoteRelationshipG def -> def)
-> (RemoteRelationshipG def -> def' -> RemoteRelationshipG def')
-> Lens
     (RemoteRelationshipG def) (RemoteRelationshipG def') def def'
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens RemoteRelationshipG def -> def
forall definition. RemoteRelationshipG definition -> definition
_rrDefinition (\RemoteRelationshipG def
rrg def'
a -> RemoteRelationshipG def
rrg {_rrDefinition :: def'
_rrDefinition = def'
a})

remoteRelationshipCodec ::
  forall definition.
  (Typeable definition) =>
  JSONCodec definition ->
  JSONCodec (RemoteRelationshipG definition)
remoteRelationshipCodec :: forall definition.
Typeable definition =>
JSONCodec definition -> JSONCodec (RemoteRelationshipG definition)
remoteRelationshipCodec JSONCodec definition
definitionCodec =
  Text
-> ObjectCodec
     (RemoteRelationshipG definition) (RemoteRelationshipG definition)
-> ValueCodec
     (RemoteRelationshipG definition) (RemoteRelationshipG definition)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
"RemoteRelationship_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @definition)
    (ObjectCodec
   (RemoteRelationshipG definition) (RemoteRelationshipG definition)
 -> ValueCodec
      (RemoteRelationshipG definition) (RemoteRelationshipG definition))
-> ObjectCodec
     (RemoteRelationshipG definition) (RemoteRelationshipG definition)
-> ValueCodec
     (RemoteRelationshipG definition) (RemoteRelationshipG definition)
forall a b. (a -> b) -> a -> b
$ RelName -> definition -> RemoteRelationshipG definition
forall definition.
RelName -> definition -> RemoteRelationshipG definition
RemoteRelationship
    (RelName -> definition -> RemoteRelationshipG definition)
-> Codec Object (RemoteRelationshipG definition) RelName
-> Codec
     Object
     (RemoteRelationshipG definition)
     (definition -> RemoteRelationshipG definition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec RelName RelName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
    ObjectCodec RelName RelName
-> (RemoteRelationshipG definition -> RelName)
-> Codec Object (RemoteRelationshipG definition) RelName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RemoteRelationshipG definition -> RelName
forall definition. RemoteRelationshipG definition -> RelName
_rrName
      Codec
  Object
  (RemoteRelationshipG definition)
  (definition -> RemoteRelationshipG definition)
-> Codec Object (RemoteRelationshipG definition) definition
-> ObjectCodec
     (RemoteRelationshipG definition) (RemoteRelationshipG definition)
forall a b.
Codec Object (RemoteRelationshipG definition) (a -> b)
-> Codec Object (RemoteRelationshipG definition) a
-> Codec Object (RemoteRelationshipG definition) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> JSONCodec definition -> ObjectCodec definition definition
forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
"definition" JSONCodec definition
definitionCodec
    ObjectCodec definition definition
-> (RemoteRelationshipG definition -> definition)
-> Codec Object (RemoteRelationshipG definition) definition
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= RemoteRelationshipG definition -> definition
forall definition. RemoteRelationshipG definition -> definition
_rrDefinition