From 0fce0099b815e2f606af5458f56424c1684bce73 Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Tue, 16 May 2023 16:52:08 +0100 Subject: [PATCH] chore(server): use generics over TH in Hasura.Eventing PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9143 GitOrigin-RevId: ed11588db37f5336698fc33f50066e75fa7f73a1 --- .../src-lib/Hasura/Eventing/EventTrigger.hs | 23 ++++++++-------- server/src-lib/Hasura/Eventing/HTTP.hs | 24 ++++++++++------- .../Hasura/Eventing/ScheduledTrigger/Types.hs | 27 +++++++++++-------- 3 files changed, 42 insertions(+), 32 deletions(-) diff --git a/server/src-lib/Hasura/Eventing/EventTrigger.hs b/server/src-lib/Hasura/Eventing/EventTrigger.hs index f2157a147ee..5df88c5545c 100644 --- a/server/src-lib/Hasura/Eventing/EventTrigger.hs +++ b/server/src-lib/Hasura/Eventing/EventTrigger.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TemplateHaskell #-} - -- | -- = Event Triggers -- @@ -56,7 +53,6 @@ import Data.Aeson qualified as J import Data.Aeson.Key qualified as Key import Data.Aeson.KeyMap qualified as KeyMap import Data.Aeson.Lens qualified as JL -import Data.Aeson.TH import Data.Has import Data.HashMap.Strict qualified as HashMap import Data.SerializableBlob qualified as SB @@ -88,7 +84,8 @@ import Hasura.Server.Prometheus import Hasura.Server.Types import Hasura.Tracing qualified as Tracing import Network.HTTP.Client.Transformable qualified as HTTP -import Refined (NonNegative, Positive, Refined, refineTH, unrefine) +import Refined (NonNegative, Positive, Refined, unrefine) +import Refined.Unsafe (unsafeRefine) import System.Metrics.Distribution qualified as EKG.Distribution import System.Metrics.Gauge qualified as EKG.Gauge import System.Metrics.Prometheus.Counter qualified as Prometheus.Counter @@ -141,9 +138,11 @@ data DeliveryInfo = DeliveryInfo { diCurrentRetry :: Int, diMaxRetries :: Int } - deriving (Show, Eq) + deriving (Show, Generic, Eq) -$(deriveJSON hasuraJSON {omitNothingFields = True} ''DeliveryInfo) +instance J.ToJSON DeliveryInfo where + toJSON = J.genericToJSON hasuraJSON {J.omitNothingFields = True} + toEncoding = J.genericToEncoding hasuraJSON {J.omitNothingFields = True} newtype QualifiedTableStrict = QualifiedTableStrict { getQualifiedTable :: QualifiedTable @@ -172,10 +171,10 @@ deriving instance Backend b => Show (EventPayload b) deriving instance Backend b => Eq (EventPayload b) instance Backend b => J.ToJSON (EventPayload b) where - toJSON = J.genericToJSON hasuraJSON {omitNothingFields = True} + toJSON = J.genericToJSON hasuraJSON {J.omitNothingFields = True} defaultMaxEventThreads :: Refined Positive Int -defaultMaxEventThreads = $$(refineTH 100) +defaultMaxEventThreads = unsafeRefine 100 defaultFetchInterval :: DiffTime defaultFetchInterval = seconds 1 @@ -228,9 +227,11 @@ data FetchedEventsStats = FetchedEventsStats { _fesNumEventsFetched :: NumEventsFetchedPerSource, _fesNumFetches :: Int } - deriving (Eq, Show) + deriving (Eq, Generic, Show) -$(deriveToJSON hasuraJSON ''FetchedEventsStats) +instance J.ToJSON FetchedEventsStats where + toJSON = J.genericToJSON hasuraJSON + toEncoding = J.genericToEncoding hasuraJSON instance L.ToEngineLog FetchedEventsStats L.Hasura where toEngineLog stats = diff --git a/server/src-lib/Hasura/Eventing/HTTP.hs b/server/src-lib/Hasura/Eventing/HTTP.hs index ce5508edfba..cb9d61bda4b 100644 --- a/server/src-lib/Hasura/Eventing/HTTP.hs +++ b/server/src-lib/Hasura/Eventing/HTTP.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} - -- | -- = Hasura.Eventing.HTTP -- @@ -50,7 +48,6 @@ import Data.Aeson.Encoding qualified as JE import Data.Aeson.Key qualified as J import Data.Aeson.KeyMap qualified as KM import Data.Aeson.Lens -import Data.Aeson.TH import Data.ByteString qualified as BS import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy qualified as LBS @@ -89,9 +86,11 @@ data HTTPResp (a :: TriggerTypes) = HTTPResp hrsBody :: !SB.SerializableBlob, hrsSize :: !Int64 } - deriving (Show) + deriving (Generic, Show) -$(deriveToJSON hasuraJSON {omitNothingFields = True} ''HTTPResp) +instance J.ToJSON (HTTPResp a) where + toJSON = J.genericToJSON hasuraJSON {J.omitNothingFields = True} + toEncoding = J.genericToEncoding hasuraJSON {J.omitNothingFields = True} instance ToEngineLog (HTTPResp 'EventType) Hasura where toEngineLog resp = (LevelInfo, eventTriggerLogType, J.toJSON resp) @@ -135,14 +134,14 @@ mkHTTPResp :: HTTP.Response LBS.ByteString -> HTTPResp a mkHTTPResp resp = HTTPResp { hrsStatus = HTTP.statusCode $ HTTP.responseStatus resp, - hrsHeaders = map decodeHeader $ HTTP.responseHeaders resp, + hrsHeaders = map decodeHeader' $ HTTP.responseHeaders resp, hrsBody = SB.fromLBS respBody, hrsSize = LBS.length respBody } where respBody = HTTP.responseBody resp decodeBS = TE.decodeUtf8With TE.lenientDecode - decodeHeader (hdrName, hdrVal) = + decodeHeader' (hdrName, hdrVal) = HeaderConf (decodeBS $ CI.original hdrName) (HVValue (decodeBS hdrVal)) data RequestDetails = RequestDetails @@ -153,11 +152,14 @@ data RequestDetails = RequestDetails _rdReqTransformCtx :: Maybe Transform.RequestContext, _rdSessionVars :: Maybe SessionVariables } + deriving (Generic) extractRequest :: RequestDetails -> HTTP.Request extractRequest RequestDetails {..} = fromMaybe _rdOriginalRequest _rdTransformedRequest -$(deriveToJSON hasuraJSON ''RequestDetails) +instance J.ToJSON RequestDetails where + toJSON = J.genericToJSON hasuraJSON + toEncoding = J.genericToEncoding hasuraJSON data HTTPRespExtra (a :: TriggerTypes) = HTTPRespExtra { _hreResponse :: !(Either (HTTPErr a) (HTTPResp a)), @@ -239,9 +241,11 @@ data HTTPReq = HTTPReq _hrqTry :: !Int, _hrqDelay :: !(Maybe Int) } - deriving (Show, Eq) + deriving (Show, Generic, Eq) -$(deriveJSON hasuraJSON {omitNothingFields = True} ''HTTPReq) +instance J.ToJSON HTTPReq where + toJSON = J.genericToJSON hasuraJSON {J.omitNothingFields = True} + toEncoding = J.genericToEncoding hasuraJSON {J.omitNothingFields = True} instance ToEngineLog HTTPReq Hasura where toEngineLog req = (LevelInfo, eventTriggerLogType, J.toJSON req) diff --git a/server/src-lib/Hasura/Eventing/ScheduledTrigger/Types.hs b/server/src-lib/Hasura/Eventing/ScheduledTrigger/Types.hs index 03c20b88ca2..8f354954059 100644 --- a/server/src-lib/Hasura/Eventing/ScheduledTrigger/Types.hs +++ b/server/src-lib/Hasura/Eventing/ScheduledTrigger/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} - module Hasura.Eventing.ScheduledTrigger.Types ( CronTriggerStats (CronTriggerStats, _ctsMaxScheduledTime, _ctsName), FetchedCronTriggerStats (..), @@ -17,7 +15,6 @@ where import Control.FoldDebounce qualified as FDebounce import Data.Aeson qualified as J -import Data.Aeson.TH qualified as J import Data.Time.Clock import Hasura.Base.Error import Hasura.Eventing.HTTP @@ -40,17 +37,21 @@ data CronTriggerStats = CronTriggerStats _ctsUpcomingEventsCount :: !Int, _ctsMaxScheduledTime :: !UTCTime } - deriving (Eq) + deriving (Eq, Generic) -$(J.deriveToJSON hasuraJSON ''CronTriggerStats) +instance J.ToJSON CronTriggerStats where + toJSON = J.genericToJSON hasuraJSON + toEncoding = J.genericToEncoding hasuraJSON data FetchedCronTriggerStats = FetchedCronTriggerStats { _fctsCronTriggers :: [CronTriggerStats], _fctsNumFetches :: Int } - deriving (Eq) + deriving (Eq, Generic) -$(J.deriveToJSON hasuraJSON ''FetchedCronTriggerStats) +instance J.ToJSON FetchedCronTriggerStats where + toJSON = J.genericToJSON hasuraJSON + toEncoding = J.genericToEncoding hasuraJSON instance L.ToEngineLog FetchedCronTriggerStats L.Hasura where toEngineLog stats = @@ -87,9 +88,11 @@ data ScheduledEventWebhookPayload = ScheduledEventWebhookPayload sewpRequestTransform :: !(Maybe RequestTransform), sewpResponseTransform :: !(Maybe MetadataResponseTransform) } - deriving (Show, Eq) + deriving (Show, Generic, Eq) -$(J.deriveToJSON hasuraJSON {J.omitNothingFields = True} ''ScheduledEventWebhookPayload) +instance J.ToJSON ScheduledEventWebhookPayload where + toJSON = J.genericToJSON hasuraJSON {J.omitNothingFields = True} + toEncoding = J.genericToEncoding hasuraJSON {J.omitNothingFields = True} data ScheduledEventOp = SEOpRetry !UTCTime @@ -108,9 +111,11 @@ data FetchedScheduledEventsStats = FetchedScheduledEventsStats _fsesNumOneOffScheduledEventsFetched :: OneOffScheduledEventsCount, _fsesNumFetches :: Int } - deriving (Eq, Show) + deriving (Eq, Generic, Show) -$(J.deriveToJSON hasuraJSON ''FetchedScheduledEventsStats) +instance J.ToJSON FetchedScheduledEventsStats where + toJSON = J.genericToJSON hasuraJSON + toEncoding = J.genericToEncoding hasuraJSON instance L.ToEngineLog FetchedScheduledEventsStats L.Hasura where toEngineLog stats =