hasura/graphql-engine
1
0
Fork 0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-09-21 07:28:26 +03:00
Code Issues Projects Releases Wiki Activity

server: simplify JSON instances

Browse Source 
GITHUB_PR_NUMBER: 6152
GITHUB_PR_URL: https://github.com/hasura/graphql-engine/pull/6152

Co-authored-by: Antoine Leblanc <1618949+nicuveo@users.noreply.github.com>
GitOrigin-RevId: 6c94aef8c57e852b3d41b8355c09e64fce756a7c
This commit is contained in:
hasura-bot 2021-01-20 00:44:42 +05:30
parent 38fc4cb677
commit 2c56254e5a
64 changed files with 322 additions and 350 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
server/src-lib/Hasura/Backends/Postgres/SQL/DML.hs
View File

@ -5,7 +5,6 @@ import Hasura.Prelude
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Text.Builder as TB
import Data.String (fromString)
@ -408,8 +407,7 @@ instance ToSQL SQLExp where
toSQL (SEFunction funcExp) = toSQL funcExp
intToSQLExp :: Int -> SQLExp
intToSQLExp =
SEUnsafe . T.pack . show
intToSQLExp = SEUnsafe . tshow
data Extractor = Extractor !SQLExp !(Maybe Alias)
deriving (Show, Eq, Generic, Data)
@ -764,10 +762,10 @@ instance Show CompareOp where
SNILIKE -> "NOT ILIKE"
SSIMILAR -> "SIMILAR TO"
SNSIMILAR -> "NOT SIMILAR TO"
SREGEX -> "~"
SIREGEX -> "~*"
SNREGEX -> "!~"
SNIREGEX -> "!~*"
SREGEX -> "~"
SIREGEX -> "~*"
SNREGEX -> "!~"
SNIREGEX -> "!~*"
SContains -> "@>"
SContainedIn -> "<@"
SHasKey -> "?"

5
server/src-lib/Hasura/Backends/Postgres/SQL/Rewrite.hs
View File

@ -5,8 +5,7 @@ module Hasura.Backends.Postgres.SQL.Rewrite
import Hasura.Prelude
import qualified Data.HashMap.Strict as Map
import qualified Data.Text as T
import qualified Data.HashMap.Strict as Map
import qualified Hasura.Backends.Postgres.SQL.DML as S
@ -43,7 +42,7 @@ withNumPfx :: Identifier -> Int -> Identifier
withNumPfx iden i =
Identifier pfx <> iden
where
pfx = "_" <> T.pack (show i) <> "_"
pfx = "_" <> tshow i <> "_"
addAlias :: S.Alias -> Uniq S.Alias
addAlias (S.Alias iden) = do

3
server/src-lib/Hasura/Backends/Postgres/SQL/Types.hs
View File

@ -58,7 +58,6 @@ import qualified PostgreSQL.Binary.Decoding as PD
import qualified Text.Builder as TB
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.Encoding (text)
import Data.Aeson.TH
import Data.Aeson.Types (toJSONKeyText)
@ -478,7 +477,7 @@ data QualifiedPGType
} deriving (Show, Eq, Generic)
instance NFData QualifiedPGType
instance Cacheable QualifiedPGType
$(deriveJSON (aesonDrop 4 snakeCase) ''QualifiedPGType)
$(deriveJSON hasuraJSON ''QualifiedPGType)
isBaseType :: QualifiedPGType -> Bool
isBaseType (QualifiedPGType _ n ty) =

38
server/src-lib/Hasura/Backends/Postgres/SQL/Value.hs
View File

@ -16,18 +16,18 @@ module Hasura.Backends.Postgres.SQL.Value
import Hasura.Prelude
import qualified Data.Aeson.Text as AE
import qualified Data.Aeson.Types as AT
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Conversions as TC
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.UUID as UUID
import qualified Database.PG.Query as Q
import qualified Database.PG.Query.PTI as PTI
import qualified Database.PostgreSQL.LibPQ as PQ
import qualified PostgreSQL.Binary.Encoding as PE
import qualified Data.Aeson.Text as AE
import qualified Data.Aeson.Types as AT
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Conversions as TC
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.UUID as UUID
import qualified Database.PG.Query as Q
import qualified Database.PG.Query.PTI as PTI
import qualified Database.PostgreSQL.LibPQ as PQ
import qualified PostgreSQL.Binary.Encoding as PE
import Data.Aeson
import Data.Int
@ -194,17 +194,17 @@ instance FromJSON TxtEncodedPGVal where
txtEncodedPGVal :: PGScalarValue -> TxtEncodedPGVal
txtEncodedPGVal = \case
PGValInteger i -> TELit $ T.pack $ show i
PGValSmallInt i -> TELit $ T.pack $ show i
PGValBigInt i -> TELit $ T.pack $ show i
PGValFloat f -> TELit $ T.pack $ show f
PGValDouble d -> TELit $ T.pack $ show d
PGValNumeric sc -> TELit $ T.pack $ show sc
PGValInteger i -> TELit $ tshow i
PGValSmallInt i -> TELit $ tshow i
PGValBigInt i -> TELit $ tshow i
PGValFloat f -> TELit $ tshow f
PGValDouble d -> TELit $ tshow d
PGValNumeric sc -> TELit $ tshow sc
-- PostgreSQL doesn't like scientific notation for money, so pass it
-- with 2 decimal places.
PGValMoney m -> TELit $ T.pack $ formatScientific Fixed (Just 2) m
PGValBoolean b -> TELit $ bool "false" "true" b
PGValChar t -> TELit $ T.pack $ show t
PGValChar t -> TELit $ tshow t
PGValVarchar t -> TELit t
PGValText t -> TELit t
PGValCitext t -> TELit t

9
server/src-lib/Hasura/Eventing/EventTrigger.hs
View File

@ -59,7 +59,6 @@ import Control.Monad.Catch (MonadMask, bracket_)
import Control.Monad.STM
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Has
import Data.Int (Int64)
@ -84,7 +83,7 @@ data TriggerMetadata
= TriggerMetadata { tmName :: TriggerName }
deriving (Show, Eq)
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''TriggerMetadata)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''TriggerMetadata)
newtype EventInternalErr
= EventInternalErr QErr
@ -107,7 +106,7 @@ data Event
, eCreatedAt :: !Time.UTCTime
} deriving (Show, Eq)
$(deriveFromJSON (aesonDrop 1 snakeCase){omitNothingFields=True} ''Event)
$(deriveFromJSON hasuraJSON{omitNothingFields=True} ''Event)
data EventEngineCtx
= EventEngineCtx
@ -121,7 +120,7 @@ data DeliveryInfo
, diMaxRetries :: Int
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''DeliveryInfo)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''DeliveryInfo)
newtype QualifiedTableStrict = QualifiedTableStrict
{ getQualifiedTable :: QualifiedTable
@ -143,7 +142,7 @@ data EventPayload
, epCreatedAt :: Time.UTCTime
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''EventPayload)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''EventPayload)
defaultMaxEventThreads :: Int
defaultMaxEventThreads = 100

21
server/src-lib/Hasura/Eventing/HTTP.hs
View File

@ -53,7 +53,6 @@ import qualified Network.HTTP.Types as HTTP
import Control.Exception (try)
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Either
import Data.Has
@ -75,7 +74,7 @@ data WebhookRequest
, _rqHeaders :: [HeaderConf]
, _rqVersion :: Text
}
$(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''WebhookRequest)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''WebhookRequest)
data WebhookResponse
= WebhookResponse
@ -83,10 +82,10 @@ data WebhookResponse
, _wrsHeaders :: [HeaderConf]
, _wrsStatus :: Int
}
$(deriveToJSON (aesonDrop 4 snakeCase){omitNothingFields=True} ''WebhookResponse)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''WebhookResponse)
newtype ClientError = ClientError { _ceMessage :: TBS.TByteString}
$(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''ClientError)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''ClientError)
type InvocationVersion = Text
@ -141,7 +140,7 @@ data ExtraLogContext
, elEventId :: EventId
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''ExtraLogContext)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''ExtraLogContext)
data HTTPResp (a :: TriggerTypes)
= HTTPResp
@ -151,7 +150,7 @@ data HTTPResp (a :: TriggerTypes)
, hrsSize :: !Int64
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''HTTPResp)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''HTTPResp)
instance ToEngineLog (HTTPResp 'EventType) Hasura where
toEngineLog resp = (LevelInfo, eventTriggerLogType, toJSON resp)
@ -203,7 +202,7 @@ mkHTTPResp resp =
newtype RequestDetails
= RequestDetails { _rdSize :: Int64 }
$(deriveToJSON (aesonDrop 3 snakeCase) ''RequestDetails)
$(deriveToJSON hasuraJSON ''RequestDetails)
data HTTPRespExtra (a :: TriggerTypes)
= HTTPRespExtra
@ -240,9 +239,9 @@ isNetworkError = \case
isNetworkErrorHC :: HTTP.HttpException -> Bool
isNetworkErrorHC = \case
HTTP.HttpExceptionRequest _ (HTTP.ConnectionFailure _) -> True
HTTP.HttpExceptionRequest _ HTTP.ConnectionTimeout -> True
HTTP.HttpExceptionRequest _ HTTP.ResponseTimeout -> True
_ -> False
HTTP.HttpExceptionRequest _ HTTP.ConnectionTimeout -> True
HTTP.HttpExceptionRequest _ HTTP.ResponseTimeout -> True
_ -> False
anyBodyParser :: HTTP.Response LBS.ByteString -> Either (HTTPErr a) (HTTPResp a)
anyBodyParser resp = do
@ -262,7 +261,7 @@ data HTTPReq
, _hrqDelay :: !(Maybe Int)
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 4 snakeCase){omitNothingFields=True} ''HTTPReq)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''HTTPReq)
instance ToEngineLog HTTPReq Hasura where
toEngineLog req = (LevelInfo, eventTriggerLogType, toJSON req)

2
server/src-lib/Hasura/Eventing/ScheduledTrigger.hs
View File

@ -134,8 +134,8 @@ import Hasura.Metadata.Class
import Hasura.RQL.DDL.EventTrigger (getHeaderInfosFromConf)
import Hasura.RQL.DDL.Headers
import Hasura.RQL.Types
import Hasura.Server.Version (HasVersion)
import Hasura.SQL.Types
import Hasura.Server.Version (HasVersion)
-- | runCronEventsGenerator makes sure that all the cron triggers
-- have an adequate buffer of cron events.

3
server/src-lib/Hasura/Eventing/ScheduledTrigger/Types.hs
View File

@ -6,7 +6,6 @@ import Hasura.Prelude
import Hasura.RQL.Types
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.TH as J
import qualified Database.PG.Query as Q
import qualified Database.PG.Query.PTI as PTI
@ -50,7 +49,7 @@ data ScheduledEventWebhookPayload
-- don't send it
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) {J.omitNothingFields = True} ''ScheduledEventWebhookPayload)
$(J.deriveToJSON hasuraJSON {J.omitNothingFields = True} ''ScheduledEventWebhookPayload)
newtype ScheduledEventIdArray =
ScheduledEventIdArray { unScheduledEventIdArray :: [ScheduledEventId]}

3
server/src-lib/Hasura/GraphQL/Context.hs
View File

@ -25,7 +25,6 @@ import Hasura.Prelude
import qualified Data.Aeson as J
import qualified Language.GraphQL.Draft.Syntax as G
import Data.Aeson.Casing
import Data.Aeson.TH
import Hasura.SQL.Backend
@ -50,7 +49,7 @@ data RoleContext a
{ _rctxDefault :: !a -- ^ The default context for normal sessions
, _rctxBackend :: !(Maybe a) -- ^ The context for sessions with backend privilege.
} deriving (Show, Eq, Functor, Foldable, Traversable)
$(deriveToJSON (aesonDrop 5 snakeCase) ''RoleContext)
$(deriveToJSON hasuraJSON ''RoleContext)
data GQLContext = GQLContext
{ gqlQueryParser :: ParserFn (InsOrdHashMap G.Name (QueryRootField (UnpreparedValue 'Postgres)))

19
server/src-lib/Hasura/GraphQL/Execute/Action.hs
View File

@ -18,7 +18,6 @@ import Hasura.Prelude
import qualified Control.Concurrent.Async.Lifted.Safe as LA
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.Ordered as AO
import qualified Data.Aeson.TH as J
import qualified Data.ByteString.Lazy as BL
@ -39,8 +38,8 @@ import Control.Exception (try)
import Control.Lens
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Has
import Data.Int (Int64)
import Data.IORef
import Data.Int (Int64)
import Data.Text.Extended
import qualified Hasura.Backends.Postgres.Execute.RemoteJoin as RJ
@ -63,11 +62,11 @@ import Hasura.Metadata.Class
import Hasura.RQL.DDL.Headers
import Hasura.RQL.DDL.Schema.Cache
import Hasura.RQL.Types
import Hasura.SQL.Types
import Hasura.Server.Utils (mkClientHeadersForward,
mkSetCookieHeaders)
import Hasura.Server.Version (HasVersion)
import Hasura.Session
import Hasura.SQL.Types
newtype ActionExecution =
@ -101,7 +100,7 @@ runActionExecution aep = do
newtype ActionContext
= ActionContext {_acName :: ActionName}
deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ActionContext)
$(J.deriveJSON hasuraJSON ''ActionContext)
data ActionWebhookPayload
= ActionWebhookPayload
@ -109,14 +108,14 @@ data ActionWebhookPayload
, _awpSessionVariables :: !SessionVariables
, _awpInput :: !J.Value
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookPayload)
$(J.deriveJSON hasuraJSON ''ActionWebhookPayload)
data ActionWebhookErrorResponse
= ActionWebhookErrorResponse
{ _awerMessage :: !Text
, _awerCode :: !(Maybe Text)
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''ActionWebhookErrorResponse)
$(J.deriveJSON hasuraJSON ''ActionWebhookErrorResponse)
data ActionWebhookResponse
= AWRArray ![Map.HashMap G.Name J.Value]
@ -139,7 +138,7 @@ data ActionRequestInfo
, _areqiBody :: !J.Value
, _areqiHeaders :: ![HeaderConf]
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 6 J.snakeCase) ''ActionRequestInfo)
$(J.deriveToJSON hasuraJSON ''ActionRequestInfo)
data ActionResponseInfo
= ActionResponseInfo
@ -147,7 +146,7 @@ data ActionResponseInfo
, _aresiBody :: !J.Value
, _aresiHeaders :: ![HeaderConf]
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 6 J.snakeCase) ''ActionResponseInfo)
$(J.deriveToJSON hasuraJSON ''ActionResponseInfo)
data ActionInternalError
= ActionInternalError
@ -155,7 +154,7 @@ data ActionInternalError
, _aieRequest :: !ActionRequestInfo
, _aieResponse :: !(Maybe ActionResponseInfo)
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''ActionInternalError)
$(J.deriveToJSON hasuraJSON ''ActionInternalError)
-- * Action handler logging related
data ActionHandlerLog
@ -163,7 +162,7 @@ data ActionHandlerLog
{ _ahlRequestSize :: !Int64
, _ahlResponseSize :: !Int64
} deriving (Show)
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase){J.omitNothingFields=True} ''ActionHandlerLog)
$(J.deriveJSON hasuraJSON{J.omitNothingFields=True} ''ActionHandlerLog)
instance L.ToEngineLog ActionHandlerLog L.Hasura where
toEngineLog ahl = (L.LevelInfo, L.ELTActionHandler, J.toJSON ahl)

2
server/src-lib/Hasura/GraphQL/Execute/Insert.hs
View File

@ -120,7 +120,7 @@ insertMultipleObjects env multiObjIns additionalColumns remoteJoinCtx mutationOu
checkCondition
mutationOutput
columnInfos
rowCount = T.pack . show . length $ IR._aiInsObj multiObjIns
rowCount = tshow . length $ IR._aiInsObj multiObjIns
Tracing.trace ("Insert (" <> rowCount <> ") " <> qualifiedObjectToText table) do
Tracing.attachMetadata [("count", rowCount)]
PGE.execInsertQuery env stringifyNum (Just remoteJoinCtx) (insertQuery, planVars)

9
server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs
View File

@ -26,7 +26,6 @@ module Hasura.GraphQL.Execute.LiveQuery.Plan
import Hasura.Prelude
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.Extended as J
import qualified Data.Aeson.TH as J
import qualified Data.ByteString as B
@ -59,8 +58,8 @@ import Hasura.GraphQL.Context
import Hasura.GraphQL.Execute.Query
import Hasura.GraphQL.Parser.Column
import Hasura.RQL.Types
import Hasura.Session
import Hasura.SQL.Types
import Hasura.Session
-- -------------------------------------------------------------------------------------------------
@ -331,7 +330,7 @@ data ParameterizedLiveQueryPlan
{ _plqpRole :: !RoleName
, _plqpQuery :: !MultiplexedQuery
} deriving (Show)
$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''ParameterizedLiveQueryPlan)
$(J.deriveToJSON hasuraJSON ''ParameterizedLiveQueryPlan)
data ReusableLiveQueryPlan
= ReusableLiveQueryPlan
@ -340,7 +339,7 @@ data ReusableLiveQueryPlan
, _rlqpSyntheticVariableValues :: !ValidatedSyntheticVariables
, _rlqpQueryVariableTypes :: HashMap G.Name (ColumnType 'Postgres)
} deriving (Show)
$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''ReusableLiveQueryPlan)
$(J.deriveToJSON hasuraJSON ''ReusableLiveQueryPlan)
-- | Constructs a new execution plan for a live query and returns a reusable version
-- of the plan if possible.
@ -397,7 +396,7 @@ data LiveQueryPlanExplanation
, _lqpePlan :: ![Text]
, _lqpeVariables :: !CohortVariables
} deriving (Show)
$(J.deriveToJSON (J.aesonDrop 5 J.snakeCase) ''LiveQueryPlanExplanation)
$(J.deriveToJSON hasuraJSON ''LiveQueryPlanExplanation)
explainLiveQueryPlan
:: ( MonadError QErr m

7
server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Poll.hs
View File

@ -49,7 +49,6 @@ import qualified Control.Concurrent.Async as A
import qualified Control.Concurrent.STM as STM
import qualified Control.Immortal as Immortal
import qualified Crypto.Hash as CH
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.Extended as J
import qualified Data.Aeson.TH as J
import qualified Data.ByteString as BS
@ -328,7 +327,7 @@ data CohortExecutionDetails
-- polled cycle
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''CohortExecutionDetails)
$(J.deriveToJSON hasuraJSON ''CohortExecutionDetails)
-- | Execution information related to a single batched execution
data BatchExecutionDetails
@ -348,7 +347,7 @@ batchExecutionDetailMinimal BatchExecutionDetails{..} =
, "push_time" J..= _bedPushTime
]
$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''BatchExecutionDetails)
$(J.deriveToJSON hasuraJSON ''BatchExecutionDetails)
data PollDetails
= PollDetails
@ -368,7 +367,7 @@ data PollDetails
, _pdLiveQueryOptions :: !LiveQueriesOptions
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''PollDetails)
$(J.deriveToJSON hasuraJSON ''PollDetails)
{- Note [Minimal LiveQuery Poller Log]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

3
server/src-lib/Hasura/GraphQL/Execute/Plan.hs
View File

@ -11,7 +11,6 @@ module Hasura.GraphQL.Execute.Plan
) where
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.TH as J
import Hasura.Prelude
@ -77,7 +76,7 @@ data ReusablePlan = ReusablePlan
newtype PlanCacheOptions
= PlanCacheOptions { unPlanCacheSize :: Cache.CacheSize }
deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 2 J.snakeCase) ''PlanCacheOptions)
$(J.deriveJSON hasuraJSON ''PlanCacheOptions)
mkPlanCacheOptions :: Cache.CacheSize -> PlanCacheOptions
mkPlanCacheOptions = PlanCacheOptions

4
server/src-lib/Hasura/GraphQL/Explain.hs
View File

@ -44,7 +44,7 @@ data GQLExplain
, _gqeIsRelay :: !(Maybe Bool)
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase){J.omitNothingFields=True}
$(J.deriveJSON hasuraJSON{J.omitNothingFields=True}
''GQLExplain
)
@ -55,7 +55,7 @@ data FieldPlan
, _fpPlan :: !(Maybe [Text])
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 3 J.camelCase) ''FieldPlan)
$(J.deriveJSON (J.aesonPrefix J.camelCase) ''FieldPlan)
resolveUnpreparedValue
:: (MonadError QErr m)

2
server/src-lib/Hasura/GraphQL/Transport/HTTP/Protocol.hs
View File

@ -64,7 +64,7 @@ data GQLReq a
, _grVariables :: !(Maybe VariableValues)
} deriving (Show, Eq, Generic, Functor, Lift)
$(J.deriveJSON (J.aesonDrop 3 J.camelCase){J.omitNothingFields=True} ''GQLReq)
$(J.deriveJSON (J.aesonPrefix J.camelCase){J.omitNothingFields=True} ''GQLReq)
instance (Hashable a) => Hashable (GQLReq a)

6
server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs
View File

@ -169,7 +169,7 @@ data OperationDetails
, _odOperationType :: !OpDetail
, _odQuery :: !(Maybe GQLReqUnparsed)
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''OperationDetails)
$(J.deriveToJSON hasuraJSON ''OperationDetails)
data WSEvent
= EAccepted
@ -190,7 +190,7 @@ data WsConnInfo
, _wsciTokenExpiry :: !(Maybe TC.UTCTime)
, _wsciMsg :: !(Maybe Text)
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 5 J.snakeCase) ''WsConnInfo)
$(J.deriveToJSON hasuraJSON ''WsConnInfo)
data WSLogInfo
= WSLogInfo
@ -198,7 +198,7 @@ data WSLogInfo
, _wsliConnectionInfo :: !WsConnInfo
, _wsliEvent :: !WSEvent
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 5 J.snakeCase) ''WSLogInfo)
$(J.deriveToJSON hasuraJSON ''WSLogInfo)
data WSLog
= WSLog

7
server/src-lib/Hasura/GraphQL/Transport/WebSocket/Protocol.hs
View File

@ -16,7 +16,6 @@ module Hasura.GraphQL.Transport.WebSocket.Protocol
) where
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.TH as J
import qualified Data.ByteString.Lazy as BL
import qualified Data.HashMap.Strict as Map
@ -35,13 +34,13 @@ data StartMsg
{ _smId :: !OperationId
, _smPayload :: !GQLReqUnparsed
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''StartMsg)
$(J.deriveJSON hasuraJSON ''StartMsg)
data StopMsg
= StopMsg
{ _stId :: OperationId
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''StopMsg)
$(J.deriveJSON hasuraJSON ''StopMsg)
data ClientMsg
= CMConnInit !(Maybe ConnParams)
@ -54,7 +53,7 @@ data ConnParams
= ConnParams
{ _cpHeaders :: Maybe (Map.HashMap Text Text)
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ConnParams)
$(J.deriveJSON hasuraJSON ''ConnParams)
instance J.FromJSON ClientMsg where
parseJSON = J.withObject "ClientMessage" $ \obj -> do

2
server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs
View File

@ -74,7 +74,7 @@ data MessageDetails
{ _mdMessage :: !TBS.TByteString
, _mdMessageSize :: !Int64
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''MessageDetails)
$(J.deriveToJSON hasuraJSON ''MessageDetails)
data WSEvent
= EConnectionRequest

31
server/src-lib/Hasura/Logging.hs
View File

@ -34,7 +34,6 @@ import Control.Monad.Trans.Control
import qualified Control.AutoUpdate as Auto
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.TH as J
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
@ -80,14 +79,14 @@ instance Hashable (EngineLogType Hasura)
instance J.ToJSON (EngineLogType Hasura) where
toJSON = \case
ELTHttpLog -> "http-log"
ELTWebsocketLog -> "websocket-log"
ELTWebhookLog -> "webhook-log"
ELTQueryLog -> "query-log"
ELTStartup -> "startup"
ELTHttpLog -> "http-log"
ELTWebsocketLog -> "websocket-log"
ELTWebhookLog -> "webhook-log"
ELTQueryLog -> "query-log"
ELTStartup -> "startup"
ELTLivequeryPollerLog -> "livequery-poller-log"
ELTActionHandler -> "action-handler-log"
ELTInternal t -> J.toJSON t
ELTActionHandler -> "action-handler-log"
ELTInternal t -> J.toJSON t
instance J.FromJSON (EngineLogType Hasura) where
parseJSON = J.withText "log-type" $ \s -> case T.toLower $ T.strip s of
@ -120,14 +119,14 @@ instance Hashable InternalLogTypes
instance J.ToJSON InternalLogTypes where
toJSON = \case
ILTUnstructured -> "unstructured"
ILTEventTrigger -> "event-trigger"
ILTUnstructured -> "unstructured"
ILTEventTrigger -> "event-trigger"
ILTScheduledTrigger -> "scheduled-trigger"
ILTWsServer -> "ws-server"
ILTPgClient -> "pg-client"
ILTMetadata -> "metadata"
ILTJwkRefreshLog -> "jwk-refresh-log"
ILTTelemetry -> "telemetry-log"
ILTWsServer -> "ws-server"
ILTPgClient -> "pg-client"
ILTMetadata -> "metadata"
ILTJwkRefreshLog -> "jwk-refresh-log"
ILTTelemetry -> "telemetry-log"
ILTSchemaSyncThread -> "schema-sync-thread"
-- the default enabled log-types
@ -192,7 +191,7 @@ deriving instance Eq (EngineLogType impl) => Eq (EngineLog impl)
$(pure [])
instance J.ToJSON (EngineLogType impl) => J.ToJSON (EngineLog impl) where
toJSON = $(J.mkToJSON (J.aesonDrop 3 J.snakeCase) ''EngineLog)
toJSON = $(J.mkToJSON hasuraJSON ''EngineLog)
-- | Typeclass representing any data type that can be converted to @EngineLog@ for the purpose of
-- logging

9
server/src-lib/Hasura/Prelude.hs
View File

@ -28,6 +28,8 @@ module Hasura.Prelude
-- * Measuring and working with moments and durations
, withElapsedTime
, startTimer
-- * Aeson options
, hasuraJSON
, module Data.Time.Clock.Units
) where
@ -51,10 +53,10 @@ import Data.Foldable as M (asum, fold, foldrM, for
traverse_)
import Data.Function as M (on, (&))
import Data.Functor as M (($>), (<&>))
import Data.Hashable as M (Hashable)
import Data.HashMap.Strict as M (HashMap)
import Data.HashMap.Strict.InsOrd as M (InsOrdHashMap)
import Data.HashSet as M (HashSet)
import Data.Hashable as M (Hashable)
import Data.List as M (find, findIndex, foldl', group,
intercalate, intersect, lookup, sort,
sortBy, sortOn, union, unionBy, (\\))
@ -79,6 +81,8 @@ import Prelude as M hiding (fail, init, look
import Test.QuickCheck.Arbitrary.Generic as M
import Text.Read as M (readEither, readMaybe)
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64.Lazy as Base64
import qualified Data.ByteString.Lazy as BL
@ -201,3 +205,6 @@ hoistMaybe = MaybeT . return
tshow :: Show a => a -> Text
tshow = T.pack . show
hasuraJSON :: J.Options
hasuraJSON = J.aesonPrefix J.snakeCase

5
server/src-lib/Hasura/RQL/DDL/Action.hs
View File

@ -22,7 +22,6 @@ module Hasura.RQL.DDL.Action
import Hasura.Prelude
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.TH as J
import qualified Data.Environment as Env
import qualified Data.HashMap.Strict as Map
@ -149,7 +148,7 @@ data DropAction
{ _daName :: !ActionName
, _daClearData :: !(Maybe ClearActionData)
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''DropAction)
$(J.deriveJSON hasuraJSON ''DropAction)
runDropAction
:: ( CacheRWM m
@ -198,7 +197,7 @@ data DropActionPermission
{ _dapAction :: !ActionName
, _dapRole :: !RoleName
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''DropActionPermission)
$(J.deriveJSON hasuraJSON ''DropActionPermission)
runDropActionPermission
:: (QErrM m, CacheRWM m, MetadataM m)

7
server/src-lib/Hasura/RQL/DDL/ComputedField.hs
View File

@ -20,7 +20,6 @@ import qualified Data.Sequence as Seq
import qualified Language.GraphQL.Draft.Syntax as G
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
@ -31,8 +30,8 @@ import Hasura.RQL.DDL.Deps
import Hasura.RQL.DDL.Permission
import Hasura.RQL.DDL.Schema.Function (mkFunctionArgs)
import Hasura.RQL.Types
import Hasura.Server.Utils (makeReasonMessage)
import Hasura.SQL.Types
import Hasura.Server.Utils (makeReasonMessage)
data AddComputedField
@ -45,7 +44,7 @@ data AddComputedField
} deriving (Show, Eq, Generic)
instance NFData AddComputedField
instance Cacheable AddComputedField
$(deriveToJSON (aesonDrop 4 snakeCase) ''AddComputedField)
$(deriveToJSON hasuraJSON ''AddComputedField)
instance FromJSON AddComputedField where
parseJSON = withObject "Object" $ \o ->
@ -255,7 +254,7 @@ data DropComputedField
, _dccName :: !ComputedFieldName
, _dccCascade :: !Bool
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase) ''DropComputedField)
$(deriveToJSON hasuraJSON ''DropComputedField)
instance FromJSON DropComputedField where
parseJSON = withObject "Object" $ \o ->

5
server/src-lib/Hasura/RQL/DDL/Metadata/Types.hs
View File

@ -17,7 +17,6 @@ module Hasura.RQL.DDL.Metadata.Types
import Hasura.Prelude
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Hasura.RQL.Types
@ -66,7 +65,7 @@ data ReloadMetadata
{ _rmReloadRemoteSchemas :: !ReloadRemoteSchemas
, _rmReloadSources :: !ReloadSources
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 3 snakeCase) ''ReloadMetadata)
$(deriveToJSON hasuraJSON ''ReloadMetadata)
instance FromJSON ReloadMetadata where
parseJSON = \case
@ -116,5 +115,5 @@ instance FromJSON ReplaceMetadata where
instance ToJSON ReplaceMetadata where
toJSON = \case
RMWithSources v -> toJSON v
RMWithSources v -> toJSON v
RMWithoutSources v -> toJSON v

5
server/src-lib/Hasura/RQL/DDL/Permission.hs
View File

@ -41,7 +41,6 @@ import qualified Data.HashSet as HS
import Control.Lens ((.~))
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
@ -50,8 +49,8 @@ import Hasura.EncJSON
import Hasura.RQL.DDL.Permission.Internal
import Hasura.RQL.DML.Internal hiding (askPermInfo)
import Hasura.RQL.Types
import Hasura.Session
import Hasura.SQL.Types
import Hasura.Session
@ -343,7 +342,7 @@ data SetPermComment
, apComment :: !(Maybe Text)
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase) ''SetPermComment)
$(deriveToJSON hasuraJSON ''SetPermComment)
instance FromJSON SetPermComment where
parseJSON = withObject "Object" $ \o ->

5
server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs
View File

@ -11,7 +11,6 @@ import qualified Database.PG.Query as Q
import qualified Hasura.Backends.Postgres.SQL.DML as S
import Control.Lens hiding ((.=))
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Text.Extended
@ -20,9 +19,9 @@ import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.Translate.BoolExp
import Hasura.Backends.Postgres.Translate.Column
import Hasura.RQL.Types
import Hasura.SQL.Types
import Hasura.Server.Utils
import Hasura.Session
import Hasura.SQL.Types
convColSpec :: FieldInfoMap (FieldInfo 'Postgres) -> PermColSpec -> [PGCol]
@ -204,7 +203,7 @@ data DropPerm a
, dipRole :: !RoleName
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''DropPerm)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''DropPerm)
instance FromJSON (DropPerm a) where
parseJSON = withObject "DropPerm" $ \o ->

3
server/src-lib/Hasura/RQL/DDL/Schema.hs
View File

@ -44,7 +44,6 @@ import qualified Text.Regex.TDFA as TDFA
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Hasura.EncJSON
@ -149,7 +148,7 @@ data RunSQLRes
{ rrResultType :: !Text
, rrResult :: !Value
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 2 snakeCase) ''RunSQLRes)
$(deriveJSON hasuraJSON ''RunSQLRes)
instance Q.FromRes RunSQLRes where
fromRes (Q.ResultOkEmpty _) =

5
server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs
View File

@ -27,7 +27,6 @@ import qualified Data.HashMap.Strict as M
import qualified Data.HashSet as HS
import qualified Data.List.NonEmpty as NE
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.List.Extended (duplicates)
@ -42,14 +41,14 @@ data FunctionMeta
, fmFunction :: !QualifiedFunction
, fmType :: !FunctionVolatility
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 2 snakeCase) ''FunctionMeta)
$(deriveJSON hasuraJSON ''FunctionMeta)
data ComputedFieldMeta
= ComputedFieldMeta
{ ccmName :: !ComputedFieldName
, ccmFunctionMeta :: !FunctionMeta
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''ComputedFieldMeta)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''ComputedFieldMeta)
data TableMeta (b :: BackendType)
= TableMeta

3
server/src-lib/Hasura/RQL/DDL/Schema/Function.hs
View File

@ -14,7 +14,6 @@ import qualified Database.PG.Query as Q
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
@ -231,7 +230,7 @@ data UnTrackFunction
{ _utfFunction :: !QualifiedFunction
, _utfSource :: !SourceName
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase) ''UnTrackFunction)
$(deriveToJSON hasuraJSON ''UnTrackFunction)
instance FromJSON UnTrackFunction where
parseJSON v = withSource <|> withoutSource

11
server/src-lib/Hasura/RQL/DDL/Schema/Table.hs
View File

@ -37,7 +37,6 @@ import Control.Arrow.Extended
import Control.Lens.Extended hiding ((.=))
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
@ -85,7 +84,7 @@ data SetTableIsEnum
, stieTable :: !QualifiedTable
, stieIsEnum :: !Bool
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase) ''SetTableIsEnum)
$(deriveToJSON hasuraJSON ''SetTableIsEnum)
instance FromJSON SetTableIsEnum where
parseJSON = withObject "Object" $ \o ->
@ -100,7 +99,7 @@ data UntrackTable =
, utTable :: !QualifiedTable
, utCascade :: !Bool
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''UntrackTable)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''UntrackTable)
instance FromJSON UntrackTable where
parseJSON = withObject "Object" $ \o ->
@ -206,7 +205,7 @@ data TrackTableV2
{ ttv2Table :: !TrackTable
, ttv2Configuration :: !TableConfig
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase) ''TrackTableV2)
$(deriveToJSON hasuraJSON ''TrackTableV2)
instance FromJSON TrackTableV2 where
parseJSON = withObject "Object" $ \o -> do
@ -234,7 +233,7 @@ data SetTableCustomization
, _stcTable :: !QualifiedTable
, _stcConfiguration :: !TableConfig
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase) ''SetTableCustomization)
$(deriveToJSON hasuraJSON ''SetTableCustomization)
instance FromJSON SetTableCustomization where
parseJSON = withObject "Object" $ \o ->
@ -250,7 +249,7 @@ data SetTableCustomFields
, _stcfCustomRootFields :: !TableCustomRootFields
, _stcfCustomColumnNames :: !CustomColumnNames
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 5 snakeCase) ''SetTableCustomFields)
$(deriveToJSON hasuraJSON ''SetTableCustomFields)
instance FromJSON SetTableCustomFields where
parseJSON = withObject "SetTableCustomFields" $ \o ->

12
server/src-lib/Hasura/RQL/DML/Types.hs
View File

@ -110,7 +110,7 @@ data SelectG a b c
, sqOffset :: !(Maybe c) -- Offset
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''SelectG)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''SelectG)
selectGToPairs :: (KeyValue kv, ToJSON a, ToJSON b, ToJSON c)
=> SelectG a b c -> [kv]
@ -215,7 +215,7 @@ data OnConflict
, ocAction :: !ConflictAction
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''OnConflict)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''OnConflict)
data InsertQuery
= InsertQuery
@ -226,7 +226,7 @@ data InsertQuery
, iqReturning :: !(Maybe [PGCol])
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''InsertQuery)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''InsertQuery)
instance FromJSON InsertQuery where
parseJSON = withObject "Object" $ \o ->
@ -243,7 +243,7 @@ data InsertTxConflictCtx
, itcConstraint :: !(Maybe ConstraintName)
, itcSetExpression :: !(Maybe Text)
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''InsertTxConflictCtx)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''InsertTxConflictCtx)
type UpdVals = ColumnValues Value
@ -293,7 +293,7 @@ data DeleteQuery
, doReturning :: !(Maybe [PGCol]) -- columns returning
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''DeleteQuery)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''DeleteQuery)
instance FromJSON DeleteQuery where
parseJSON = withObject "Object" $ \o ->
@ -311,7 +311,7 @@ data CountQuery
, cqWhere :: !(Maybe (BoolExp 'Postgres))
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''CountQuery)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''CountQuery)
instance FromJSON CountQuery where
parseJSON = withObject "Object" $ \o ->

9
server/src-lib/Hasura/RQL/IR/BoolExp.hs
View File

@ -46,7 +46,6 @@ import qualified Data.HashMap.Strict as M
import Control.Lens.Plated
import Control.Lens.TH
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.Internal
import Data.Aeson.TH
import Data.Typeable
@ -181,7 +180,7 @@ data DWithinGeomOp a =
instance (NFData a) => NFData (DWithinGeomOp a)
instance (Cacheable a) => Cacheable (DWithinGeomOp a)
instance (Hashable a) => Hashable (DWithinGeomOp a)
$(deriveJSON (aesonDrop 6 snakeCase) ''DWithinGeomOp)
$(deriveJSON hasuraJSON ''DWithinGeomOp)
data DWithinGeogOp a =
DWithinGeogOp
@ -192,7 +191,7 @@ data DWithinGeogOp a =
instance (NFData a) => NFData (DWithinGeogOp a)
instance (Cacheable a) => Cacheable (DWithinGeogOp a)
instance (Hashable a) => Hashable (DWithinGeogOp a)
$(deriveJSON (aesonDrop 6 snakeCase) ''DWithinGeogOp)
$(deriveJSON hasuraJSON ''DWithinGeogOp)
data STIntersectsNbandGeommin a =
STIntersectsNbandGeommin
@ -202,7 +201,7 @@ data STIntersectsNbandGeommin a =
instance (NFData a) => NFData (STIntersectsNbandGeommin a)
instance (Cacheable a) => Cacheable (STIntersectsNbandGeommin a)
instance (Hashable a) => Hashable (STIntersectsNbandGeommin a)
$(deriveJSON (aesonDrop 4 snakeCase) ''STIntersectsNbandGeommin)
$(deriveJSON hasuraJSON ''STIntersectsNbandGeommin)
data STIntersectsGeomminNband a =
STIntersectsGeomminNband
@ -212,7 +211,7 @@ data STIntersectsGeomminNband a =
instance (NFData a) => NFData (STIntersectsGeomminNband a)
instance (Cacheable a) => Cacheable (STIntersectsGeomminNband a)
instance (Hashable a) => Hashable (STIntersectsGeomminNband a)
$(deriveJSON (aesonDrop 4 snakeCase) ''STIntersectsGeomminNband)
$(deriveJSON hasuraJSON ''STIntersectsGeomminNband)
type CastExp b a = M.HashMap (ScalarType b) [OpExpG b a]

9
server/src-lib/Hasura/RQL/IR/OrderBy.hs
View File

@ -8,12 +8,11 @@ module Hasura.RQL.IR.OrderBy
import Hasura.Prelude
import qualified Data.Text as T
import qualified Data.Text as T
import Data.Aeson
import Data.Aeson.Casing
import Hasura.RQL.Instances ()
import Hasura.RQL.Instances ()
import Hasura.RQL.Types.Common
import Hasura.SQL.Backend
@ -73,7 +72,7 @@ instance (Backend b, Hashable a) => Hashable (OrderByItemG b a)
type OrderByItem b = OrderByItemG b OrderByCol
instance (Backend b, FromJSON a) => FromJSON (OrderByItemG b a) where
parseJSON = genericParseJSON (aesonPrefix snakeCase){omitNothingFields=True}
parseJSON = genericParseJSON hasuraJSON{omitNothingFields=True}
instance (Backend b, ToJSON a) => ToJSON (OrderByItemG b a) where
toJSON = genericToJSON (aesonPrefix snakeCase){omitNothingFields=True}
toJSON = genericToJSON hasuraJSON{omitNothingFields=True}

18
server/src-lib/Hasura/RQL/Types/Action.hs
View File

@ -125,7 +125,7 @@ data ArgumentDefinition a
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic)
instance (NFData a) => NFData (ArgumentDefinition a)
instance (Cacheable a) => Cacheable (ArgumentDefinition a)
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ArgumentDefinition)
$(J.deriveJSON hasuraJSON ''ArgumentDefinition)
data ActionType
= ActionQuery
@ -188,7 +188,7 @@ data ActionPermissionInfo
= ActionPermissionInfo
{ _apiRole :: !RoleName
} deriving (Show, Eq)
$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''ActionPermissionInfo)
$(J.deriveToJSON hasuraJSON ''ActionPermissionInfo)
type ActionPermissionMap = Map.HashMap RoleName ActionPermissionInfo
@ -207,7 +207,7 @@ data ActionInfo (b :: BackendType)
, _aiComment :: !(Maybe Text)
} deriving (Generic)
instance J.ToJSON (ActionInfo 'Postgres) where
toJSON = J.genericToJSON $ J.aesonDrop 3 J.snakeCase
toJSON = J.genericToJSON hasuraJSON
$(makeLenses ''ActionInfo)
type ActionDefinitionInput =
@ -221,14 +221,14 @@ data CreateAction
} deriving (Show, Eq, Generic)
instance NFData CreateAction
instance Cacheable CreateAction
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''CreateAction)
$(J.deriveJSON hasuraJSON ''CreateAction)
data UpdateAction
= UpdateAction
{ _uaName :: !ActionName
, _uaDefinition :: !ActionDefinitionInput
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''UpdateAction)
$(J.deriveJSON hasuraJSON ''UpdateAction)
data CreateActionPermission
= CreateActionPermission
@ -239,7 +239,7 @@ data CreateActionPermission
} deriving (Show, Eq, Generic)
instance NFData CreateActionPermission
instance Cacheable CreateActionPermission
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''CreateActionPermission)
$(J.deriveJSON hasuraJSON ''CreateActionPermission)
-- representation of action permission metadata
data ActionPermissionMetadata
@ -251,7 +251,7 @@ instance NFData ActionPermissionMetadata
instance Cacheable ActionPermissionMetadata
$(J.deriveJSON
(J.aesonDrop 4 J.snakeCase){J.omitNothingFields=True}
hasuraJSON{J.omitNothingFields=True}
''ActionPermissionMetadata)
-- representation of action metadata
@ -262,7 +262,7 @@ data ActionMetadata
, _amDefinition :: !ActionDefinitionInput
, _amPermissions :: ![ActionPermissionMetadata]
} deriving (Show, Eq, Generic)
$(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''ActionMetadata)
$(J.deriveToJSON hasuraJSON ''ActionMetadata)
$(makeLenses ''ActionMetadata)
instance NFData ActionMetadata
instance Cacheable ActionMetadata
@ -357,7 +357,7 @@ data ActionLogResponse
, _alrErrors :: !(Maybe J.Value)
, _alrSessionVariables :: !SessionVariables
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionLogResponse)
$(J.deriveJSON hasuraJSON ''ActionLogResponse)
data AsyncActionStatus
= AASCompleted !J.Value

17
server/src-lib/Hasura/RQL/Types/Column.hs
View File

@ -33,11 +33,10 @@ import qualified Language.GraphQL.Draft.Syntax as G
import Control.Lens.TH
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Hasura.Backends.Postgres.SQL.Types hiding (TableName, isNumType, isComparableType)
import Hasura.Backends.Postgres.SQL.Types hiding (TableName, isComparableType, isNumType)
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Instances ()
@ -54,7 +53,7 @@ newtype EnumValueInfo
= EnumValueInfo
{ evComment :: Maybe Text
} deriving (Show, Eq, Ord, NFData, Hashable, Cacheable)
$(deriveJSON (aesonDrop 2 snakeCase) ''EnumValueInfo)
$(deriveJSON hasuraJSON ''EnumValueInfo)
type EnumValues = M.HashMap EnumValue EnumValueInfo
@ -73,10 +72,10 @@ instance (Backend b) => Hashable (EnumReference b)
instance (Backend b) => Cacheable (EnumReference b)
instance Backend b => FromJSON (EnumReference b) where
parseJSON = genericParseJSON $ aesonPrefix snakeCase
parseJSON = genericParseJSON hasuraJSON
instance Backend b => ToJSON (EnumReference b) where
toJSON = genericToJSON $ aesonPrefix snakeCase
toJSON = genericToJSON hasuraJSON
-- | The type we use for columns, which are currently always “scalars” (though
-- see the note about 'CollectableType'). Unlike 'ScalarType', which represents
@ -172,9 +171,9 @@ deriving instance Backend b => Show (RawColumnInfo b)
instance Backend b => NFData (RawColumnInfo b)
instance Backend b => Cacheable (RawColumnInfo b)
instance Backend b => ToJSON (RawColumnInfo b) where
toJSON = genericToJSON $ aesonDrop 4 snakeCase
toJSON = genericToJSON hasuraJSON
instance Backend b => FromJSON (RawColumnInfo b) where
parseJSON = genericParseJSON $ aesonDrop 4 snakeCase
parseJSON = genericParseJSON hasuraJSON
-- | “Resolved” column info, produced from a 'RawColumnInfo' value that has been combined with
-- other schema information to produce a 'PGColumnType'.
@ -193,8 +192,8 @@ instance Backend b => Cacheable (ColumnInfo b)
instance Backend b => NFData (ColumnInfo b)
instance Backend b => Hashable (ColumnInfo b)
instance Backend b => ToJSON (ColumnInfo b) where
toJSON = genericToJSON $ aesonDrop 3 snakeCase
toEncoding = genericToEncoding $ aesonDrop 3 snakeCase
toJSON = genericToJSON hasuraJSON
toEncoding = genericToEncoding hasuraJSON
type PrimaryKeyColumns b = NESeq (ColumnInfo b)

15
server/src-lib/Hasura/RQL/Types/Common.hs
View File

@ -75,7 +75,6 @@ import qualified Test.QuickCheck as QC
import Control.Lens (makeLenses)
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Bifunctor (bimap)
import Data.Kind (Type)
@ -263,10 +262,10 @@ instance Backend b => Cacheable (RelInfo b)
instance Backend b => Hashable (RelInfo b)
instance (Backend b) => FromJSON (RelInfo b) where
parseJSON = genericParseJSON $ aesonPrefix snakeCase
parseJSON = genericParseJSON hasuraJSON
instance (Backend b) => ToJSON (RelInfo b) where
toJSON = genericToJSON $ aesonPrefix snakeCase
toJSON = genericToJSON hasuraJSON
newtype FieldName
@ -351,7 +350,7 @@ data MutateResp a
{ _mrAffectedRows :: !Int
, _mrReturningColumns :: ![ColumnValues a]
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 3 snakeCase) ''MutateResp)
$(deriveJSON hasuraJSON ''MutateResp)
-- | Postgres OIDs. <https://www.postgresql.org/docs/12/datatype-oid.html>
newtype OID = OID { unOID :: Int }
@ -365,7 +364,7 @@ data Constraint
instance NFData Constraint
instance Hashable Constraint
instance Cacheable Constraint
$(deriveJSON (aesonDrop 2 snakeCase) ''Constraint)
$(deriveJSON hasuraJSON ''Constraint)
data PrimaryKey a
= PrimaryKey
@ -375,7 +374,7 @@ data PrimaryKey a
instance (NFData a) => NFData (PrimaryKey a)
instance (Cacheable a) => Cacheable (PrimaryKey a)
$(makeLenses ''PrimaryKey)
$(deriveJSON (aesonDrop 3 snakeCase) ''PrimaryKey)
$(deriveJSON hasuraJSON ''PrimaryKey)
data ForeignKey (b :: BackendType)
= ForeignKey
@ -389,9 +388,9 @@ instance Backend b => NFData (ForeignKey b)
instance Backend b => Hashable (ForeignKey b)
instance Backend b => Cacheable (ForeignKey b)
instance Backend b => ToJSON (ForeignKey b) where
toJSON = genericToJSON $ aesonDrop 3 snakeCase
toJSON = genericToJSON hasuraJSON
instance Backend b => FromJSON (ForeignKey b) where
parseJSON = genericParseJSON $ aesonDrop 3 snakeCase
parseJSON = genericParseJSON hasuraJSON
data InpValInfo
= InpValInfo

4
server/src-lib/Hasura/RQL/Types/ComputedField.hs
View File

@ -43,7 +43,7 @@ data ComputedFieldDefinition
} deriving (Show, Eq, Generic)
instance NFData ComputedFieldDefinition
instance Cacheable ComputedFieldDefinition
$(deriveJSON (aesonDrop 4 snakeCase){omitNothingFields = True} ''ComputedFieldDefinition)
$(deriveJSON hasuraJSON{omitNothingFields = True} ''ComputedFieldDefinition)
-- | The function table argument is either the very first argument or the named
-- argument with an index. The index is 0 if the named argument is the first.
@ -94,7 +94,7 @@ data ComputedFieldFunction
, _cffDescription :: !(Maybe PGDescription)
} deriving (Show, Eq, Generic)
instance Cacheable ComputedFieldFunction
$(deriveToJSON (aesonDrop 4 snakeCase) ''ComputedFieldFunction)
$(deriveToJSON hasuraJSON ''ComputedFieldFunction)
data ComputedFieldInfo (b :: BackendType)
= ComputedFieldInfo

19
server/src-lib/Hasura/RQL/Types/CustomTypes.hs
View File

@ -36,7 +36,6 @@ import Control.Lens.TH (makeLenses)
import Data.Text.Extended
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.TH as J
import qualified Data.HashMap.Strict as Map
import qualified Data.List.NonEmpty as NEList
@ -85,7 +84,7 @@ data InputObjectFieldDefinition
} deriving (Show, Eq, Generic)
instance NFData InputObjectFieldDefinition
instance Cacheable InputObjectFieldDefinition
$(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''InputObjectFieldDefinition)
$(J.deriveJSON hasuraJSON ''InputObjectFieldDefinition)
newtype InputObjectTypeName
= InputObjectTypeName { unInputObjectTypeName :: G.Name }
@ -99,7 +98,7 @@ data InputObjectTypeDefinition
} deriving (Show, Eq, Generic)
instance NFData InputObjectTypeDefinition
instance Cacheable InputObjectTypeDefinition
$(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''InputObjectTypeDefinition)
$(J.deriveJSON hasuraJSON ''InputObjectTypeDefinition)
newtype ObjectFieldName
= ObjectFieldName { unObjectFieldName :: G.Name }
@ -119,7 +118,7 @@ data ObjectFieldDefinition a
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic)
instance (NFData a) => NFData (ObjectFieldDefinition a)
instance (Cacheable a) => Cacheable (ObjectFieldDefinition a)
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectFieldDefinition)
$(J.deriveJSON hasuraJSON ''ObjectFieldDefinition)
newtype RelationshipName
= RelationshipName { unRelationshipName :: G.Name }
@ -136,7 +135,7 @@ data TypeRelationship t f
instance (NFData t, NFData f) => NFData (TypeRelationship t f)
instance (Cacheable t, Cacheable f) => Cacheable (TypeRelationship t f)
$(makeLenses ''TypeRelationship)
$(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''TypeRelationship)
$(J.deriveToJSON hasuraJSON ''TypeRelationship)
instance (J.FromJSON t, J.FromJSON f) => J.FromJSON (TypeRelationship t f) where
parseJSON = J.withObject "Object" $ \o ->
@ -160,7 +159,7 @@ data ObjectTypeDefinition a b c
} deriving (Show, Eq, Generic)
instance (NFData a, NFData b, NFData c) => NFData (ObjectTypeDefinition a b c)
instance (Cacheable a, Cacheable b, Cacheable c) => Cacheable (ObjectTypeDefinition a b c)
$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''ObjectTypeDefinition)
$(J.deriveToJSON hasuraJSON ''ObjectTypeDefinition)
instance (J.FromJSON a, J.FromJSON b, J.FromJSON c) => J.FromJSON (ObjectTypeDefinition a b c) where
parseJSON = J.withObject "ObjectTypeDefinition" \obj -> do
@ -184,7 +183,7 @@ data ScalarTypeDefinition
instance NFData ScalarTypeDefinition
instance Cacheable ScalarTypeDefinition
instance Hashable ScalarTypeDefinition
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ScalarTypeDefinition)
$(J.deriveJSON hasuraJSON ''ScalarTypeDefinition)
-- default scalar names
intScalar, floatScalar, stringScalar, boolScalar, idScalar :: G.Name
@ -211,7 +210,7 @@ data EnumValueDefinition
} deriving (Show, Eq, Generic)
instance NFData EnumValueDefinition
instance Cacheable EnumValueDefinition
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''EnumValueDefinition)
$(J.deriveJSON hasuraJSON ''EnumValueDefinition)
data EnumTypeDefinition
= EnumTypeDefinition
@ -221,7 +220,7 @@ data EnumTypeDefinition
} deriving (Show, Eq, Generic)
instance NFData EnumTypeDefinition
instance Cacheable EnumTypeDefinition
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''EnumTypeDefinition)
$(J.deriveJSON hasuraJSON ''EnumTypeDefinition)
type ObjectType =
ObjectTypeDefinition GraphQLType QualifiedTable PGCol
@ -235,7 +234,7 @@ data CustomTypes
} deriving (Show, Eq, Generic)
instance NFData CustomTypes
instance Cacheable CustomTypes
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''CustomTypes)
$(J.deriveJSON hasuraJSON ''CustomTypes)
emptyCustomTypes :: CustomTypes
emptyCustomTypes = CustomTypes Nothing Nothing Nothing Nothing

21
server/src-lib/Hasura/RQL/Types/EventTrigger.hs
View File

@ -32,7 +32,6 @@ import qualified Database.PG.Query as Q
import qualified Text.Regex.TDFA as TDFA
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Data.Text.NonEmpty
@ -87,7 +86,7 @@ data SubscribeOpSpec
} deriving (Show, Eq, Generic)
instance NFData SubscribeOpSpec
instance Cacheable SubscribeOpSpec
$(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''SubscribeOpSpec)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''SubscribeOpSpec)
defaultNumRetries :: Int
defaultNumRetries = 0
@ -109,7 +108,7 @@ data RetryConf
} deriving (Show, Eq, Generic)
instance NFData RetryConf
instance Cacheable RetryConf
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''RetryConf)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''RetryConf)
data EventHeaderInfo
= EventHeaderInfo
@ -117,7 +116,7 @@ data EventHeaderInfo
, ehiCachedValue :: !Text
} deriving (Show, Eq, Generic)
instance NFData EventHeaderInfo
$(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''EventHeaderInfo)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''EventHeaderInfo)
data WebhookConf = WCValue InputWebhook | WCEnv Text
deriving (Show, Eq, Generic)
@ -142,7 +141,7 @@ data WebhookConfInfo
, wciCachedValue :: !Text
} deriving (Show, Eq, Generic)
instance NFData WebhookConfInfo
$(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''WebhookConfInfo)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''WebhookConfInfo)
data CreateEventTriggerQuery
= CreateEventTriggerQuery
@ -198,7 +197,7 @@ instance FromJSON CreateEventTriggerQuery where
_ -> return ()
parseJSON _ = fail "expecting an object"
$(deriveToJSON (aesonDrop 4 snakeCase){omitNothingFields=True} ''CreateEventTriggerQuery)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''CreateEventTriggerQuery)
-- | The table operations on which the event trigger will be invoked.
data TriggerOpsDef
@ -210,7 +209,7 @@ data TriggerOpsDef
} deriving (Show, Eq, Generic)
instance NFData TriggerOpsDef
instance Cacheable TriggerOpsDef
$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''TriggerOpsDef)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''TriggerOpsDef)
data DeleteEventTriggerQuery
= DeleteEventTriggerQuery
@ -224,7 +223,7 @@ instance FromJSON DeleteEventTriggerQuery where
<$> o .:? "source" .!= defaultSource
<*> o .: "name"
$(deriveToJSON (aesonDrop 4 snakeCase){omitNothingFields=True} ''DeleteEventTriggerQuery)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''DeleteEventTriggerQuery)
data EventTriggerConf
= EventTriggerConf
@ -236,7 +235,7 @@ data EventTriggerConf
, etcHeaders :: !(Maybe [HeaderConf])
} deriving (Show, Eq, Generic)
instance Cacheable EventTriggerConf
$(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''EventTriggerConf)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''EventTriggerConf)
data RedeliverEventQuery
= RedeliverEventQuery
@ -244,7 +243,7 @@ data RedeliverEventQuery
, rdeqSource :: !SourceName
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase){omitNothingFields=True} ''RedeliverEventQuery)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''RedeliverEventQuery)
instance FromJSON RedeliverEventQuery where
parseJSON = withObject "Object" $ \o ->
@ -259,7 +258,7 @@ data InvokeEventTriggerQuery
, ietqPayload :: !Value
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase){omitNothingFields=True} ''InvokeEventTriggerQuery)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''InvokeEventTriggerQuery)
instance FromJSON InvokeEventTriggerQuery where
parseJSON = withObject "Object" $ \o ->

10
server/src-lib/Hasura/RQL/Types/Function.hs
View File

@ -49,7 +49,7 @@ data FunctionArg
, faHasDefault :: !HasDefault
} deriving (Show, Eq, Generic)
instance Cacheable FunctionArg
$(deriveToJSON (aesonDrop 2 snakeCase) ''FunctionArg)
$(deriveToJSON hasuraJSON ''FunctionArg)
data InputArgument a
= IAUserProvided !a
@ -95,7 +95,7 @@ data FunctionInfo
-- returns the composite type corresponding to this table".
, fiDescription :: !(Maybe PGDescription)
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase) ''FunctionInfo)
$(deriveToJSON hasuraJSON ''FunctionInfo)
getInputArgs :: FunctionInfo -> Seq.Seq FunctionArg
getInputArgs =
@ -118,7 +118,7 @@ data FunctionConfig
} deriving (Show, Eq, Generic)
instance NFData FunctionConfig
instance Cacheable FunctionConfig
$(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields = True} ''FunctionConfig)
$(deriveJSON hasuraJSON{omitNothingFields = True} ''FunctionConfig)
-- | The default function config; v1 of the API implies this.
emptyFunctionConfig :: FunctionConfig
@ -134,7 +134,7 @@ data TrackFunctionV2
, _tfv2Function :: !QualifiedFunction
, _tfv2Configuration :: !FunctionConfig
} deriving (Show, Eq, Generic)
$(deriveToJSON (aesonDrop 5 snakeCase) ''TrackFunctionV2)
$(deriveToJSON hasuraJSON ''TrackFunctionV2)
instance FromJSON TrackFunctionV2 where
parseJSON = withObject "Object" $ \o ->
@ -161,6 +161,6 @@ data RawFunctionInfo
} deriving (Show, Eq, Generic)
instance NFData RawFunctionInfo
instance Cacheable RawFunctionInfo
$(deriveJSON (aesonDrop 3 snakeCase) ''RawFunctionInfo)
$(deriveJSON hasuraJSON ''RawFunctionInfo)
type PostgresFunctionsMetadata = HashMap QualifiedFunction [RawFunctionInfo]

22
server/src-lib/Hasura/RQL/Types/Metadata.hs
View File

@ -3,6 +3,7 @@ module Hasura.RQL.Types.Metadata where
import Data.Aeson
import Data.Aeson.Casing
import Data.Text.Extended
import Hasura.Prelude
@ -16,7 +17,6 @@ import qualified Data.Text as T
import qualified Language.GraphQL.Draft.Syntax as G
import Control.Lens hiding (set, (.=))
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Aeson.Types
@ -36,8 +36,8 @@ import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.ScheduledTrigger
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.Table
import Hasura.Session
import Hasura.SQL.Backend
import Hasura.Session
data TableMetadataObjId
@ -207,7 +207,7 @@ data ComputedFieldMetadata
, _cfmComment :: !(Maybe Text)
} deriving (Show, Eq, Generic)
instance Cacheable ComputedFieldMetadata
$(deriveJSON (aesonDrop 4 snakeCase) ''ComputedFieldMetadata)
$(deriveJSON hasuraJSON ''ComputedFieldMetadata)
data RemoteRelationshipMetadata
= RemoteRelationshipMetadata
@ -215,7 +215,7 @@ data RemoteRelationshipMetadata
, _rrmDefinition :: !RemoteRelationshipDef
} deriving (Show, Eq, Generic)
instance Cacheable RemoteRelationshipMetadata
$(deriveJSON (aesonDrop 4 snakeCase) ''RemoteRelationshipMetadata)
$(deriveJSON hasuraJSON ''RemoteRelationshipMetadata)
$(makeLenses ''RemoteRelationshipMetadata)
data RemoteSchemaPermissionMetadata
@ -225,7 +225,7 @@ data RemoteSchemaPermissionMetadata
, _rspmComment :: !(Maybe Text)
} deriving (Show, Eq, Generic)
instance Cacheable RemoteSchemaPermissionMetadata
$(deriveJSON (aesonDrop 5 snakeCase){omitNothingFields=True} ''RemoteSchemaPermissionMetadata)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''RemoteSchemaPermissionMetadata)
$(makeLenses ''RemoteSchemaPermissionMetadata)
data RemoteSchemaMetadata
@ -244,7 +244,7 @@ instance FromJSON RemoteSchemaMetadata where
<*> obj .: "definition"
<*> obj .:? "comment"
<*> obj .:? "permissions" .!= mempty
$(deriveToJSON (aesonDrop 4 snakeCase) ''RemoteSchemaMetadata)
$(deriveToJSON hasuraJSON ''RemoteSchemaMetadata)
$(makeLenses ''RemoteSchemaMetadata)
type Relationships a = InsOrdHashMap RelName a
@ -269,7 +269,7 @@ data TableMetadata
, _tmEventTriggers :: !EventTriggers
} deriving (Show, Eq, Generic)
instance Cacheable TableMetadata
$(deriveToJSON (aesonDrop 3 snakeCase) ''TableMetadata)
$(deriveToJSON hasuraJSON ''TableMetadata)
$(makeLenses ''TableMetadata)
mkTableMeta :: QualifiedTable -> Bool -> TableConfig -> TableMetadata
@ -327,7 +327,7 @@ data FunctionMetadata
} deriving (Show, Eq, Generic)
instance Cacheable FunctionMetadata
$(makeLenses ''FunctionMetadata)
$(deriveToJSON (aesonDrop 3 snakeCase) ''FunctionMetadata)
$(deriveToJSON hasuraJSON ''FunctionMetadata)
instance FromJSON FunctionMetadata where
parseJSON = withObject "Object" $ \o ->
@ -437,7 +437,7 @@ data MetadataNoSources
, _mnsActions :: !Actions
, _mnsCronTriggers :: !CronTriggers
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase) ''MetadataNoSources)
$(deriveToJSON hasuraJSON ''MetadataNoSources)
instance FromJSON MetadataNoSources where
parseJSON = withObject "Object" $ \o -> do
@ -836,7 +836,7 @@ data SetCatalogState
{ _scsType :: !CatalogStateType
, _scsState :: !Value
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 4 snakeCase) ''SetCatalogState)
$(deriveJSON hasuraJSON ''SetCatalogState)
data CatalogState
= CatalogState
@ -844,7 +844,7 @@ data CatalogState
, _csCliState :: !Value
, _csConsoleState :: !Value
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 3 snakeCase) ''CatalogState)
$(deriveToJSON hasuraJSON ''CatalogState)
data GetCatalogState
= GetCatalogState

19
server/src-lib/Hasura/RQL/Types/Permission.hs
View File

@ -8,7 +8,6 @@ import qualified PostgreSQL.Binary.Decoding as PD
import Control.Lens (makeLenses)
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Hashable
@ -78,7 +77,7 @@ instance Show PermId where
, "."
, roleNameToTxt rn
, "."
, T.pack $ show pType
, tshow pType
]
data PermColSpec
@ -102,7 +101,7 @@ data PermDef a =
, _pdComment :: !(Maybe T.Text)
} deriving (Show, Eq, Generic)
instance (Cacheable a) => Cacheable (PermDef a)
$(deriveFromJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''PermDef)
$(deriveFromJSON hasuraJSON{omitNothingFields=True} ''PermDef)
$(makeLenses ''PermDef)
instance (ToJSON a) => ToJSON (PermDef a) where
@ -125,9 +124,9 @@ data InsPerm (b :: BackendType)
} deriving (Show, Eq, Generic)
instance Cacheable (InsPerm 'Postgres)
instance FromJSON (InsPerm 'Postgres) where
parseJSON = genericParseJSON (aesonDrop 2 snakeCase){omitNothingFields=True}
parseJSON = genericParseJSON hasuraJSON{omitNothingFields=True}
instance ToJSON (InsPerm 'Postgres) where
toJSON = genericToJSON (aesonDrop 2 snakeCase){omitNothingFields=True}
toJSON = genericToJSON hasuraJSON{omitNothingFields=True}
type InsPermDef b = PermDef (InsPerm b)
@ -142,7 +141,7 @@ data SelPerm (b :: BackendType)
} deriving (Show, Eq, Generic)
instance Cacheable (SelPerm 'Postgres)
instance ToJSON (SelPerm 'Postgres) where
toJSON = genericToJSON (aesonDrop 2 snakeCase) {omitNothingFields=True}
toJSON = genericToJSON hasuraJSON {omitNothingFields=True}
instance FromJSON (SelPerm 'Postgres) where
parseJSON = withObject "SelPerm" $ \o ->
@ -161,9 +160,9 @@ data DelPerm (b :: BackendType)
deriving (Show, Eq, Generic)
instance Cacheable (DelPerm 'Postgres)
instance FromJSON (DelPerm 'Postgres) where
parseJSON = genericParseJSON $ aesonDrop 2 snakeCase
parseJSON = genericParseJSON hasuraJSON
instance ToJSON (DelPerm 'Postgres) where
toJSON = genericToJSON (aesonDrop 2 snakeCase) {omitNothingFields=True}
toJSON = genericToJSON hasuraJSON {omitNothingFields=True}
type DelPermDef b = PermDef (DelPerm b)
@ -181,8 +180,8 @@ data UpdPerm (b :: BackendType)
} deriving (Show, Eq, Generic)
instance Cacheable (UpdPerm 'Postgres)
instance FromJSON (UpdPerm 'Postgres) where
parseJSON = genericParseJSON (aesonDrop 2 snakeCase){omitNothingFields=True}
parseJSON = genericParseJSON hasuraJSON{omitNothingFields=True}
instance ToJSON (UpdPerm 'Postgres) where
toJSON = genericToJSON (aesonDrop 2 snakeCase){omitNothingFields=True}
toJSON = genericToJSON hasuraJSON{omitNothingFields=True}
type UpdPermDef b = PermDef (UpdPerm b)

15
server/src-lib/Hasura/RQL/Types/QueryCollection.hs
View File

@ -26,7 +26,6 @@ import qualified Language.GraphQL.Draft.Syntax as G
import Control.Lens
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Data.Text.NonEmpty
@ -110,7 +109,7 @@ data ListedQuery
} deriving (Show, Eq, Generic)
instance NFData ListedQuery
instance Cacheable ListedQuery
$(deriveJSON (aesonDrop 3 snakeCase) ''ListedQuery)
$(deriveJSON hasuraJSON ''ListedQuery)
type QueryList = [ListedQuery]
@ -118,7 +117,7 @@ newtype CollectionDef
= CollectionDef
{ _cdQueries :: QueryList }
deriving (Show, Eq, Generic, NFData, Cacheable)
$(deriveJSON (aesonDrop 3 snakeCase) ''CollectionDef)
$(deriveJSON hasuraJSON ''CollectionDef)
$(makeLenses ''CollectionDef)
data CreateCollection
@ -127,7 +126,7 @@ data CreateCollection
, _ccDefinition :: !CollectionDef
, _ccComment :: !(Maybe Text)
} deriving (Show, Eq, Generic)
$(deriveJSON (aesonDrop 3 snakeCase) ''CreateCollection)
$(deriveJSON hasuraJSON ''CreateCollection)
$(makeLenses ''CreateCollection)
data DropCollection
@ -135,7 +134,7 @@ data DropCollection
{ _dcCollection :: !CollectionName
, _dcCascade :: !Bool
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 3 snakeCase) ''DropCollection)
$(deriveJSON hasuraJSON ''DropCollection)
data AddQueryToCollection
= AddQueryToCollection
@ -143,17 +142,17 @@ data AddQueryToCollection
, _aqtcQueryName :: !QueryName
, _aqtcQuery :: !GQLQueryWithText
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 5 snakeCase) ''AddQueryToCollection)
$(deriveJSON hasuraJSON ''AddQueryToCollection)
data DropQueryFromCollection
= DropQueryFromCollection
{ _dqfcCollectionName :: !CollectionName
, _dqfcQueryName :: !QueryName
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 5 snakeCase) ''DropQueryFromCollection)
$(deriveJSON hasuraJSON ''DropQueryFromCollection)
newtype CollectionReq
= CollectionReq
{_crCollection :: CollectionName}
deriving (Show, Eq, Generic, Hashable)
$(deriveJSON (aesonDrop 3 snakeCase) ''CollectionReq)
$(deriveJSON hasuraJSON ''CollectionReq)

11
server/src-lib/Hasura/RQL/Types/Relationship.hs
View File

@ -5,7 +5,6 @@ import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Control.Lens (makeLenses)
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Aeson.Types
import Hasura.RQL.Types.Common
@ -20,7 +19,7 @@ data RelDef a
, _rdComment :: !(Maybe T.Text)
} deriving (Show, Eq, Generic)
instance (Cacheable a) => Cacheable (RelDef a)
$(deriveFromJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''RelDef)
$(deriveFromJSON hasuraJSON{omitNothingFields=True} ''RelDef)
$(makeLenses ''RelDef)
instance (ToJSON a) => ToJSON (RelDef a) where
@ -87,7 +86,7 @@ data ArrRelUsingFKeyOn
} deriving (Show, Eq, Generic)
instance Cacheable ArrRelUsingFKeyOn
$(deriveJSON (aesonDrop 4 snakeCase){omitNothingFields=True} ''ArrRelUsingFKeyOn)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''ArrRelUsingFKeyOn)
type ArrRelUsing = RelUsing ArrRelUsingFKeyOn
type ArrRelDef = RelDef ArrRelUsing
@ -104,7 +103,7 @@ data DropRel
, drRelationship :: !RelName
, drCascade :: !Bool
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''DropRel)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''DropRel)
instance FromJSON DropRel where
parseJSON = withObject "Object" $ \o ->
@ -121,7 +120,7 @@ data SetRelComment
, arRelationship :: !RelName
, arComment :: !(Maybe T.Text)
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''SetRelComment)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''SetRelComment)
instance FromJSON SetRelComment where
parseJSON = withObject "Object" $ \o ->
SetRelComment
@ -137,7 +136,7 @@ data RenameRel
, rrName :: !RelName
, rrNewName :: !RelName
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase) ''RenameRel)
$(deriveToJSON hasuraJSON ''RenameRel)
instance FromJSON RenameRel where
parseJSON = withObject "Object" $ \o ->

7
server/src-lib/Hasura/RQL/Types/RemoteRelationship.hs
View File

@ -27,7 +27,6 @@ import qualified Language.GraphQL.Draft.Syntax as G
import Control.Lens (makeLenses)
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Scientific
import Data.Set (Set)
@ -254,7 +253,7 @@ data RemoteRelationship =
} deriving (Show, Eq, Generic)
instance NFData RemoteRelationship
instance Cacheable RemoteRelationship
$(deriveToJSON (aesonDrop 3 snakeCase) ''RemoteRelationship)
$(deriveToJSON hasuraJSON ''RemoteRelationship)
instance FromJSON RemoteRelationship where
parseJSON = withObject "Object" $ \o ->
@ -273,7 +272,7 @@ data RemoteRelationshipDef
, _rrdRemoteField :: !RemoteFields
} deriving (Show, Eq, Generic)
instance Cacheable RemoteRelationshipDef
$(deriveJSON (aesonDrop 4 snakeCase) ''RemoteRelationshipDef)
$(deriveJSON hasuraJSON ''RemoteRelationshipDef)
$(makeLenses ''RemoteRelationshipDef)
data DeleteRemoteRelationship
@ -289,4 +288,4 @@ instance FromJSON DeleteRemoteRelationship where
<*> o .: "table"
<*> o .: "name"
$(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''DeleteRemoteRelationship)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''DeleteRemoteRelationship)

29
server/src-lib/Hasura/RQL/Types/RemoteSchema.hs
View File

@ -3,25 +3,24 @@ module Hasura.RQL.Types.RemoteSchema where
import Hasura.Prelude
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.TH as J
import qualified Data.Environment as Env
import qualified Data.HashSet as Set
import qualified Data.Text as T
import qualified Text.Builder as TB
import Data.Text.Extended
import Data.Text.NonEmpty
import qualified Database.PG.Query as Q
import qualified Network.URI.Extended as N
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Language.GraphQL.Draft.Printer as G
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Network.URI.Extended as N
import qualified Text.Builder as TB
import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Headers (HeaderConf (..))
import Hasura.GraphQL.Parser.Schema (Variable)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Headers (HeaderConf (..))
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Error
import Hasura.Session
import Hasura.GraphQL.Parser.Schema (Variable)
type UrlFromEnv = Text
@ -50,7 +49,7 @@ instance NFData RemoteSchemaInfo
instance Cacheable RemoteSchemaInfo
instance Hashable RemoteSchemaInfo
$(J.deriveJSON (J.aesonDrop 2 J.snakeCase) ''RemoteSchemaInfo)
$(J.deriveJSON hasuraJSON ''RemoteSchemaInfo)
-- | From the user's API request
data RemoteSchemaDef
@ -63,7 +62,7 @@ data RemoteSchemaDef
} deriving (Show, Eq, Generic)
instance NFData RemoteSchemaDef
instance Cacheable RemoteSchemaDef
$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase){J.omitNothingFields=True} ''RemoteSchemaDef)
$(J.deriveToJSON hasuraJSON{J.omitNothingFields=True} ''RemoteSchemaDef)
instance J.FromJSON RemoteSchemaDef where
parseJSON = J.withObject "Object" $ \o ->
@ -84,14 +83,14 @@ data AddRemoteSchemaQuery
} deriving (Show, Eq, Generic)
instance NFData AddRemoteSchemaQuery
instance Cacheable AddRemoteSchemaQuery
$(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''AddRemoteSchemaQuery)
$(J.deriveJSON hasuraJSON ''AddRemoteSchemaQuery)
newtype RemoteSchemaNameQuery
= RemoteSchemaNameQuery
{ _rsnqName :: RemoteSchemaName
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''RemoteSchemaNameQuery)
$(J.deriveJSON hasuraJSON ''RemoteSchemaNameQuery)
getUrlFromEnv :: (MonadIO m, MonadError QErr m) => Env.Environment -> Text -> m N.URI
getUrlFromEnv env urlFromEnv = do
@ -151,7 +150,7 @@ data AddRemoteSchemaPermissions
} deriving (Show, Eq, Generic)
instance NFData AddRemoteSchemaPermissions
instance Cacheable AddRemoteSchemaPermissions
$(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''AddRemoteSchemaPermissions)
$(J.deriveJSON hasuraJSON ''AddRemoteSchemaPermissions)
data DropRemoteSchemaPermissions
= DropRemoteSchemaPermissions
@ -160,7 +159,7 @@ data DropRemoteSchemaPermissions
} deriving (Show, Eq, Generic)
instance NFData DropRemoteSchemaPermissions
instance Cacheable DropRemoteSchemaPermissions
$(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''DropRemoteSchemaPermissions)
$(J.deriveJSON hasuraJSON ''DropRemoteSchemaPermissions)
-- | See `resolveRemoteVariable` function. This data type is used
-- for validation of the session variable value
@ -185,8 +184,8 @@ instance Cacheable RemoteSchemaVariable
-- may contain a preset with it.
data RemoteSchemaInputValueDefinition
= RemoteSchemaInputValueDefinition
{ _rsitdDefinition :: !G.InputValueDefinition
, _rsitdPresetArgument :: !(Maybe (G.Value RemoteSchemaVariable))
{ _rsitdDefinition :: !G.InputValueDefinition
, _rsitdPresetArgument :: !(Maybe (G.Value RemoteSchemaVariable))
} deriving (Show, Eq, Generic, Ord)
instance Hashable RemoteSchemaInputValueDefinition
instance Cacheable RemoteSchemaInputValueDefinition

18
server/src-lib/Hasura/RQL/Types/ScheduledTrigger.hs
View File

@ -84,7 +84,7 @@ instance FromJSON STRetryConf where
then fail "num_retries cannot be a negative value"
else pure $ STRetryConf numRetries' retryInterval timeout tolerance
$(deriveToJSON (aesonDrop 4 snakeCase){omitNothingFields=True} ''STRetryConf)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''STRetryConf)
defaultSTRetryConf :: STRetryConf
defaultSTRetryConf =
@ -123,7 +123,7 @@ instance FromJSON CronTriggerMetadata where
ctComment <- o .:? "comment"
pure CronTriggerMetadata {..}
$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''CronTriggerMetadata)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''CronTriggerMetadata)
data CreateCronTrigger
= CreateCronTrigger
@ -155,13 +155,13 @@ instance FromJSON CreateCronTrigger where
cctReplace <- o .:? "replace" .!= False
pure CreateCronTrigger {..}
$(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''CreateCronTrigger)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''CreateCronTrigger)
newtype ScheduledTriggerName
= ScheduledTriggerName { unName :: TriggerName }
deriving (Show, Eq)
$(deriveJSON (aesonDrop 2 snakeCase) ''ScheduledTriggerName)
$(deriveJSON hasuraJSON ''ScheduledTriggerName)
formatTime' :: UTCTime -> Text
formatTime'= T.pack . iso8601Show
@ -189,7 +189,7 @@ instance FromJSON CreateScheduledEvent where
<*> o .:? "retry_conf" .!= defaultSTRetryConf
<*> o .:? "comment"
$(deriveToJSON (aesonDrop 3 snakeCase) ''CreateScheduledEvent)
$(deriveToJSON hasuraJSON ''CreateScheduledEvent)
-- | The 'ScheduledEventType' data type is needed to differentiate
-- between a 'CronScheduledEvent' and 'OneOffScheduledEvent' scheduled
@ -218,7 +218,7 @@ data ScheduledEventInvocation
, _seiResponse :: !(Maybe Value)
, _seiCreatedAt :: !UTCTime
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 4 snakeCase) ''ScheduledEventInvocation)
$(deriveJSON hasuraJSON ''ScheduledEventInvocation)
data ScheduledEvent
= SEOneOff
@ -300,7 +300,7 @@ data OneOffScheduledEvent
, _ooseNextRetryAt :: !(Maybe UTCTime)
, _ooseComment :: !(Maybe Text)
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 5 snakeCase) ''OneOffScheduledEvent)
$(deriveJSON hasuraJSON ''OneOffScheduledEvent)
data CronEvent
= CronEvent
@ -313,7 +313,7 @@ data CronEvent
-- ^ it is the time at which the cron event generator created the event
, _ceNextRetryAt :: !(Maybe UTCTime)
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 3 snakeCase) ''CronEvent)
$(deriveJSON hasuraJSON ''CronEvent)
data ScheduledEventPagination
= ScheduledEventPagination
@ -363,7 +363,7 @@ data DeleteScheduledEvent
{ _dseType :: !ScheduledEventType
, _dseEventId :: !ScheduledEventId
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 4 snakeCase) ''DeleteScheduledEvent)
$(deriveJSON hasuraJSON ''DeleteScheduledEvent)
data GetInvocationsBy
= GIBEventId !EventId !ScheduledEventType

5
server/src-lib/Hasura/RQL/Types/SchemaCache.hs
View File

@ -135,7 +135,6 @@ import qualified Data.HashSet as HS
import qualified Language.GraphQL.Draft.Syntax as G
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import System.Cron.Types
@ -236,7 +235,7 @@ data CronTriggerInfo
, ctiComment :: !(Maybe Text)
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 3 snakeCase) ''CronTriggerInfo)
$(deriveToJSON hasuraJSON ''CronTriggerInfo)
newtype SchemaCacheVer
= SchemaCacheVer { unSchemaCacheVer :: Word64 }
@ -276,7 +275,7 @@ data SchemaCache
, scInconsistentObjs :: ![InconsistentMetadata]
, scCronTriggers :: !(M.HashMap TriggerName CronTriggerInfo)
}
$(deriveToJSON (aesonDrop 2 snakeCase) ''SchemaCache)
$(deriveToJSON hasuraJSON ''SchemaCache)
getFuncsOfTable :: QualifiedTable -> FunctionCache -> [FunctionInfo]
getFuncsOfTable qt fc = flip filter allFuncs $ \f -> qt == fiReturnType f

3
server/src-lib/Hasura/RQL/Types/SchemaCache/Build.hs
View File

@ -36,7 +36,6 @@ import Control.Monad.Morph
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Unique
import Data.Aeson (toJSON)
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.List (nub)
import Data.Text.Extended
@ -140,7 +139,7 @@ data CacheInvalidations = CacheInvalidations
-- ^ Force re-establishing connections of the given data sources, even if their configuration has not changed. Set
-- by the @pg_reload_source@ API.
}
$(deriveJSON (aesonDrop 2 snakeCase) ''CacheInvalidations)
$(deriveJSON hasuraJSON ''CacheInvalidations)
instance Semigroup CacheInvalidations where
CacheInvalidations a1 b1 c1 <> CacheInvalidations a2 b2 c2 =

3
server/src-lib/Hasura/RQL/Types/SchemaCacheTypes.hs
View File

@ -5,7 +5,6 @@ import Hasura.Prelude
import qualified Data.Text as T
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Text.Extended
@ -133,5 +132,5 @@ data SchemaDependency
, sdReason :: !DependencyReason
} deriving (Show, Eq, Generic)
$(deriveToJSON (aesonDrop 2 snakeCase) ''SchemaDependency)
$(deriveToJSON hasuraJSON ''SchemaDependency)
instance Hashable SchemaDependency

15
server/src-lib/Hasura/RQL/Types/Source.hs
View File

@ -13,7 +13,6 @@ import qualified Hasura.Tracing as Tracing
import Control.Lens
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
data SourceInfo b
@ -25,7 +24,7 @@ data SourceInfo b
} deriving (Generic)
$(makeLenses ''SourceInfo)
instance ToJSON (SourceInfo 'Postgres) where
toJSON = genericToJSON $ aesonDrop 3 snakeCase
toJSON = genericToJSON hasuraJSON
type SourceCache b = HashMap SourceName (SourceInfo b)
@ -48,7 +47,7 @@ data PostgresPoolSettings
, _ppsRetries :: !Int
} deriving (Show, Eq, Generic)
instance Cacheable PostgresPoolSettings
$(deriveToJSON (aesonDrop 4 snakeCase) ''PostgresPoolSettings)
$(deriveToJSON hasuraJSON ''PostgresPoolSettings)
instance FromJSON PostgresPoolSettings where
parseJSON = withObject "Object" $ \o ->
@ -71,7 +70,7 @@ data PostgresSourceConnInfo
, _psciPoolSettings :: !PostgresPoolSettings
} deriving (Show, Eq, Generic)
instance Cacheable PostgresSourceConnInfo
$(deriveToJSON (aesonDrop 5 snakeCase) ''PostgresSourceConnInfo)
$(deriveToJSON hasuraJSON ''PostgresSourceConnInfo)
instance FromJSON PostgresSourceConnInfo where
parseJSON = withObject "Object" $ \o ->
@ -85,7 +84,7 @@ data SourceConfiguration
, _scReadReplicas :: !(Maybe (NonEmpty PostgresSourceConnInfo))
} deriving (Show, Eq, Generic)
instance Cacheable SourceConfiguration
$(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields = True} ''SourceConfiguration)
$(deriveJSON hasuraJSON{omitNothingFields = True} ''SourceConfiguration)
type SourceResolver =
SourceName -> SourceConfiguration -> IO (Either QErr (SourceConfig 'Postgres))
@ -111,14 +110,14 @@ data AddPgSource
{ _apsName :: !SourceName
, _apsConfiguration :: !SourceConfiguration
} deriving (Show, Eq)
$(deriveJSON (aesonDrop 4 snakeCase) ''AddPgSource)
$(deriveJSON hasuraJSON ''AddPgSource)
data DropPgSource
= DropPgSource
{ _dpsName :: !SourceName
, _dpsCascade :: !Bool
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase) ''DropPgSource)
$(deriveToJSON hasuraJSON ''DropPgSource)
instance FromJSON DropPgSource where
parseJSON = withObject "Object" $ \o ->
@ -127,4 +126,4 @@ instance FromJSON DropPgSource where
newtype PostgresSourceName =
PostgresSourceName {_psnName :: SourceName}
deriving (Show, Eq)
$(deriveJSON (aesonDrop 4 snakeCase) ''PostgresSourceName)
$(deriveJSON hasuraJSON ''PostgresSourceName)

26
server/src-lib/Hasura/RQL/Types/Table.hs
View File

@ -130,7 +130,7 @@ data TableCustomRootFields
} deriving (Show, Eq, Generic)
instance NFData TableCustomRootFields
instance Cacheable TableCustomRootFields
$(deriveToJSON (aesonDrop 5 snakeCase){omitNothingFields=True} ''TableCustomRootFields)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''TableCustomRootFields)
instance FromJSON TableCustomRootFields where
parseJSON = withObject "Object" $ \obj -> do
@ -244,7 +244,7 @@ instance NFData (InsPermInfo 'Postgres)
deriving instance Eq (InsPermInfo 'Postgres)
instance Cacheable (InsPermInfo 'Postgres)
instance ToJSON (InsPermInfo 'Postgres) where
toJSON = genericToJSON $ aesonDrop 3 snakeCase
toJSON = genericToJSON hasuraJSON
data SelPermInfo (b :: BackendType)
= SelPermInfo
@ -259,7 +259,7 @@ instance NFData (SelPermInfo 'Postgres)
deriving instance Eq (SelPermInfo 'Postgres)
instance Cacheable (SelPermInfo 'Postgres)
instance ToJSON (SelPermInfo 'Postgres) where
toJSON = genericToJSON $ aesonDrop 3 snakeCase
toJSON = genericToJSON hasuraJSON
data UpdPermInfo (b :: BackendType)
= UpdPermInfo
@ -274,7 +274,7 @@ instance NFData (UpdPermInfo 'Postgres)
deriving instance Eq (UpdPermInfo 'Postgres)
instance Cacheable (UpdPermInfo 'Postgres)
instance ToJSON (UpdPermInfo 'Postgres) where
toJSON = genericToJSON $ aesonDrop 3 snakeCase
toJSON = genericToJSON hasuraJSON
data DelPermInfo (b :: BackendType)
= DelPermInfo
@ -286,7 +286,7 @@ instance NFData (DelPermInfo 'Postgres)
deriving instance Eq (DelPermInfo 'Postgres)
instance Cacheable (DelPermInfo 'Postgres)
instance ToJSON (DelPermInfo 'Postgres) where
toJSON = genericToJSON $ aesonDrop 3 snakeCase
toJSON = genericToJSON hasuraJSON
mkRolePermInfo :: RolePermInfo backend
mkRolePermInfo = RolePermInfo Nothing Nothing Nothing Nothing
@ -300,7 +300,7 @@ data RolePermInfo (b :: BackendType)
} deriving (Generic)
instance NFData (RolePermInfo 'Postgres)
instance ToJSON (RolePermInfo 'Postgres) where
toJSON = genericToJSON $ aesonDrop 5 snakeCase
toJSON = genericToJSON hasuraJSON
makeLenses ''RolePermInfo
@ -321,7 +321,7 @@ data EventTriggerInfo
-- headers added.
} deriving (Show, Eq, Generic)
instance NFData EventTriggerInfo
$(deriveToJSON (aesonDrop 3 snakeCase) ''EventTriggerInfo)
$(deriveToJSON hasuraJSON ''EventTriggerInfo)
type EventTriggerInfoMap = M.HashMap TriggerName EventTriggerInfo
@ -370,7 +370,7 @@ type EventTriggerInfoMap = M.HashMap TriggerName EventTriggerInfo
-- , tcName :: !ConstraintName
-- } deriving (Show, Eq)
-- $(deriveJSON (aesonDrop 2 snakeCase) ''TableConstraint)
-- $(deriveJSON hasuraJSON ''TableConstraint)
data ViewInfo
= ViewInfo
@ -380,7 +380,7 @@ data ViewInfo
} deriving (Show, Eq, Generic)
instance NFData ViewInfo
instance Cacheable ViewInfo
$(deriveJSON (aesonDrop 2 snakeCase) ''ViewInfo)
$(deriveJSON hasuraJSON ''ViewInfo)
isMutable :: (ViewInfo -> Bool) -> Maybe ViewInfo -> Bool
isMutable _ Nothing = True
@ -401,7 +401,7 @@ data TableConfig
} deriving (Show, Eq, Generic)
instance NFData TableConfig
instance Cacheable TableConfig
$(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''TableConfig)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''TableConfig)
$(makeLenses ''TableConfig)
emptyTableConfig :: TableConfig
@ -434,7 +434,7 @@ data TableCoreInfoG (b :: BackendType) field primaryKeyColumn
deriving instance (Eq field, Eq pkCol, Backend b) => Eq (TableCoreInfoG b field pkCol)
instance (Cacheable field, Cacheable pkCol, Backend b) => Cacheable (TableCoreInfoG b field pkCol)
instance (Backend b, ToJSON field, ToJSON pkCol) => ToJSON (TableCoreInfoG b field pkCol) where
toJSON = genericToJSON $ aesonDrop 4 snakeCase
toJSON = genericToJSON hasuraJSON
$(makeLenses ''TableCoreInfoG)
-- | Fully-processed table info that includes non-column fields.
@ -452,7 +452,7 @@ data TableInfo (b :: BackendType)
, _tiEventTriggerInfoMap :: !EventTriggerInfoMap
} deriving (Generic)
instance ToJSON (TableInfo 'Postgres) where
toJSON = genericToJSON $ aesonDrop 3 snakeCase
toJSON = genericToJSON hasuraJSON
$(makeLenses ''TableInfo)
type TableCoreCache b = M.HashMap (TableName b) (TableCoreInfo b)
@ -499,7 +499,7 @@ deriving instance Backend b => Show (DBTableMetadata b)
instance Backend b => NFData (DBTableMetadata b)
instance Backend b => Cacheable (DBTableMetadata b)
instance Backend b => FromJSON (DBTableMetadata b) where
parseJSON = genericParseJSON $ aesonDrop 5 snakeCase
parseJSON = genericParseJSON hasuraJSON
type DBTablesMetadata b = HashMap (TableName b) (DBTableMetadata b)

4
server/src-lib/Hasura/SQL/GeoJSON.hs
View File

@ -181,8 +181,8 @@ data CRS
| CRSLink !CRSLinkProps
deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 4 J.camelCase) ''CRSNameProps)
$(J.deriveJSON (J.aesonDrop 4 J.camelCase) ''CRSLinkProps)
$(J.deriveJSON (J.aesonPrefix J.camelCase) ''CRSNameProps)
$(J.deriveJSON (J.aesonPrefix J.camelCase) ''CRSLinkProps)
$(J.deriveJSON
J.defaultOptions { J.constructorTagModifier = J.camelCase . drop 3
, J.sumEncoding = J.TaggedObject "type" "properties"

11
server/src-lib/Hasura/Server/API/Config.hs
View File

@ -5,15 +5,16 @@ module Hasura.Server.API.Config
, runGetConfig
) where
import Data.Aeson.Casing
import Hasura.Prelude
import Data.Aeson.TH
import Hasura.Prelude
import qualified Hasura.GraphQL.Execute.LiveQuery.Options as LQ
import Hasura.Server.Auth
import Hasura.Server.Auth.JWT
import Hasura.Server.Version (HasVersion, Version, currentVersion)
import qualified Hasura.GraphQL.Execute.LiveQuery.Options as LQ
data JWTInfo
= JWTInfo
@ -22,7 +23,7 @@ data JWTInfo
, jwtiClaimsMap :: !(Maybe JWTCustomClaimsMap)
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase) ''JWTInfo)
$(deriveToJSON hasuraJSON ''JWTInfo)
data ServerConfig
= ServerConfig
@ -36,7 +37,7 @@ data ServerConfig
, scfgConsoleAssetsDir :: !(Maybe Text)
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 4 snakeCase) ''ServerConfig)
$(deriveToJSON hasuraJSON ''ServerConfig)
runGetConfig :: HasVersion => AuthMode -> Bool -> LQ.LiveQueriesOptions -> Maybe Text -> ServerConfig
runGetConfig am isAllowListEnabled liveQueryOpts consoleAssetsDir = ServerConfig

3
server/src-lib/Hasura/Server/API/PGDump.hs
View File

@ -6,7 +6,6 @@ module Hasura.Server.API.PGDump
import Control.Exception (IOException, try)
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Char (isSpace)
import Data.Text.Conversions
@ -29,7 +28,7 @@ data PGDumpReqBody =
, prbCleanOutput :: !Bool
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 3 snakeCase) ''PGDumpReqBody)
$(deriveToJSON hasuraJSON ''PGDumpReqBody)
instance FromJSON PGDumpReqBody where
parseJSON = withObject "Object" $ \o ->

22
server/src-lib/Hasura/Server/Auth/JWT.hs
View File

@ -49,7 +49,8 @@ import Hasura.Prelude
import Hasura.RQL.Types
import Hasura.Server.Auth.JWT.Internal (parseHmacKey, parseRsaKey)
import Hasura.Server.Auth.JWT.Logging
import Hasura.Server.Utils (executeJSONPath, getRequestHeader, userRoleHeader, isSessionVariable)
import Hasura.Server.Utils (executeJSONPath, getRequestHeader,
isSessionVariable, userRoleHeader)
import Hasura.Server.Version (HasVersion)
import Hasura.Session
import qualified Hasura.Tracing as Tracing
@ -153,7 +154,8 @@ instance J.FromJSON JWTCustomClaimsMap where
let withNotFoundError sessionVariable =
let errorMsg = T.unpack $
sessionVariableToText sessionVariable <> " is expected but not found"
in onNothing (Map.lookup (sessionVariableToText sessionVariable) obj) (fail errorMsg)
in Map.lookup (sessionVariableToText sessionVariable) obj
`onNothing` fail errorMsg
allowedRoles <- withNotFoundError allowedRolesClaim >>= J.parseJSON
defaultRole <- withNotFoundError defaultRoleClaim >>= J.parseJSON
@ -212,7 +214,7 @@ data HasuraClaims
{ _cmAllowedRoles :: ![RoleName]
, _cmDefaultRole :: !RoleName
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''HasuraClaims)
$(J.deriveJSON hasuraJSON ''HasuraClaims)
-- | An action that refreshes the JWK at intervals in an infinite loop.
jwkRefreshCtrl
@ -314,7 +316,7 @@ updateJwkRef (Logger logger) manager url jwkRef = do
getHttpExceptionMsg = \case
HTTP.HttpExceptionRequest _ reason -> show reason
HTTP.InvalidUrlException _ reason -> show reason
HTTP.InvalidUrlException _ reason -> show reason
type ClaimsMap = Map.HashMap SessionVariable J.Value
@ -431,10 +433,9 @@ parseClaimsMap
parseClaimsMap unregisteredClaims jcxClaims =
case jcxClaims of
JCNamespace namespace claimsFormat -> do
claimsV <- flip onNothing (claimsNotFound namespace) $
case namespace of
ClaimNs k -> Map.lookup k unregisteredClaims
ClaimNsPath path -> iResultToMaybe $ executeJSONPath path (J.toJSON unregisteredClaims)
claimsV <- flip onNothing (claimsNotFound namespace) $ case namespace of
ClaimNs k -> Map.lookup k unregisteredClaims
ClaimNsPath path -> iResultToMaybe $ executeJSONPath path (J.toJSON unregisteredClaims)
-- get hasura claims value as an object. parse from string possibly
claimsObject <- parseObjectFromString namespace claimsFormat claimsV
@ -464,8 +465,9 @@ parseClaimsMap unregisteredClaims jcxClaims =
<> sessionVariableToText k <> " not found"
case claimObj of
JWTCustomClaimsMapJSONPath path defaultVal ->
onNothing (iResultToMaybe $ executeJSONPath path claimsObjValue) $
(onNothing (J.String <$> defaultVal) throwClaimErr)
iResultToMaybe (executeJSONPath path claimsObjValue)
`onNothing` (J.String <$> defaultVal)
`onNothing` throwClaimErr
JWTCustomClaimsMapStatic claimStaticValue -> pure $ J.String claimStaticValue
pure $ Map.fromList [

22
server/src-lib/Hasura/Server/CheckUpdates.hs
View File

@ -2,9 +2,7 @@ module Hasura.Server.CheckUpdates
( checkForUpdates
) where
import Control.Exception (try)
import Control.Lens
import Data.Text.Conversions (toText)
import Hasura.Prelude
import qualified CI
import qualified Control.Concurrent.Extended as C
@ -17,10 +15,14 @@ import qualified Network.URI.Encode as URI
import qualified Network.Wreq as Wreq
import qualified System.Log.FastLogger as FL
import Control.Exception (try)
import Control.Lens
import Data.Either (fromRight)
import Data.Text.Conversions (toText)
import Hasura.HTTP
import Hasura.Logging (LoggerCtx (..))
import Hasura.Prelude
import Hasura.Server.Version (HasVersion, Version, currentVersion)
import Hasura.Logging (LoggerCtx (..))
import Hasura.Server.Version (HasVersion, Version, currentVersion)
newtype UpdateInfo
@ -28,6 +30,8 @@ newtype UpdateInfo
{ _uiLatest :: Version
} deriving (Show)
-- note that this is erroneous and should drop three characters or use
-- aesonPrefix, but needs to remain like this for backwards compatibility
$(A.deriveJSON (A.aesonDrop 2 A.snakeCase) ''UpdateInfo)
checkForUpdates :: HasVersion => LoggerCtx a -> H.Manager -> IO void
@ -53,12 +57,10 @@ checkForUpdates (LoggerCtx loggerSet _ _ _) manager = do
ciM <- CI.getCI
return . buildUrl $ case ciM of
Nothing -> "server"
Just ci -> "server-" <> (T.toLower . T.pack $ show ci)
Just ci -> "server-" <> T.toLower (tshow ci)
-- ignoring if there is any error in response and returning the current version
decodeResp bs = case A.eitherDecode bs of
Left _ -> return $ UpdateInfo currentVersion
Right a -> return a
decodeResp = pure . fromRight (UpdateInfo currentVersion) . A.eitherDecode
ignoreHttpErr :: H.HttpException -> IO ()
ignoreHttpErr _ = return ()

21
server/src-lib/Hasura/Server/Cors.hs
View File

@ -14,18 +14,19 @@ module Hasura.Server.Cors
) where
import Hasura.Prelude
import Hasura.Server.Utils (fmapL)
import Control.Applicative (optional)
import Data.Aeson ((.:))
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.TH as J
import qualified Data.Attoparsec.Text as AT
import qualified Data.HashSet as Set
import qualified Data.Text as T
import Control.Applicative (optional)
import Data.Aeson ((.:))
import Hasura.Server.Utils (fmapL)
data DomainParts =
DomainParts
{ wdScheme :: !Text
@ -33,7 +34,7 @@ data DomainParts =
, wdPort :: !(Maybe Int)
} deriving (Show, Eq, Generic, Hashable)
$(J.deriveJSON (J.aesonDrop 2 J.snakeCase) ''DomainParts)
$(J.deriveJSON hasuraJSON ''DomainParts)
data Domains
= Domains
@ -41,7 +42,7 @@ data Domains
, dmWildcards :: !(Set.HashSet DomainParts)
} deriving (Show, Eq)
$(J.deriveJSON (J.aesonDrop 2 J.snakeCase) ''Domains)
$(J.deriveJSON hasuraJSON ''Domains)
data CorsConfig
= CCAllowAll
@ -65,7 +66,7 @@ instance J.ToJSON CorsConfig where
instance J.FromJSON CorsConfig where
parseJSON = J.withObject "cors config" \o -> do
let parseAllowAll "*" = pure CCAllowAll
parseAllowAll _ = fail "unexpected string"
parseAllowAll _ = fail "unexpected string"
o .: "disabled" >>= \case
True -> CCDisabled <$> o .: "ws_read_cookie"
False -> o .: "allowed_origins" >>= \v ->
@ -75,7 +76,7 @@ instance J.FromJSON CorsConfig where
isCorsDisabled :: CorsConfig -> Bool
isCorsDisabled = \case
CCDisabled _ -> True
_ -> False
_ -> False
readCorsDomains :: String -> Either String CorsConfig
readCorsDomains str
@ -142,7 +143,7 @@ parseOptWildcardDomain d =
fqdnParser :: AT.Parser Text
fqdnParser = do
(DomainParts scheme host port) <- domainParser Nothing
let sPort = maybe "" (\p -> ":" <> T.pack (show p)) port
let sPort = maybe "" (\p -> ":" <> tshow p) port
return $ scheme <> host <> sPort

3
server/src-lib/Hasura/Server/Init.hs
View File

@ -7,7 +7,6 @@ module Hasura.Server.Init
) where
import qualified Data.Aeson as J
import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.TH as J
import qualified Data.HashSet as Set
import qualified Data.String as DataString
@ -59,7 +58,7 @@ data StartupTimeInfo
{ _stiMessage :: !Text
, _stiTimeTaken :: !Double
}
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''StartupTimeInfo)
$(J.deriveJSON hasuraJSON ''StartupTimeInfo)
returnJust :: Monad m => a -> m (Maybe a)
returnJust = return . Just

2
server/src-lib/Hasura/Server/Init/Config.hs
View File

@ -189,7 +189,7 @@ $(J.deriveJSON (J.defaultOptions { J.constructorTagModifier = map toLower })
instance Hashable API
$(J.deriveJSON (J.aesonDrop 4 J.camelCase){J.omitNothingFields=True} ''PostgresRawConnDetails)
$(J.deriveJSON (J.aesonPrefix J.camelCase){J.omitNothingFields=True} ''PostgresRawConnDetails)
type HGECommand impl = HGECommandG (ServeOptions impl)
type RawHGECommand impl = HGECommandG (RawServeOptions impl)

5
server/src-lib/Hasura/Server/Logging.hs
View File

@ -22,7 +22,6 @@ import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai.Extended as Wai
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Int (Int64)
@ -197,7 +196,7 @@ data OperationLog
, olError :: !(Maybe QErr)
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 2 snakeCase){omitNothingFields = True} ''OperationLog)
$(deriveToJSON hasuraJSON{omitNothingFields = True} ''OperationLog)
data HttpLogContext
= HttpLogContext
@ -205,7 +204,7 @@ data HttpLogContext
, hlcOperation :: !OperationLog
, hlcRequestId :: !RequestId
} deriving (Show, Eq)
$(deriveToJSON (aesonDrop 3 snakeCase) ''HttpLogContext)
$(deriveToJSON hasuraJSON ''HttpLogContext)
mkHttpAccessLogContext
:: Maybe UserInfo

2
server/src-lib/Hasura/Server/SchemaUpdate.hs
View File

@ -73,7 +73,7 @@ data EventPayload
, _epOccurredAt :: !UTC.UTCTime
, _epInvalidations :: !CacheInvalidations
}
$(deriveJSON (aesonDrop 3 snakeCase) ''EventPayload)
$(deriveJSON hasuraJSON ''EventPayload)
data SchemaSyncEvent
= SSEListenStart !UTC.UTCTime

13
server/src-lib/Hasura/Server/Telemetry.hs
View File

@ -26,7 +26,6 @@ import Hasura.Session
import qualified CI
import qualified Control.Concurrent.Extended as C
import qualified Data.Aeson as A
import qualified Data.Aeson.Casing as A
import qualified Data.Aeson.TH as A
import qualified Data.ByteString.Lazy as BL
import qualified Data.HashMap.Strict as Map
@ -41,7 +40,7 @@ data RelationshipMetric
{ _rmManual :: !Int
, _rmAuto :: !Int
} deriving (Show, Eq)
$(A.deriveToJSON (A.aesonDrop 3 A.snakeCase) ''RelationshipMetric)
$(A.deriveToJSON hasuraJSON ''RelationshipMetric)
data PermissionMetric
= PermissionMetric
@ -51,7 +50,7 @@ data PermissionMetric
, _pmDelete :: !Int
, _pmRoles :: !Int
} deriving (Show, Eq)
$(A.deriveToJSON (A.aesonDrop 3 A.snakeCase) ''PermissionMetric)
$(A.deriveToJSON hasuraJSON ''PermissionMetric)
data ActionMetric
= ActionMetric
@ -61,7 +60,7 @@ data ActionMetric
, _amTypeRelationships :: !Int
, _amCustomTypes :: !Int
} deriving (Show, Eq)
$(A.deriveToJSON (A.aesonDrop 3 A.snakeCase) ''ActionMetric)
$(A.deriveToJSON hasuraJSON ''ActionMetric)
data Metrics
= Metrics
@ -77,7 +76,7 @@ data Metrics
, _mtPgVersion :: !PGVersion
, _mtActions :: !ActionMetric
} deriving (Show, Eq)
$(A.deriveToJSON (A.aesonDrop 3 A.snakeCase) ''Metrics)
$(A.deriveToJSON hasuraJSON ''Metrics)
data HasuraTelemetry
= HasuraTelemetry
@ -87,14 +86,14 @@ data HasuraTelemetry
, _htCi :: !(Maybe CI.CI)
, _htMetrics :: !Metrics
} deriving (Show)
$(A.deriveToJSON (A.aesonDrop 3 A.snakeCase) ''HasuraTelemetry)
$(A.deriveToJSON hasuraJSON ''HasuraTelemetry)
data TelemetryPayload
= TelemetryPayload
{ _tpTopic :: !Text
, _tpData :: !HasuraTelemetry
} deriving (Show)
$(A.deriveToJSON (A.aesonDrop 3 A.snakeCase) ''TelemetryPayload)
$(A.deriveToJSON hasuraJSON ''TelemetryPayload)
telemetryUrl :: Text
telemetryUrl = "https://telemetry.hasura.io/v1/http"

11
server/src-lib/Hasura/Server/Telemetry/Counters.hs
View File

@ -22,15 +22,16 @@ module Hasura.Server.Telemetry.Counters
)
where
import Hasura.Prelude
import qualified Data.Aeson as A
import qualified Data.Aeson.Casing as A
import qualified Data.Aeson.TH as A
import Data.Hashable
import qualified Data.HashMap.Strict as HM
import Data.IORef
import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
import GHC.IO.Unsafe (unsafePerformIO)
import Hasura.Prelude
-- | The properties that characterize this request. The dimensions over which
-- we collect metrics for each serviced request.
@ -176,8 +177,8 @@ data ServiceTimingMetric
deriving (Show, Generic, Eq)
$(A.deriveJSON (A.aesonDrop 5 A.snakeCase) ''RequestTimingsCount)
$(A.deriveJSON (A.aesonDrop 5 A.snakeCase) ''RequestDimensions)
$(A.deriveJSON hasuraJSON ''RequestTimingsCount)
$(A.deriveJSON hasuraJSON ''RequestDimensions)
instance A.ToJSON ServiceTimingMetric
instance A.FromJSON ServiceTimingMetric