Extract Network and Net into hasura-extras

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8855
Co-authored-by: Daniel Harvey <4729125+danieljharvey@users.noreply.github.com>
GitOrigin-RevId: 5bde8ff821739c37a2e4435b57a5a623bc66de42
This commit is contained in:
Tom Harding 2023-04-24 12:11:43 +01:00 committed by hasura-bot
parent 6ed9f36125
commit eac27bbf13
31 changed files with 96 additions and 66 deletions

View File

@ -811,7 +811,6 @@ library
, Hasura.RQL.Types.Metadata.Instances
, Hasura.RQL.Types.Metadata.Object
, Hasura.RQL.Types.Metadata.Serialization
, Hasura.RQL.Types.Network
, Hasura.RQL.Types.OpenTelemetry
, Hasura.RQL.Types.Permission
, Hasura.RQL.Types.QueryCollection
@ -1006,20 +1005,6 @@ library
, Hasura.SQL.WKT
, Hasura.QueryTags
, Hasura.QueryTags.Types
, Network.HTTP.Client.Transformable
, Network.HTTP.Client.DynamicTlsPermissions
, Network.HTTP.Client.Restricted
, Network.HTTP.Client.Blocklisting
, Network.HTTP.Client.CreateManager
, Network.URI.Extended
, Network.Wai.Extended
, Network.Wai.Handler.WebSockets.Custom
-- Our vendored bits of the 'ip' package, to avoid dependencies and ease 9.2 migration
-- We might see if maintainer is willing to split their package up so we can remove these:
, Net.IPv4
, Net.IPv6
executable graphql-engine
import: common-all, common-exe

View File

@ -43,16 +43,33 @@ library
, autodocodec
, base
, base64-bytestring
, byteorder
, bytestring
, case-insensitive
, connection
, containers
, data-default
, data-default-class
, deepseq
, exceptions
, graphql-parser
, hashable
, hasura-prelude
, http-client
, http-client-tls
, http-conduit
, http-types
, insert-ordered-containers
, kriti-lang
, lens
, mtl
, network
, network-bsd
, network-uri
, odbc
, pg-client
, refined
, safe-exceptions
, pg-client
, refined
, scientific
@ -62,11 +79,21 @@ library
, text-builder
, text-conversions
, time
, tls
, unordered-containers
, uri-encode
, wai
, websockets
, wide-word
, witherable
, x509
, x509-store
, x509-system
, x509-validation
default-extensions:
BlockArguments
DerivingStrategies
FunctionalDependencies
ImportQualifiedPost
@ -74,6 +101,7 @@ library
NoImplicitPrelude
QuasiQuotes
OverloadedStrings
RecordWildCards
TypeFamilies
exposed-modules:
@ -95,3 +123,17 @@ library
Data.Text.NonEmpty
Data.Trie
Data.URL.Template
Network.HTTP.Client.Blocklisting
Network.HTTP.Client.CreateManager
Network.HTTP.Client.DynamicTlsPermissions
Network.HTTP.Client.Restricted
Network.HTTP.Client.Transformable
Network.Types.Extended
Network.URI.Extended
Network.Wai.Extended
Network.Wai.Handler.WebSockets.Custom
-- Our vendored bits of the 'ip' package, to avoid dependencies and ease 9.2 migration
-- We might see if maintainer is willing to split their package up so we can remove these:
Net.IPv4
Net.IPv6

View File

@ -3,6 +3,7 @@
module Autodocodec.Extended
( baseUrlCodec,
boundedEnumCodec,
caseInsensitiveHashMapCodec,
caseInsensitiveTextCodec,
graphQLEnumValueCodec,
@ -40,6 +41,7 @@ import Data.CaseInsensitive qualified as CI
import Data.Char (isAlphaNum)
import Data.HashMap.Strict qualified as M
import Data.HashSet qualified as HashSet
import Data.List.NonEmpty qualified as NE
import Data.Maybe (fromJust)
import Data.Scientific (Scientific (base10Exponent), floatingOrInteger)
import Data.Scientific qualified as Scientific
@ -345,3 +347,26 @@ disjointMatchChoicesNECodec l = go l
disjointMatchChoiceCodec c (go l') $ \i -> case m i of
Just j -> Left j
Nothing -> Right i
-- | A codec for a 'Bounded' 'Enum' that maps to literal strings using
-- a provided function.
--
--
-- === Example usage
--
-- >>> data Fruit = FruitApple | FruitOrange deriving (Show, Eq, Enum, Bounded)
-- >>> let c = boundedEnumCodec (snakeCase . drop 5)
-- >>> toJSONVia c Apple
-- String "apple"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "orange") :: Maybe Fruit
-- Just Orange
boundedEnumCodec ::
forall enum.
(Eq enum, Enum enum, Bounded enum) =>
(enum -> String) ->
JSONCodec enum
boundedEnumCodec display =
let ls = [minBound .. maxBound]
in case NE.nonEmpty ls of
Nothing -> error "0 enum values ?!"
Just ne -> stringConstCodec (NE.map (\v -> (v, T.pack (display v))) ne)

View File

@ -4,11 +4,11 @@ module Network.HTTP.Client.CreateManager
where
import Hasura.Prelude
import Hasura.RQL.Types.Network (TlsAllow)
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Client.Blocklisting (Blocklist, block)
import Network.HTTP.Client.DynamicTlsPermissions qualified as HTTP
import Network.HTTP.Client.Restricted qualified as Restricted
import Network.Types.Extended (TlsAllow)
-- | This mkHttpManager function takes a mechanism for finding the current allowlist,
-- | Thus allowing it to be coupled from any ref type such as AppStateRef.

View File

@ -11,10 +11,10 @@ import Data.X509.CertificateStore qualified as HTTP
import Data.X509.Validation qualified as HTTP
import GHC.Exception (Exception (displayException))
import Hasura.Prelude
import Hasura.RQL.Types.Network (TlsAllow (TlsAllow), TlsPermission (SelfSigned))
import Network.Connection qualified as HTTP
import Network.TLS qualified as HTTP
import Network.TLS.Extra qualified as TLS
import Network.Types.Extended (TlsAllow (TlsAllow), TlsPermission (SelfSigned))
import System.X509 qualified as HTTP
newtype TlsServiceDefinitionError = TlsServiceDefinitionError

View File

@ -1,4 +1,4 @@
module Hasura.RQL.Types.Network
module Network.Types.Extended
( AddHostToTLSAllowlist,
DropHostFromTLSAllowlist (..),
Network (..),
@ -10,9 +10,9 @@ where
import Autodocodec (HasCodec, optionalField', optionalFieldWithDefault', requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (boundedEnumCodec)
import Data.Aeson as A
import Data.Text qualified as T
import Hasura.Metadata.DTO.Utils (boundedEnumCodec)
import Hasura.Prelude
data Network = Network
@ -24,7 +24,8 @@ instance HasCodec Network where
codec =
AC.object "Network" $
Network
<$> optionalFieldWithDefault' "tls_allowlist" [] AC..= networkTlsAllowlist
<$> optionalFieldWithDefault' "tls_allowlist" []
AC..= networkTlsAllowlist
instance FromJSON Network where
parseJSON = withObject "Network" $ \o -> Network <$> o .:? "tls_allowlist" .!= []
@ -46,9 +47,12 @@ instance HasCodec TlsAllow where
codec =
AC.object "TlsAllow" $
TlsAllow
<$> requiredField' "host" AC..= taHost
<*> optionalField' "suffix" AC..= taSuffix
<*> optionalField' "permissions" AC..= taPermit
<$> requiredField' "host"
AC..= taHost
<*> optionalField' "suffix"
AC..= taSuffix
<*> optionalField' "permissions"
AC..= taPermit
instance FromJSON TlsAllow where
parseJSON j = aString j <|> anObject j

View File

@ -128,7 +128,6 @@ import Hasura.RQL.Types.Common
import Hasura.RQL.Types.EECredentials
import Hasura.RQL.Types.Eventing.Backend
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Network
import Hasura.RQL.Types.ResizePool
import Hasura.RQL.Types.Roles (adminRoleName)
import Hasura.RQL.Types.SchemaCache
@ -161,6 +160,7 @@ import Hasura.ShutdownLatch
import Hasura.Tracing
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Client.CreateManager (mkHttpManager)
import Network.Types.Extended
import Network.Wai (Application)
import Network.Wai.Handler.Warp qualified as Warp
import Options.Applicative

View File

@ -75,6 +75,7 @@ where
import Autodocodec (HasCodec (codec), dimapCodec, object, optionalField', requiredField', (.=))
import Autodocodec qualified as AC
import Autodocodec.Extended (boundedEnumCodec)
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import Data.Aeson qualified as J
import Data.Aeson.Casing qualified as J
@ -98,7 +99,6 @@ import Hasura.Base.Error
import Hasura.Base.ErrorValue qualified as ErrorValue
import Hasura.Base.ToErrorValue
import Hasura.Function.Cache (FunctionArgName)
import Hasura.Metadata.DTO.Utils (boundedEnumCodec)
import Hasura.NativeQuery.Metadata (InterpolatedQuery, NativeQueryName)
import Hasura.Prelude hiding (state)
import Hasura.RQL.IR.BoolExp

View File

@ -26,13 +26,13 @@ import Hasura.RQL.Types.CustomTypes (CustomTypes, emptyCustomTypes)
import Hasura.RQL.Types.Endpoint (_ceName)
import Hasura.RQL.Types.GraphqlSchemaIntrospection (SetGraphqlIntrospectionOptions)
import Hasura.RQL.Types.Metadata.Common (Actions, BackendConfigWrapper, CronTriggers, Endpoints, InheritedRoles, QueryCollections, RemoteSchemas, Sources, sourcesCodec)
import Hasura.RQL.Types.Network (Network, emptyNetwork)
import Hasura.RQL.Types.OpenTelemetry (OpenTelemetryConfig, emptyOpenTelemetryConfig)
import Hasura.RQL.Types.QueryCollection qualified as QC
import Hasura.RQL.Types.Roles (Role (_rRoleName))
import Hasura.RQL.Types.ScheduledTrigger (CronTriggerMetadata (ctName))
import Hasura.RemoteSchema.Metadata.Core (RemoteSchemaMetadataG (_rsmName))
import Hasura.SQL.BackendMap (BackendMap)
import Network.Types.Extended (Network, emptyNetwork)
-- | Revision 3 of the Metadata export format. Note that values of the types,
-- 'PlaceholderArray' and 'PlaceholderObject' will eventually be expanded to represent more detail.

View File

@ -1,7 +1,6 @@
-- | Utility functions for use defining autodocodec codecs.
module Hasura.Metadata.DTO.Utils
( boolConstCodec,
boundedEnumCodec,
codecNamePrefix,
discriminatorField,
discriminatorBoolField,
@ -12,7 +11,6 @@ module Hasura.Metadata.DTO.Utils
where
import Autodocodec
import Data.List.NonEmpty qualified as NE
import Data.Scientific (Scientific)
import Data.Text qualified as T
import Data.Text.Extended qualified as T
@ -29,29 +27,6 @@ boolConstCodec trueCase falseCase =
(== trueCase)
$ codec @Bool
-- | A codec for a 'Bounded' 'Enum' that maps to literal strings using
-- a provided function.
--
--
-- === Example usage
--
-- >>> data Fruit = FruitApple | FruitOrange deriving (Show, Eq, Enum, Bounded)
-- >>> let c = boundedEnumCodec (snakeCase . drop 5)
-- >>> toJSONVia c Apple
-- String "apple"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "orange") :: Maybe Fruit
-- Just Orange
boundedEnumCodec ::
forall enum.
(Eq enum, Enum enum, Bounded enum) =>
(enum -> String) ->
JSONCodec enum
boundedEnumCodec display =
let ls = [minBound .. maxBound]
in case NE.nonEmpty ls of
Nothing -> error "0 enum values ?!"
Just ne -> stringConstCodec (NE.map (\v -> (v, T.pack (display v))) ne)
-- | Defines a required object field named @version@ that must have the given
-- integer value. On serialization the field will have the given value
-- automatically. On deserialization parsing will fail unless the field has the

View File

@ -73,7 +73,6 @@ import Hasura.RQL.Types.Eventing.Backend (BackendEventTrigger (..))
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Network
import Hasura.RQL.Types.OpenTelemetry
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.ScheduledTrigger
@ -86,6 +85,7 @@ import Hasura.SQL.Backend (BackendType (..))
import Hasura.SQL.BackendMap qualified as BackendMap
import Hasura.Server.Logging (MetadataLog (..))
import Network.HTTP.Client.Transformable qualified as HTTP
import Network.Types.Extended
-- | Helper function to run the post drop source hook
postDropSourceHookHelper ::

View File

@ -14,8 +14,8 @@ import Hasura.Metadata.Class ()
import Hasura.Prelude
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Network
import Hasura.RQL.Types.SchemaCache.Build
import Network.Types.Extended
runAddHostToTLSAllowlist ::
(QErrM m, CacheRWM m, MetadataM m) =>

View File

@ -79,7 +79,6 @@ import Hasura.RQL.Types.Eventing.Backend
import Hasura.RQL.Types.Metadata hiding (tmTable)
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Network
import Hasura.RQL.Types.OpenTelemetry
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.Relationships.Remote
@ -106,6 +105,7 @@ import Hasura.Services
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
import Network.Types.Extended
{- Note [Roles Inheritance]
~~~~~~~~~~~~~~~~~~~~~~~~~~~

View File

@ -57,7 +57,7 @@ where
import Autodocodec (HasCodec, dimapCodec, disjointEitherCodec, optionalField', optionalFieldWith', optionalFieldWithDefault', optionalFieldWithOmittedDefault', requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (graphQLFieldDescriptionCodec, graphQLFieldNameCodec, typeableName)
import Autodocodec.Extended (boundedEnumCodec, graphQLFieldDescriptionCodec, graphQLFieldNameCodec, typeableName)
import Control.Lens (makeLenses)
import Data.Aeson qualified as J
import Data.Aeson.Casing qualified as J
@ -70,7 +70,7 @@ import Data.UUID qualified as UUID
import Database.PG.Query qualified as PG
import Database.PG.Query.PTI qualified as PTI
import Hasura.Base.Error
import Hasura.Metadata.DTO.Utils (boundedEnumCodec, discriminatorField)
import Hasura.Metadata.DTO.Utils (discriminatorField)
import Hasura.Prelude
import Hasura.RQL.DDL.Headers
import Hasura.RQL.DDL.Webhook.Transform (MetadataResponseTransform, RequestTransform)

View File

@ -30,7 +30,7 @@ where
import Autodocodec (HasCodec (codec), dimapCodec, optionalField', requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (typeableName)
import Autodocodec.Extended (boundedEnumCodec, typeableName)
import Control.Lens
import Data.Aeson
import Data.Aeson.Casing
@ -41,7 +41,6 @@ import Data.Text.Extended
import Data.Text.NonEmpty
import Data.Trie qualified as T
import Data.Typeable (Typeable)
import Hasura.Metadata.DTO.Utils (boundedEnumCodec)
import Hasura.Prelude
import Hasura.RQL.Types.Endpoint.Trie as Trie
import Hasura.RQL.Types.QueryCollection (CollectionName, QueryName)

View File

@ -74,7 +74,6 @@ import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.GraphqlSchemaIntrospection
import Hasura.RQL.Types.Metadata.Common
import Hasura.RQL.Types.Metadata.Serialization
import Hasura.RQL.Types.Network
import Hasura.RQL.Types.OpenTelemetry
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.Roles (RoleName)
@ -85,6 +84,7 @@ import Hasura.SQL.BackendMap (BackendMap)
import Hasura.SQL.BackendMap qualified as BackendMap
import Hasura.Tracing (TraceT)
import Language.GraphQL.Draft.Syntax qualified as G
import Network.Types.Extended
-- | Versioning the @'Metadata' JSON structure to track backwards incompatible changes.
-- This value is included in the metadata JSON object at top level 'version' key.

View File

@ -72,7 +72,6 @@ import Hasura.RQL.Types.Metadata.Common
TableMetadata (..),
getSourceName,
)
import Hasura.RQL.Types.Network (Network, emptyNetwork)
import Hasura.RQL.Types.OpenTelemetry
( OpenTelemetryConfig (..),
emptyOpenTelemetryConfig,
@ -106,6 +105,7 @@ import Hasura.SQL.BackendMap (BackendMap)
import Hasura.SQL.BackendMap qualified as BackendMap
import Hasura.SQL.Tag (HasTag (backendTag), reify)
import Language.GraphQL.Draft.Syntax qualified as G
import Network.Types.Extended (Network, emptyNetwork)
sourcesToOrdJSONList :: Sources -> AO.Array
sourcesToOrdJSONList sources =

View File

@ -38,6 +38,7 @@ where
import Autodocodec (HasCodec, optionalField, optionalFieldWithDefault, optionalFieldWithDefault', requiredField', (<?>))
import Autodocodec qualified as AC
import Autodocodec.Extended (boundedEnumCodec)
import Control.Lens.TH (makeLenses)
import Data.Aeson (FromJSON, ToJSON (..), (.!=), (.:), (.:?), (.=))
import Data.Aeson qualified as Aeson
@ -50,7 +51,6 @@ import Data.Set qualified as Set
import Data.Text qualified as Text
import GHC.Generics
import Hasura.Base.Error (Code (InvalidParams), QErr, err400)
import Hasura.Metadata.DTO.Utils (boundedEnumCodec)
import Hasura.Prelude hiding (first)
import Hasura.RQL.DDL.Headers
import Language.Haskell.TH.Syntax (Lift)

View File

@ -145,7 +145,6 @@ import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.GraphqlSchemaIntrospection
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Network (TlsAllow)
import Hasura.RQL.Types.OpenTelemetry (OpenTelemetryInfo)
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.Relationships.Local
@ -165,6 +164,7 @@ import Hasura.SQL.Tag (HasTag (backendTag), reify)
import Hasura.Session (UserInfoM)
import Hasura.Tracing (TraceT)
import Language.GraphQL.Draft.Syntax qualified as G
import Network.Types.Extended (TlsAllow)
import System.Cron.Types
newtype MetadataResourceVersion = MetadataResourceVersion

View File

@ -35,13 +35,13 @@ import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.GraphqlSchemaIntrospection
import Hasura.RQL.Types.Metadata (GetCatalogState, SetCatalogState)
import Hasura.RQL.Types.Network
import Hasura.RQL.Types.OpenTelemetry
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.Roles
import Hasura.RQL.Types.ScheduledTrigger
import Hasura.RemoteSchema.MetadataAPI
import Hasura.SQL.AnyBackend
import Network.Types.Extended
data RQLMetadataV1
= -- Sources

View File

@ -37,10 +37,10 @@ import Hasura.Prelude hiding (get, put)
import Hasura.RQL.DDL.Schema
import Hasura.RQL.Types.Common (MetricsConfig)
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Network
import Hasura.RQL.Types.SchemaCache
import Hasura.Server.Logging
import Hasura.Server.Metrics
import Network.Types.Extended
import System.Metrics.Gauge (Gauge)
import System.Metrics.Gauge qualified as Gauge

View File

@ -48,7 +48,6 @@ import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Network
import Hasura.RQL.Types.OpenTelemetry (emptyOpenTelemetryConfig)
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SourceCustomization
@ -62,6 +61,7 @@ import Hasura.Server.Migrate.Version
import Hasura.Server.Types (MaintenanceMode (..))
import Language.Haskell.TH.Lib qualified as TH
import Language.Haskell.TH.Syntax qualified as TH
import Network.Types.Extended
import System.Directory (doesFileExist)
data MigrationResult

View File

@ -25,8 +25,8 @@ import Hasura.RQL.Types.ApiLimit (emptyApiLimit)
import Hasura.RQL.Types.Common (emptyMetricsConfig)
import Hasura.RQL.Types.CustomTypes (emptyCustomTypes)
import Hasura.RQL.Types.Metadata (Metadata, MetadataDefaults, metadataToDTO, overrideMetadataDefaults)
import Hasura.RQL.Types.Network (emptyNetwork)
import Hasura.RQL.Types.OpenTelemetry (emptyOpenTelemetryConfig)
import Network.Types.Extended (emptyNetwork)
import Test.Hspec
import Test.Hspec.Expectations.Json (shouldBeJson)