{-# LANGUAGE TemplateHaskell #-}

-- | This module contains types which are common to event triggers and scheduled triggers.
module Hasura.RQL.Types.Eventing
  ( ClientError (..),
    EventId (..),
    Invocation (..),
    InvocationVersion,
    PGTextArray (..),
    Response (..),
    TriggerTypes (..),
    WebhookRequest (..),
    WebhookResponse (..),
    OpVar (..),
    invocationVersionET,
    invocationVersionST,
  )
where

import Data.Aeson
import Data.Aeson.TH
import Data.SerializableBlob qualified as SB
import Data.Text.Extended
import Database.PG.Query qualified as Q
import Database.PG.Query.PTI qualified as PTI
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Hasura.RQL.DDL.Headers
import PostgreSQL.Binary.Encoding qualified as PE

newtype EventId = EventId {EventId -> Text
unEventId :: Text}
  deriving (Int -> EventId -> ShowS
[EventId] -> ShowS
EventId -> String
(Int -> EventId -> ShowS)
-> (EventId -> String) -> ([EventId] -> ShowS) -> Show EventId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventId] -> ShowS
$cshowList :: [EventId] -> ShowS
show :: EventId -> String
$cshow :: EventId -> String
showsPrec :: Int -> EventId -> ShowS
$cshowsPrec :: Int -> EventId -> ShowS
Show, EventId -> EventId -> Bool
(EventId -> EventId -> Bool)
-> (EventId -> EventId -> Bool) -> Eq EventId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventId -> EventId -> Bool
$c/= :: EventId -> EventId -> Bool
== :: EventId -> EventId -> Bool
$c== :: EventId -> EventId -> Bool
Eq, Eq EventId
Eq EventId
-> (EventId -> EventId -> Ordering)
-> (EventId -> EventId -> Bool)
-> (EventId -> EventId -> Bool)
-> (EventId -> EventId -> Bool)
-> (EventId -> EventId -> Bool)
-> (EventId -> EventId -> EventId)
-> (EventId -> EventId -> EventId)
-> Ord EventId
EventId -> EventId -> Bool
EventId -> EventId -> Ordering
EventId -> EventId -> EventId
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
min :: EventId -> EventId -> EventId
$cmin :: EventId -> EventId -> EventId
max :: EventId -> EventId -> EventId
$cmax :: EventId -> EventId -> EventId
>= :: EventId -> EventId -> Bool
$c>= :: EventId -> EventId -> Bool
> :: EventId -> EventId -> Bool
$c> :: EventId -> EventId -> Bool
<= :: EventId -> EventId -> Bool
$c<= :: EventId -> EventId -> Bool
< :: EventId -> EventId -> Bool
$c< :: EventId -> EventId -> Bool
compare :: EventId -> EventId -> Ordering
$ccompare :: EventId -> EventId -> Ordering
$cp1Ord :: Eq EventId
Ord, Int -> EventId -> Int
EventId -> Int
(Int -> EventId -> Int) -> (EventId -> Int) -> Hashable EventId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: EventId -> Int
$chash :: EventId -> Int
hashWithSalt :: Int -> EventId -> Int
$chashWithSalt :: Int -> EventId -> Int
Hashable, EventId -> Text
(EventId -> Text) -> ToTxt EventId
forall a. (a -> Text) -> ToTxt a
toTxt :: EventId -> Text
$ctoTxt :: EventId -> Text
ToTxt, Value -> Parser [EventId]
Value -> Parser EventId
(Value -> Parser EventId)
-> (Value -> Parser [EventId]) -> FromJSON EventId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EventId]
$cparseJSONList :: Value -> Parser [EventId]
parseJSON :: Value -> Parser EventId
$cparseJSON :: Value -> Parser EventId
FromJSON, [EventId] -> Value
[EventId] -> Encoding
EventId -> Value
EventId -> Encoding
(EventId -> Value)
-> (EventId -> Encoding)
-> ([EventId] -> Value)
-> ([EventId] -> Encoding)
-> ToJSON EventId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EventId] -> Encoding
$ctoEncodingList :: [EventId] -> Encoding
toJSONList :: [EventId] -> Value
$ctoJSONList :: [EventId] -> Value
toEncoding :: EventId -> Encoding
$ctoEncoding :: EventId -> Encoding
toJSON :: EventId -> Value
$ctoJSON :: EventId -> Value
ToJSON, ToJSONKeyFunction [EventId]
ToJSONKeyFunction EventId
ToJSONKeyFunction EventId
-> ToJSONKeyFunction [EventId] -> ToJSONKey EventId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [EventId]
$ctoJSONKeyList :: ToJSONKeyFunction [EventId]
toJSONKey :: ToJSONKeyFunction EventId
$ctoJSONKey :: ToJSONKeyFunction EventId
ToJSONKey, Maybe ByteString -> Either Text EventId
(Maybe ByteString -> Either Text EventId) -> FromCol EventId
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
fromCol :: Maybe ByteString -> Either Text EventId
$cfromCol :: Maybe ByteString -> Either Text EventId
Q.FromCol, EventId -> PrepArg
(EventId -> PrepArg) -> ToPrepArg EventId
forall a. (a -> PrepArg) -> ToPrepArg a
toPrepVal :: EventId -> PrepArg
$ctoPrepVal :: EventId -> PrepArg
Q.ToPrepArg, (forall x. EventId -> Rep EventId x)
-> (forall x. Rep EventId x -> EventId) -> Generic EventId
forall x. Rep EventId x -> EventId
forall x. EventId -> Rep EventId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventId x -> EventId
$cfrom :: forall x. EventId -> Rep EventId x
Generic, EventId -> ()
(EventId -> ()) -> NFData EventId
forall a. (a -> ()) -> NFData a
rnf :: EventId -> ()
$crnf :: EventId -> ()
NFData, Eq EventId
Eq EventId
-> (Accesses -> EventId -> EventId -> Bool) -> Cacheable EventId
Accesses -> EventId -> EventId -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> EventId -> EventId -> Bool
$cunchanged :: Accesses -> EventId -> EventId -> Bool
$cp1Cacheable :: Eq EventId
Cacheable)

-- | There are two types of events: EventType (for event triggers) and ScheduledType (for scheduled triggers)
data TriggerTypes = EventType | ScheduledType

data WebhookRequest = WebhookRequest
  { WebhookRequest -> Value
_rqPayload :: Value,
    WebhookRequest -> [HeaderConf]
_rqHeaders :: [HeaderConf],
    WebhookRequest -> Text
_rqVersion :: Text
  }

$(deriveToJSON hasuraJSON {omitNothingFields = True} ''WebhookRequest)

data WebhookResponse = WebhookResponse
  { WebhookResponse -> SerializableBlob
_wrsBody :: SB.SerializableBlob,
    WebhookResponse -> [HeaderConf]
_wrsHeaders :: [HeaderConf],
    WebhookResponse -> Int
_wrsStatus :: Int
  }

$(deriveToJSON hasuraJSON {omitNothingFields = True} ''WebhookResponse)

newtype ClientError = ClientError {ClientError -> SerializableBlob
_ceMessage :: SB.SerializableBlob}

$(deriveToJSON hasuraJSON {omitNothingFields = True} ''ClientError)

data Response (a :: TriggerTypes)
  = ResponseHTTP WebhookResponse
  | ResponseError ClientError

type InvocationVersion = Text

invocationVersionET :: InvocationVersion
invocationVersionET :: Text
invocationVersionET = Text
"2"

invocationVersionST :: InvocationVersion
invocationVersionST :: Text
invocationVersionST = Text
"1"

instance ToJSON (Response 'EventType) where
  toJSON :: Response 'EventType -> Value
toJSON (ResponseHTTP WebhookResponse
resp) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"webhook_response",
        Key
"data" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebhookResponse -> Value
forall a. ToJSON a => a -> Value
toJSON WebhookResponse
resp,
        Key
"version" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
invocationVersionET
      ]
  toJSON (ResponseError ClientError
err) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"client_error",
        Key
"data" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ClientError -> Value
forall a. ToJSON a => a -> Value
toJSON ClientError
err,
        Key
"version" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
invocationVersionET
      ]

instance ToJSON (Response 'ScheduledType) where
  toJSON :: Response 'ScheduledType -> Value
toJSON (ResponseHTTP WebhookResponse
resp) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"webhook_response",
        Key
"data" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebhookResponse -> Value
forall a. ToJSON a => a -> Value
toJSON WebhookResponse
resp,
        Key
"version" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
invocationVersionST
      ]
  toJSON (ResponseError ClientError
err) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"client_error",
        Key
"data" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ClientError -> Value
forall a. ToJSON a => a -> Value
toJSON ClientError
err,
        Key
"version" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
invocationVersionST
      ]

data Invocation (a :: TriggerTypes) = Invocation
  { Invocation a -> EventId
iEventId :: EventId,
    Invocation a -> Maybe Int
iStatus :: Maybe Int,
    Invocation a -> WebhookRequest
iRequest :: WebhookRequest,
    Invocation a -> Response a
iResponse :: Response a
  }

-- | PGTextArray is only used for PG array encoding
newtype PGTextArray = PGTextArray {PGTextArray -> [Text]
unPGTextArray :: [Text]}
  deriving (Int -> PGTextArray -> ShowS
[PGTextArray] -> ShowS
PGTextArray -> String
(Int -> PGTextArray -> ShowS)
-> (PGTextArray -> String)
-> ([PGTextArray] -> ShowS)
-> Show PGTextArray
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PGTextArray] -> ShowS
$cshowList :: [PGTextArray] -> ShowS
show :: PGTextArray -> String
$cshow :: PGTextArray -> String
showsPrec :: Int -> PGTextArray -> ShowS
$cshowsPrec :: Int -> PGTextArray -> ShowS
Show, PGTextArray -> PGTextArray -> Bool
(PGTextArray -> PGTextArray -> Bool)
-> (PGTextArray -> PGTextArray -> Bool) -> Eq PGTextArray
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PGTextArray -> PGTextArray -> Bool
$c/= :: PGTextArray -> PGTextArray -> Bool
== :: PGTextArray -> PGTextArray -> Bool
$c== :: PGTextArray -> PGTextArray -> Bool
Eq)

instance Q.ToPrepArg PGTextArray where
  toPrepVal :: PGTextArray -> PrepArg
toPrepVal (PGTextArray [Text]
l) =
    Oid -> ([Text] -> Encoding) -> [Text] -> PrepArg
forall a. Oid -> (a -> Encoding) -> a -> PrepArg
Q.toPrepValHelper Oid
PTI.unknown [Text] -> Encoding
encoder [Text]
l
    where
      -- 25 is the OID value of TEXT, https://jdbc.postgresql.org/development/privateapi/constant-values.html
      encoder :: [Text] -> Encoding
encoder = Word32 -> Array -> Encoding
PE.array Word32
25 (Array -> Encoding) -> ([Text] -> Array) -> [Text] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b. (b -> Text -> b) -> b -> [Text] -> b)
-> (Text -> Array) -> [Text] -> Array
forall a c.
(forall b. (b -> a -> b) -> b -> c -> b)
-> (a -> Array) -> c -> Array
PE.dimensionArray forall b. (b -> Text -> b) -> b -> [Text] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Encoding -> Array
PE.encodingArray (Encoding -> Array) -> (Text -> Encoding) -> Text -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
PE.text_strict)

-- | Used to construct the payload of Event Trigger
--
-- OLD: Depicts the old database row value for UPDATE/DELETE trigger operations.
--      This is used to construct the 'data.old' field of the event trigger
--      payload. The value of 'data.old' is null in INSERT trigger operation.
--
-- NEW: Depicts the new database row value for INSERT/UPDATE trigger operations.
--      This is used to construct the 'data.new' field of the event trigger
--      payload. The value of 'data.new' is null in DELETE trigger operation.
data OpVar = OLD | NEW deriving (Int -> OpVar -> ShowS
[OpVar] -> ShowS
OpVar -> String
(Int -> OpVar -> ShowS)
-> (OpVar -> String) -> ([OpVar] -> ShowS) -> Show OpVar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpVar] -> ShowS
$cshowList :: [OpVar] -> ShowS
show :: OpVar -> String
$cshow :: OpVar -> String
showsPrec :: Int -> OpVar -> ShowS
$cshowsPrec :: Int -> OpVar -> ShowS
Show)