From 74c91e0f3cc1a41b42791c8648a76f8396ba5b82 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Fri, 25 Oct 2024 07:49:36 +0200 Subject: [PATCH 1/3] Improve docs for `Util.Parser` --- grpc-spec/src/Network/GRPC/Spec/Serialization.hs | 1 - grpc-spec/src/Network/GRPC/Spec/Util/Parser.hs | 6 ++++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization.hs index 3e0095cd..2d58e9d8 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization.hs @@ -6,7 +6,6 @@ module Network.GRPC.Spec.Serialization ( -- ** Outputs , buildOutput , parseOutput - -- ** Inbound -- * Headers -- ** Status , buildGrpcStatus diff --git a/grpc-spec/src/Network/GRPC/Spec/Util/Parser.hs b/grpc-spec/src/Network/GRPC/Spec/Util/Parser.hs index 714efff4..d1fea1ec 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Util/Parser.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Util/Parser.hs @@ -30,6 +30,12 @@ import Data.Int Definition -------------------------------------------------------------------------------} +-- | Simple incremental parser +-- +-- This is used to parse a stream of values, where we know ahead of time for +-- each value how much data to expect (perhaps based on the previous value). +-- Individual values are not parsed incrementally; see 'consumeExactly' or +-- 'getExactly'. newtype Parser e a = Parser { runParser :: Accumulator -> Result e a } From bff2ec628825b0aa490ad3d7bc82798669a25d48 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Fri, 25 Oct 2024 09:12:41 +0200 Subject: [PATCH 2/3] Full haddock coverage in `grpc-spec` --- grpc-spec/src/Network/GRPC/Spec/Call.hs | 2 +- .../src/Network/GRPC/Spec/Compression.hs | 6 ++++- .../Network/GRPC/Spec/CustomMetadata/Map.hs | 8 +++--- .../GRPC/Spec/CustomMetadata/NoMetadata.hs | 8 ------ .../Network/GRPC/Spec/CustomMetadata/Raw.hs | 14 ++++++++-- .../Network/GRPC/Spec/CustomMetadata/Typed.hs | 9 +++++++ .../src/Network/GRPC/Spec/Headers/Common.hs | 2 ++ .../src/Network/GRPC/Spec/Headers/Invalid.hs | 14 +++++++++- .../src/Network/GRPC/Spec/Headers/Response.hs | 13 +++++----- .../src/Network/GRPC/Spec/MessageMeta.hs | 2 ++ grpc-spec/src/Network/GRPC/Spec/RPC.hs | 6 +++-- grpc-spec/src/Network/GRPC/Spec/RPC/JSON.hs | 6 ++--- .../src/Network/GRPC/Spec/RPC/Protobuf.hs | 8 +++--- .../src/Network/GRPC/Spec/RPC/StreamType.hs | 2 ++ .../src/Network/GRPC/Spec/Serialization.hs | 7 +++++ .../GRPC/Spec/Serialization/CustomMetadata.hs | 3 +++ .../Serialization/Headers/PseudoHeaders.hs | 11 +++++--- .../Spec/Serialization/Headers/Request.hs | 12 ++++++++- .../Spec/Serialization/Headers/Response.hs | 21 +++++++++++++-- .../GRPC/Spec/Serialization/LengthPrefixed.hs | 2 ++ .../Network/GRPC/Spec/Serialization/Status.hs | 4 +++ .../GRPC/Spec/Serialization/Timeout.hs | 6 ++--- .../GRPC/Spec/Serialization/TraceContext.hs | 2 ++ grpc-spec/src/Network/GRPC/Spec/Status.hs | 3 ++- grpc-spec/src/Network/GRPC/Spec/Timeout.hs | 26 +++++++++++++------ .../src/Network/GRPC/Spec/TraceContext.hs | 6 ++--- grpc-spec/src/Network/GRPC/Spec/Util/HKD.hs | 11 ++++++-- .../src/Network/GRPC/Spec/Util/Parser.hs | 21 ++++++++++++--- 28 files changed, 176 insertions(+), 59 deletions(-) diff --git a/grpc-spec/src/Network/GRPC/Spec/Call.hs b/grpc-spec/src/Network/GRPC/Spec/Call.hs index 8ec1e051..8a03c7f4 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Call.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Call.hs @@ -47,7 +47,7 @@ data CallParams rpc = CallParams { deriving instance (Show (RequestMetadata rpc)) => Show (CallParams rpc) --- | Default 'CallParams' +-- | Default t'CallParams' instance Default (RequestMetadata rpc) => Default (CallParams rpc) where def = CallParams { callTimeout = Nothing diff --git a/grpc-spec/src/Network/GRPC/Spec/Compression.hs b/grpc-spec/src/Network/GRPC/Spec/Compression.hs index 2abb8e0f..0c62e14c 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Compression.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Compression.hs @@ -95,6 +95,7 @@ data CompressionId = | Custom String deriving stock (Eq, Ord, Generic) +-- | Serialize compression ID serializeCompressionId :: CompressionId -> Strict.ByteString serializeCompressionId Identity = "identity" serializeCompressionId GZip = "gzip" @@ -102,6 +103,7 @@ serializeCompressionId Deflate = "deflate" serializeCompressionId Snappy = "snappy" serializeCompressionId (Custom i) = BS.Strict.UTF8.fromString i +-- | Parse compression ID deserializeCompressionId :: Strict.ByteString -> CompressionId deserializeCompressionId "identity" = Identity deserializeCompressionId "gzip" = GZip @@ -122,6 +124,7 @@ compressionIsIdentity = (== Identity) . compressionId Compression algorithms -------------------------------------------------------------------------------} +-- | Disable compression (referred to as @identity@ in the gRPC spec) noCompression :: Compression noCompression = Compression { compressionId = Identity @@ -130,6 +133,7 @@ noCompression = Compression { , uncompressedSizeThreshold = const False } +-- | @gzip@ gzip :: Compression gzip = Compression { compressionId = GZip @@ -141,7 +145,7 @@ gzip = Compression { , uncompressedSizeThreshold = (>= 27) } --- | zlib deflate compression +-- | @zlib@ (aka @deflate@) compression -- -- Note: The gRPC spec calls this "deflate", but it is /not/ raw deflate -- format. The expected format (at least by the python server) is just zlib diff --git a/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Map.hs b/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Map.hs index 5a004319..275c3323 100644 --- a/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Map.hs +++ b/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Map.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} --- | Map of 'CustomMetadata', handling joining values +-- | Map of t'CustomMetadata', handling joining values module Network.GRPC.Spec.CustomMetadata.Map ( CustomMetadataMap -- opaque -- * Conversion @@ -53,14 +53,14 @@ instance Semigroup CustomMetadataMap where Conversion -------------------------------------------------------------------------------} --- | Construct 'CustomMetadataMap', joining duplicates +-- | Construct t'CustomMetadataMap', joining duplicates customMetadataMapFromList :: [CustomMetadata] -> CustomMetadataMap customMetadataMapFromList = CustomMetadataMap . Map.fromListWith joinHeaderValue . map unpairCustomMetadata --- | Flatten 'CustomMetadataMap' to a list +-- | Flatten t'CustomMetadataMap' to a list -- -- Precondition: the map must be valid. customMetadataMapToList :: CustomMetadataMap -> [CustomMetadata] @@ -74,7 +74,7 @@ customMetadataMapToList mds = Construction -------------------------------------------------------------------------------} --- | Insert value into 'CustomMetadataMap' +-- | Insert value into t'CustomMetadataMap' -- -- If a header with the same name already exists, the value is appended to -- (the end of) the existing value. diff --git a/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs b/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs index e5d06a43..d614defc 100644 --- a/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs +++ b/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs @@ -1,13 +1,10 @@ module Network.GRPC.Spec.CustomMetadata.NoMetadata ( NoMetadata(..) - , UnexpectedMetadata(..) ) where -import Control.Exception import Control.Monad.Catch import Data.Default.Class -import Network.GRPC.Spec.CustomMetadata.Raw import Network.GRPC.Spec.CustomMetadata.Typed -- | Indicate the absence of custom metadata @@ -26,8 +23,3 @@ instance ParseMetadata NoMetadata where instance StaticMetadata NoMetadata where metadataHeaderNames _ = [] - -data UnexpectedMetadata = UnexpectedMetadata [CustomMetadata] - deriving stock (Show) - deriving anyclass (Exception) - diff --git a/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Raw.hs b/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Raw.hs index e9963c84..452e437e 100644 --- a/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Raw.hs +++ b/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Raw.hs @@ -56,13 +56,19 @@ import Network.GRPC.Spec.Util.ByteString (strip, ascii) -- with duplicate header names. Duplicate header names may have their values -- joined with "," as the delimiter and be considered semantically equivalent. data CustomMetadata = UnsafeCustomMetadata { - customMetadataName :: HeaderName + -- | Header name + -- + -- The header name determines if this is an ASCII header or a binary + -- header; see the t'CustomMetadata' pattern synonym. + customMetadataName :: HeaderName + + -- | Header value , customMetadataValue :: Strict.ByteString } deriving stock (Eq, Generic) deriving anyclass (NFData) --- | 'Show' instance relies on the 'CustomMetadata' pattern synonym +-- | 'Show' instance relies on the v'CustomMetadata' pattern synonym instance Show CustomMetadata where showsPrec p (UnsafeCustomMetadata name value) = showParen (p >= appPrec1) $ showString "CustomMetadata " @@ -81,6 +87,10 @@ instance Show CustomMetadata where isValidAsciiValue :: Strict.ByteString -> Bool isValidAsciiValue bs = BS.Strict.all (\c -> 0x20 <= c && c <= 0x7E) bs +-- | Construct t'CustomMetadata' +-- +-- Returns 'Nothing' if the 'HeaderName' indicates an ASCII header but the +-- value is not valid ASCII (consider using a binary header instead). safeCustomMetadata :: HeaderName -> Strict.ByteString -> Maybe CustomMetadata safeCustomMetadata name value = case name of diff --git a/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Typed.hs b/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Typed.hs index e9cefe38..68b74567 100644 --- a/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Typed.hs +++ b/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Typed.hs @@ -8,6 +8,7 @@ module Network.GRPC.Spec.CustomMetadata.Typed ( , BuildMetadata(..) , StaticMetadata(..) , ParseMetadata(..) + , UnexpectedMetadata(..) , buildMetadataIO ) where @@ -113,3 +114,11 @@ class BuildMetadata a => StaticMetadata a where class ParseMetadata a where parseMetadata :: MonadThrow m => [CustomMetadata] -> m a +-- | Unexpected metadata +-- +-- This exception can be thrown in 'ParseMetadata' instances. See 'ParseMetadata' +-- for discussion. +data UnexpectedMetadata = UnexpectedMetadata [CustomMetadata] + deriving stock (Show) + deriving anyclass (Exception) + diff --git a/grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs b/grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs index 4d569331..33851690 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs @@ -53,6 +53,7 @@ data ContentType = instance Default ContentType where def = ContentTypeDefault +-- | Interpret 'ContentType' chooseContentType :: IsRPC rpc => Proxy rpc -> ContentType -> Strict.ByteString chooseContentType p ContentTypeDefault = rpcContentType p chooseContentType _ (ContentTypeOverride ct) = ct @@ -77,6 +78,7 @@ data MessageType = instance Default MessageType where def = MessageTypeDefault +-- | Interpret 'MessageType' chooseMessageType :: IsRPC rpc => Proxy rpc -> MessageType -> Maybe Strict.ByteString diff --git a/grpc-spec/src/Network/GRPC/Spec/Headers/Invalid.hs b/grpc-spec/src/Network/GRPC/Spec/Headers/Invalid.hs index 80773ccc..a0366002 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Headers/Invalid.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Headers/Invalid.hs @@ -54,7 +54,7 @@ newtype InvalidHeaders e = InvalidHeaders { -- -- This corresponds to a single \"raw\" HTTP header. It is possible that a -- particular field of, say, 'Network.GRPC.Spec.Headers.Request.RequestHeaders' --- corresponds to /multiple/ 'InvalidHeader', when the value of that field is +-- corresponds to /multiple/ t'InvalidHeader', when the value of that field is -- determined by combining multiple HTTP headers. A special case of this is the -- field for unrecognized headers (see -- 'Network.GRPC.Spec.Headers.Request.requestUnrecognized', @@ -90,21 +90,26 @@ data InvalidHeader e = Construction -------------------------------------------------------------------------------} +-- | Convenience constructor around v'InvalidHeader' invalidHeader :: Maybe HTTP.Status -> HTTP.Header -> String -> InvalidHeaders e invalidHeader status hdr err = wrapOne $ InvalidHeader status hdr err +-- | Convenience constructor around v'MissingHeader' missingHeader :: Maybe HTTP.Status -> HTTP.HeaderName -> InvalidHeaders e missingHeader status name = wrapOne $ MissingHeader status name +-- | Convenience constructor around v'UnexpectedHeader' unexpectedHeader :: HTTP.HeaderName -> InvalidHeaders e unexpectedHeader name = wrapOne $ UnexpectedHeader name +-- | Convenience constructor around v'InvalidHeaderSynthesize' invalidHeaderSynthesize :: e -> InvalidHeader HandledSynthesized -> InvalidHeaders e invalidHeaderSynthesize e orig = wrapOne $ InvalidHeaderSynthesize e orig +-- | Convenience function for throwing an 'invalidHeader' exception. throwInvalidHeader :: MonadError (InvalidHeaders e) m => HTTP.Header @@ -136,6 +141,7 @@ instance Show HandledSynthesized where instance Eq HandledSynthesized where x == _ = handledSynthesized x +-- | Evidence that 'HandledSynthesized' is an empty type handledSynthesized :: HandledSynthesized -> a handledSynthesized x = case x of {} @@ -154,6 +160,7 @@ dropSynthesized = \(InvalidHeaders es) -> aux (InvalidHeaderSynthesize _ orig) = orig +-- | Map over the errors mapSynthesizedM :: forall m e e'. Monad m => (e -> m e') @@ -176,9 +183,13 @@ mapSynthesizedM f = \(InvalidHeaders es) -> e' <- f e go (InvalidHeaderSynthesize e' orig : acc) xs +-- | Pure version of 'mapSynthesizedM' mapSynthesized :: (e -> e') -> InvalidHeaders e -> InvalidHeaders e' mapSynthesized f = runIdentity . mapSynthesizedM (Identity . f) +-- | Throw all synthesized errors +-- +-- After this we are guaranteed that the synthesized errors have been handlded. throwSynthesized :: (HKD.Traversable h, Monad m) => (forall a. GrpcException -> m a) @@ -206,6 +217,7 @@ invalidHeaders = \invalid -> aux UnexpectedHeader{} = Nothing aux (InvalidHeaderSynthesize e _) = handledSynthesized e +-- | Render t'InvalidHeaders' prettyInvalidHeaders :: InvalidHeaders HandledSynthesized -> ByteString.Builder prettyInvalidHeaders = mconcat . map go . getInvalidHeaders where diff --git a/grpc-spec/src/Network/GRPC/Spec/Headers/Response.hs b/grpc-spec/src/Network/GRPC/Spec/Headers/Response.hs index 98339155..4a631bcb 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Headers/Response.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Headers/Response.hs @@ -73,12 +73,13 @@ data ResponseHeaders_ f = ResponseHeaders { -- | Response headers (without allowing for invalid headers) -- --- See 'RequestHeaders' for an explanation of @Undecorated@. +-- See t'Network.GRPC.Spec.RequestHeaders' for an explanation of 'Undecorated'. type ResponseHeaders = ResponseHeaders_ Undecorated -- | Response headers allowing for invalid headers -- --- See 'RequestHeaders'' for an explanation of @Checked@ and the purpose of @e@. +-- See t'Network.GRPC.Spec.RequestHeaders'' for an explanation of 'Checked' and +-- the purpose of @e@. type ResponseHeaders' e = ResponseHeaders_ (Checked (InvalidHeaders e)) deriving stock instance Show ResponseHeaders @@ -132,7 +133,7 @@ data ProperTrailers_ f = ProperTrailers { } deriving anyclass (HKD.Coerce) --- | Default constructor for 'ProperTrailers' +-- | Default constructor for t'ProperTrailers' simpleProperTrailers :: forall f. HKD.ValidDecoration Applicative f => HKD f GrpcStatus @@ -209,7 +210,7 @@ instance HKD.Traversable TrailersOnly_ where <$> (f $ trailersOnlyContentType x) <*> (HKD.traverse f $ trailersOnlyProper x) --- | 'ProperTrailers' is a subset of 'TrailersOnly' +-- | t'ProperTrailers' is a subset of t'TrailersOnly' properTrailersToTrailersOnly :: (ProperTrailers_ f, HKD f (Maybe ContentType)) -> TrailersOnly_ f @@ -218,7 +219,7 @@ properTrailersToTrailersOnly (proper, ct) = TrailersOnly { , trailersOnlyContentType = ct } --- | 'TrailersOnly' is a superset of 'ProperTrailers' +-- | t'TrailersOnly' is a superset of t'ProperTrailers' trailersOnlyToProperTrailers :: TrailersOnly_ f -> (ProperTrailers_ f, HKD f (Maybe ContentType)) @@ -268,7 +269,7 @@ data GrpcNormalTermination = GrpcNormalTermination { -- -- However, in practice gRPC servers can also respond with @Trailers-Only@ in -- non-error cases, simply indicating that the server considers the --- conversation over. To distinguish, we look at 'trailerGrpcStatus'. +-- conversation over. To distinguish, we look at 'properTrailersGrpcStatus'. grpcClassifyTermination :: ProperTrailers' -> Either GrpcException GrpcNormalTermination diff --git a/grpc-spec/src/Network/GRPC/Spec/MessageMeta.hs b/grpc-spec/src/Network/GRPC/Spec/MessageMeta.hs index 693d4c4b..da19dfe9 100644 --- a/grpc-spec/src/Network/GRPC/Spec/MessageMeta.hs +++ b/grpc-spec/src/Network/GRPC/Spec/MessageMeta.hs @@ -13,6 +13,7 @@ import GHC.Generics (Generic) Outbound messages -------------------------------------------------------------------------------} +-- | Meta-information for outbound messages data OutboundMeta = OutboundMeta { -- | Enable compression for this message -- @@ -32,6 +33,7 @@ instance Default OutboundMeta where Inbound messages -------------------------------------------------------------------------------} +-- | Meta-information about inbound messages data InboundMeta = InboundMeta { -- | Size of the message in compressed form, /if/ it was compressed inboundCompressedSize :: Maybe Word32 diff --git a/grpc-spec/src/Network/GRPC/Spec/RPC.hs b/grpc-spec/src/Network/GRPC/Spec/RPC.hs index 95bf4e38..ebe00d3f 100644 --- a/grpc-spec/src/Network/GRPC/Spec/RPC.hs +++ b/grpc-spec/src/Network/GRPC/Spec/RPC.hs @@ -99,6 +99,7 @@ class ( -- Serialization defaultRpcContentType :: Strict.ByteString -> Strict.ByteString defaultRpcContentType format = "application/grpc+" <> format +-- | Client-side RPC class ( IsRPC rpc -- Serialization @@ -115,18 +116,19 @@ class ( IsRPC rpc -- anything. -- -- We use the terms \"serialize\" and \"deserialize\" here, and - -- \"compress\"/\"decompress\" for compression here, rather than + -- \"compress\"/\"decompress\" for compression, rather than -- \"encode\"/\"decode\", which could refer to either process. rpcSerializeInput :: Proxy rpc -> Input rpc -> Lazy.ByteString -- | Deserialize RPC output -- - -- Discussion of 'deserializeInput' applies here, also. + -- Discussion of 'rpcDeserializeInput' applies here, also. rpcDeserializeOutput :: Proxy rpc -> Lazy.ByteString -> Either String (Output rpc) +-- | Server-side RPC class ( IsRPC rpc -- Serialization diff --git a/grpc-spec/src/Network/GRPC/Spec/RPC/JSON.hs b/grpc-spec/src/Network/GRPC/Spec/RPC/JSON.hs index fa193e0d..993db752 100644 --- a/grpc-spec/src/Network/GRPC/Spec/RPC/JSON.hs +++ b/grpc-spec/src/Network/GRPC/Spec/RPC/JSON.hs @@ -53,7 +53,7 @@ import Network.GRPC.Spec.RPC.StreamType -- -- On the client, you will need 'ToJSON' instances for inputs and 'FromJSON' -- instances for outputs; on the server the situation is dual. You may find it --- convenient to use 'JsonObject' (but this is certainly not required). +-- convenient to use t'JsonObject' (but this is certainly not required). -- -- TODO: -- We don't currently offer explicit support for "Protobuf JSON". @@ -161,7 +161,7 @@ newtype Optional a = Optional { infixr 5 :* --- | Auxiliary class used for the 'ToJSON' instance for 'JsonObject' +-- | Auxiliary class used for the 'ToJSON' instance for t'JsonObject' -- -- It is not possible (nor necessary) to define additional instances. class EncodeFields fs where @@ -187,7 +187,7 @@ instance (KnownSymbol f, ToJSON x, EncodeFields fs) instance EncodeFields fs => ToJSON (JsonObject fs) where toJSON = Aeson.object . encodeFields --- | Auxiliary class used for the 'FromJSON' instance for 'JsonObject' +-- | Auxiliary class used for the 'FromJSON' instance for t'JsonObject' -- -- It is not possible (nor necessary) to define additional instances. class DecodeFields fs where diff --git a/grpc-spec/src/Network/GRPC/Spec/RPC/Protobuf.hs b/grpc-spec/src/Network/GRPC/Spec/RPC/Protobuf.hs index 0185ed12..29fb8c17 100644 --- a/grpc-spec/src/Network/GRPC/Spec/RPC/Protobuf.hs +++ b/grpc-spec/src/Network/GRPC/Spec/RPC/Protobuf.hs @@ -116,8 +116,8 @@ instance ValidStreamingType (MethodStreamingType serv meth) -- -- Protobuf messages and enums behave differently to normal Haskell datatypes. -- Fields in messages always have defaults, enums can have unknown values, etc. --- We therefore mark them at the type-level with this 'Proto' wrapper. Most of --- the time you can work with 'Proto' values as if the wrapper is not there, +-- We therefore mark them at the type-level with this t'Proto' wrapper. Most of +-- the time you can work with t'Proto' values as if the wrapper is not there, -- because @Proto msg@ inherits 'Message' and @Data.ProtoLens.Field@ -- 'ProtoLens.HasField' instances from @msg@. For example, you can create a -- 'Proto Point' value as @@ -132,7 +132,7 @@ instance ValidStreamingType (MethodStreamingType serv meth) -- -- as per usual. -- --- One advantage of the 'Proto' wrapper is that we can give blanket instances +-- One advantage of the t'Proto' wrapper is that we can give blanket instances -- for /all/ Protobuf messages; we use this to provide @GHC.Records@ -- 'GHC.HasField' and @GHC.Records.Compat@ 'GHC.Compat.HasField' instances. -- This means that you can also use @OverloadedRecordDot@ to access fields @@ -154,7 +154,7 @@ newtype Proto msg = Proto msg , NFData ) --- | Field accessor for 'Proto' +-- | Field accessor for t'Proto' getProto :: Proto msg -> msg -- Implementation note: This /must/ be defined separately from the 'Proto' -- newtype, otherwise ghc won't let us define a 'GHC.HasField' instance. diff --git a/grpc-spec/src/Network/GRPC/Spec/RPC/StreamType.hs b/grpc-spec/src/Network/GRPC/Spec/RPC/StreamType.hs index d2013bcb..1c36e9fe 100644 --- a/grpc-spec/src/Network/GRPC/Spec/RPC/StreamType.hs +++ b/grpc-spec/src/Network/GRPC/Spec/RPC/StreamType.hs @@ -150,6 +150,7 @@ data SStreamingType :: StreamingType -> Type where SServerStreaming :: SStreamingType ServerStreaming SBiDiStreaming :: SStreamingType BiDiStreaming +-- | Valid streaming types class ValidStreamingType (styp :: StreamingType) where -- | Obtain singleton validStreamingType :: Proxy styp -> SStreamingType styp @@ -185,6 +186,7 @@ instance HoistServerHandler BiDiStreaming where hoistServerHandler' f (ServerHandler h) = ServerHandler $ \(recv, send) -> f $ h (recv, send) +-- | Hoist server handler from one monad to another hoistServerHandler :: forall styp m n rpc. ValidStreamingType styp => (forall a. m a -> n a) diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization.hs index 2d58e9d8..72c0ba48 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization.hs @@ -1,3 +1,10 @@ +-- | Serialization functions +-- +-- We collect these functions in a separate module, rather than exporting them +-- from "Network.GRPC.Spec", because while the functions in "Network.GRPC.Spec" +-- /may/ be needed in some user code (albeit rarely), the serialization +-- functions from this module really should only be needed in gRPC +-- implementations such as @grapesy@. module Network.GRPC.Spec.Serialization ( -- * Messages -- ** Inputs diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization/CustomMetadata.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization/CustomMetadata.hs index ab458933..b0284fa3 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization/CustomMetadata.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization/CustomMetadata.hs @@ -63,6 +63,7 @@ parseAsciiValue bs = do BinaryValue -------------------------------------------------------------------------------} +-- | Serialize binary value (base-64 encoding) buildBinaryValue :: Strict.ByteString -> Strict.ByteString buildBinaryValue = encodeBase64 @@ -115,12 +116,14 @@ parseBinaryValue bs = do CustomMetadata -------------------------------------------------------------------------------} +-- | Serialize t'CustomMetadata' buildCustomMetadata :: CustomMetadata -> HTTP.Header buildCustomMetadata (CustomMetadata name value) = case name of BinaryHeader _ -> (buildHeaderName name, buildBinaryValue value) AsciiHeader _ -> (buildHeaderName name, buildAsciiValue value) +-- | Parse t'CustomMetadata' parseCustomMetadata :: MonadError (InvalidHeaders GrpcException) m => HTTP.Header -> m CustomMetadata diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/PseudoHeaders.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/PseudoHeaders.hs index 078f01fe..0b41ab34 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/PseudoHeaders.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/PseudoHeaders.hs @@ -18,17 +18,22 @@ import Network.GRPC.Spec.Util.ByteString Serialization -------------------------------------------------------------------------------} +-- | Raw (serialized) form of t'ResourceHeaders' data RawResourceHeaders = RawResourceHeaders { - rawPath :: Strict.ByteString - , rawMethod :: Strict.ByteString + rawPath :: Strict.ByteString -- ^ Serialized 'resourcePath' + , rawMethod :: Strict.ByteString -- ^ Serialized 'resourceMethod' } deriving (Show) +-- | Invalid resource headers +-- +-- See 'parseResourceHeaders' data InvalidResourceHeaders = InvalidMethod Strict.ByteString | InvalidPath Strict.ByteString deriving stock (Show) +-- | Serialize t'ResourceHeaders' (pseudo headers) buildResourceHeaders :: ResourceHeaders -> RawResourceHeaders buildResourceHeaders ResourceHeaders{resourcePath, resourceMethod} = RawResourceHeaders { @@ -41,7 +46,7 @@ buildResourceHeaders ResourceHeaders{resourcePath, resourceMethod} = ] } --- | Parse pseudo headers +-- | Parse t'ResourceHeaders' (pseudo headers) parseResourceHeaders :: RawResourceHeaders -> Either InvalidResourceHeaders ResourceHeaders diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/Request.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/Request.hs index ee523cf1..8c4a880d 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/Request.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/Request.hs @@ -2,7 +2,13 @@ module Network.GRPC.Spec.Serialization.Headers.Request ( buildRequestHeaders + -- + -- Throws an error if any headers fail to parse; if this is not desired, see + -- 'parseRequestHeaders'' instead. , parseRequestHeaders + -- + -- Throws an error if any headers fail to parse; if this is not desired, see + -- 'parseRequestHeaders'' instead. , parseRequestHeaders' ) where @@ -69,7 +75,7 @@ buildRequestHeaders proxy callParams@RequestHeaders{requestMetadata} = concat [ -- .) This means -- @TE@ should come /after/ @Authority@ (if using). However, we will not include -- the reserved headers here /at all/, as they are automatically added by --- `http2`. +-- @http2@. callDefinition :: forall rpc. IsRPC rpc => Proxy rpc -> RequestHeaders -> [HTTP.Header] @@ -132,6 +138,10 @@ callDefinition proxy = \hdrs -> catMaybes [ Parsing -------------------------------------------------------------------------------} +-- | Parse t'RequestHeaders' +-- +-- Throws an error if any headers fail to parse; if this is not desired, see +-- 'parseRequestHeaders'' instead. parseRequestHeaders :: forall rpc m. (IsRPC rpc, MonadError (InvalidHeaders GrpcException) m) => Proxy rpc diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/Response.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/Response.hs index 05f90b3e..0915f857 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/Response.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization/Headers/Response.hs @@ -221,6 +221,10 @@ parseResponseHeaders :: forall rpc m. => Proxy rpc -> [HTTP.Header] -> m ResponseHeaders parseResponseHeaders proxy = HKD.sequenceChecked . parseResponseHeaders' proxy +-- | Generalization of 'parseResponseHeaders' that does not throw errors +-- +-- See also 'Network.GRPC.Spec.parseRequestHeaders' versus +-- ''Network.GRPC.Spec.parseRequestHeaders'' for a similar pair of functions. parseResponseHeaders' :: forall rpc. IsRPC rpc => Proxy rpc -> [HTTP.Header] -> ResponseHeaders' GrpcException @@ -311,7 +315,7 @@ invalidContentType err = invalidHeaderSynthesize GrpcException { > Trailers → Status [Status-Message] *Custom-Metadata -------------------------------------------------------------------------------} --- | Construct the HTTP 'Trailer' header +-- | Construct the HTTP @Trailer@ header -- -- This lists all headers that /might/ be present in the trailers. -- @@ -420,6 +424,13 @@ parseProperTrailers :: forall rpc m. => Proxy rpc -> [HTTP.Header] -> m ProperTrailers parseProperTrailers proxy = HKD.sequenceChecked . parseProperTrailers' proxy +-- | Generalization of 'parseProperTrailers' that does not throw errors. +-- +-- See also 'Network.GRPC.Spec.parseRequestHeaders' versus +-- ''Network.GRPC.Spec.parseRequestHeaders'' for a similar pair of functions. +-- See t'ProperTrailers'' for a discussion of why 'ProperTrailers'' is not +-- parameterized (unlike t'ResponseHeaders'' and +-- t'Network.GRPC.Spec.RequestHeaders''). parseProperTrailers' :: forall rpc. IsRPC rpc => Proxy rpc -> [HTTP.Header] -> ProperTrailers' @@ -453,11 +464,16 @@ parseProperTrailers' proxy hdrs = trailersOnly :: TrailersOnly' GrpcException trailersOnly = parseTrailersOnly' proxy hdrs +-- | Parse t'TrailersOnly' parseTrailersOnly :: forall m rpc. (IsRPC rpc, MonadError (InvalidHeaders GrpcException) m) => Proxy rpc -> [HTTP.Header] -> m TrailersOnly parseTrailersOnly proxy = HKD.sequenceChecked . parseTrailersOnly' proxy +-- | Generalization of 'parseTrailersOnly' does that not throw errors. +-- +-- See also 'Network.GRPC.Spec.parseRequestHeaders' versus +-- ''Network.GRPC.Spec.parseRequestHeaders'' for a similar pair of functions. parseTrailersOnly' :: forall rpc. IsRPC rpc => Proxy rpc -> [HTTP.Header] -> TrailersOnly' GrpcException @@ -542,11 +558,12 @@ parseTrailersOnly' proxy = Pushback -------------------------------------------------------------------------------} +-- | Serialize t'Pushback' buildPushback :: Pushback -> Strict.ByteString buildPushback (RetryAfter n) = BS.Strict.C8.pack $ show n buildPushback DoNotRetry = "-1" --- | Parse 'Pushback' +-- | Parse t'Pushback' -- -- Parsing a pushback cannot fail; the spec mandates: -- diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization/LengthPrefixed.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization/LengthPrefixed.hs index a391fc3a..f1e51ace 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization/LengthPrefixed.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization/LengthPrefixed.hs @@ -129,6 +129,7 @@ buildMsg build compr (meta, x) = mconcat [ Parsing -------------------------------------------------------------------------------} +-- | Parse input parseInput :: SupportsServerRpc rpc => Proxy rpc @@ -136,6 +137,7 @@ parseInput :: -> Parser String (InboundMeta, Input rpc) parseInput = parseMsg . rpcDeserializeInput +-- | Parse output parseOutput :: SupportsClientRpc rpc => Proxy rpc diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization/Status.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization/Status.hs index 8a2a09d5..133331ee 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization/Status.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization/Status.hs @@ -9,6 +9,9 @@ import Network.GRPC.Spec Serialization -------------------------------------------------------------------------------} +-- | Translate 'GrpcStatus to numerical code +-- +-- See buildGrpcStatus :: GrpcStatus -> Word buildGrpcStatus GrpcOk = 0 buildGrpcStatus (GrpcError GrpcCancelled) = 1 @@ -28,6 +31,7 @@ buildGrpcStatus (GrpcError GrpcUnavailable) = 14 buildGrpcStatus (GrpcError GrpcDataLoss) = 15 buildGrpcStatus (GrpcError GrpcUnauthenticated) = 16 +-- | Inverse to 'buildGrpcStatus' parseGrpcStatus :: Word -> Maybe GrpcStatus parseGrpcStatus 0 = Just $ GrpcOk parseGrpcStatus 1 = Just $ GrpcError $ GrpcCancelled diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization/Timeout.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization/Timeout.hs index 26108b28..800417d9 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization/Timeout.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization/Timeout.hs @@ -27,6 +27,7 @@ import Network.GRPC.Spec > Nanosecond → "n" -------------------------------------------------------------------------------} +-- | Serialize t'Timeout' buildTimeout :: Timeout -> Strict.ByteString buildTimeout (Timeout unit val) = mconcat [ BS.Strict.C8.pack $ show $ getTimeoutValue val @@ -39,9 +40,8 @@ buildTimeout (Timeout unit val) = mconcat [ Nanosecond -> "n" ] -parseTimeout :: forall m. - MonadError String m - => Strict.ByteString -> m Timeout +-- | Parse t'Timeout' +parseTimeout :: forall m. MonadError String m => Strict.ByteString -> m Timeout parseTimeout bs = do let (bsVal, bsUnit) = BS.Strict.C8.span isDigit bs diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization/TraceContext.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization/TraceContext.hs index 93fac7ce..51e3b214 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization/TraceContext.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization/TraceContext.hs @@ -23,9 +23,11 @@ import Network.GRPC.Spec Serialization -------------------------------------------------------------------------------} +-- | Serialize t'TraceContext' buildTraceContext :: TraceContext -> Strict.ByteString buildTraceContext = BS.Lazy.toStrict . Binary.encode +-- | Parse t'TraceContext' parseTraceContext :: MonadError String m => Strict.ByteString -> m TraceContext parseTraceContext bs = case Binary.decodeOrFail (BS.Lazy.fromStrict bs) of diff --git a/grpc-spec/src/Network/GRPC/Spec/Status.hs b/grpc-spec/src/Network/GRPC/Spec/Status.hs index 8aa00f78..24714bcf 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Status.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Status.hs @@ -45,7 +45,7 @@ data GrpcError = -- | Invalid argument -- -- The client specified an invalid argument. Note that this differs from - -- 'GrpcFailedPrecondition': 'GrpcInvalidArgument'` indicates arguments that + -- 'GrpcFailedPrecondition': 'GrpcInvalidArgument' indicates arguments that -- are problematic regardless of the state of the system (e.g., a malformed -- file name). | GrpcInvalidArgument @@ -190,6 +190,7 @@ data GrpcException = GrpcException { deriving stock (Show, Eq) deriving anyclass (Exception) +-- | Convenience function to throw an t'GrpcException' with the specified error throwGrpcError :: GrpcError -> IO a throwGrpcError grpcError = throwIO $ GrpcException { grpcError diff --git a/grpc-spec/src/Network/GRPC/Spec/Timeout.hs b/grpc-spec/src/Network/GRPC/Spec/Timeout.hs index 5d1248e6..f3626a6f 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Timeout.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Timeout.hs @@ -15,6 +15,7 @@ import GHC.Show Timeouts -------------------------------------------------------------------------------} +-- | Timeout data Timeout = Timeout TimeoutUnit TimeoutValue deriving stock (Show, Eq, Generic) @@ -25,7 +26,7 @@ newtype TimeoutValue = UnsafeTimeoutValue { deriving newtype (Eq) deriving stock (Generic) --- | 'Show' instance relies on the 'TimeoutValue' pattern synonym +-- | 'Show' instance relies on the v'TimeoutValue' pattern synonym instance Show TimeoutValue where showsPrec p (UnsafeTimeoutValue val) = showParen (p >= appPrec1) $ showString "TimeoutValue " @@ -40,23 +41,32 @@ pattern TimeoutValue t <- UnsafeTimeoutValue t {-# COMPLETE TimeoutValue #-} +-- | Valid timeout values +-- +-- Timeout values cannot exceed 8 digits. If you need a longer timeout, consider +-- using a different 'TimeoutUnit' instead. isValidTimeoutValue :: Word -> Bool isValidTimeoutValue t = length (show t) <= 8 +-- | Timeout unit data TimeoutUnit = - Hour - | Minute - | Second - | Millisecond - | Microsecond - | Nanosecond + Hour -- ^ Hours + | Minute -- ^ Minutes + | Second -- ^ Seconds + | Millisecond -- ^ Milliseconds + | Microsecond -- ^ Microseconds + | Nanosecond -- ^ Nanoseconds + -- + -- Although some servers may be able to interpret this in a + -- meaningful way, /we/ cannot, and round this up to the nearest + -- microsecond. deriving stock (Show, Eq, Generic) {------------------------------------------------------------------------------- Translation -------------------------------------------------------------------------------} --- | Translate 'Timeout' to microseconds +-- | Translate t'Timeout' to microseconds -- -- For 'Nanosecond' timeout we round up. -- diff --git a/grpc-spec/src/Network/GRPC/Spec/TraceContext.hs b/grpc-spec/src/Network/GRPC/Spec/TraceContext.hs index 705cbe13..6626c73b 100644 --- a/grpc-spec/src/Network/GRPC/Spec/TraceContext.hs +++ b/grpc-spec/src/Network/GRPC/Spec/TraceContext.hs @@ -1,6 +1,6 @@ -- | Trace context -- --- See documentation of 'TraceContext'. +-- See documentation of t'TraceContext'. module Network.GRPC.Spec.TraceContext ( -- * Definition TraceContext(..) @@ -40,12 +40,12 @@ import GHC.Generics (Generic) -- -- * The Haskell @opentelemetry@ package calls this a @SpanContext@, but -- provides no binary @PropagationFormat@, and does not support --- 'TraceOptions'. +-- t'TraceOptions'. -- -- -- -- * The Haskell @hs-opentelemetry@ ecosystem defines @SpanContext@, which is --- the combination of the W3C @traceparent@ header (our 'TraceContext') and +-- the combination of the W3C @traceparent@ header (our t'TraceContext') and -- the W3C @tracestate@ header (which we do not support). It too does not -- support the @grpc-trace-bin@ binary format. -- diff --git a/grpc-spec/src/Network/GRPC/Spec/Util/HKD.hs b/grpc-spec/src/Network/GRPC/Spec/Util/HKD.hs index aeb0e90c..87690896 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Util/HKD.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Util/HKD.hs @@ -39,7 +39,14 @@ import Unsafe.Coerce (unsafeCoerce) Definition -------------------------------------------------------------------------------} -data Undecorated (x :: Type) +-- | Marker for undecorated fields +-- +-- @HKD Undecorated x@ is equivalent to simply @x@. See 'HKD' for details. +data Undecorated (x :: Type) + +-- | Marker for fields decorated with type constructor @f@ +-- +-- @HKD (DecoratedWith f) x@ is equivalent to @(f x)@. See 'HKD' for details. data DecoratedWith (f :: Type -> Type) (x :: Type) -- | Marker for fields of HKD types @@ -53,7 +60,7 @@ data DecoratedWith (f :: Type -> Type) (x :: Type) -- > } -- -- The downside of such an approach is that if we don't need that type --- constructor, we must instantiate @f@ to 'Identity', which results in +-- constructor, we must instantiate @f@ to t'Identity', which results in -- syntactic overhead. -- (See also -- [The Haskell Unfolder episode 14: Higher-kinded types] diff --git a/grpc-spec/src/Network/GRPC/Spec/Util/Parser.hs b/grpc-spec/src/Network/GRPC/Spec/Util/Parser.hs index d1fea1ec..ac60551b 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Util/Parser.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Util/Parser.hs @@ -44,7 +44,7 @@ data Result e a = -- | Parsing failed -- -- This implies that we can stop parsing: getting more data won't fix the - -- problem (see also 'InsufficientData') + -- problem (see also 'NeedData') Failed e -- | We make some partial progress, but we need more data to continue @@ -135,6 +135,13 @@ split n acc Construction -------------------------------------------------------------------------------} +-- | Consume a specified number of bytes +-- +-- In order to use the t'Parser' interface we must know for each value exactly +-- how big it will be ahead of time. Typically this will be done by first +-- calling 'consumeExactly' for some kind of fixed size header, indicating how +-- big the value actual value is, which will then inform the next call to +-- 'consumeExactly'. consumeExactly :: forall e a. Int64 -- ^ Length -> (Lazy.ByteString -> Either e a) -- ^ Parser @@ -165,9 +172,15 @@ getExactly len get = Execution -------------------------------------------------------------------------------} -type IsFinal = Bool +-- | Is this the final chunk in the input? +type IsFinal = Bool + +-- | Leftover data type Leftover = Lazy.ByteString +-- | Result from processing all chunks in the input +-- +-- See 'processAll'. data ProcessResult e b = -- | Parse error during processing ProcessError e @@ -192,8 +205,8 @@ data ProcessResult e b = -- > empty chunk -- marked final -- -- In the former case, we know that we are processing the final message /as/ - -- we are processing it ('ProcessedFinal'); in the latter case, we realize - -- this only after we receive the final empty chunk. + -- we are processing it ('ProcessedWithFinal'); in the latter case, we + -- realize this only after we receive the final empty chunk. | ProcessedWithoutFinal Leftover -- | Process all incoming data From 034a2d91f43dd894b5e38251abdc12d000672162 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Fri, 25 Oct 2024 09:17:28 +0200 Subject: [PATCH 3/3] Move back to using `data-default` See https://github.com/commercialhaskell/stackage/issues/7545 for rationale. --- grapesy/grapesy.cabal | 2 +- grapesy/src/Network/GRPC/Client/Connection.hs | 2 +- grapesy/src/Network/GRPC/Common.hs | 2 +- grapesy/src/Network/GRPC/Common/Compression.hs | 2 +- grapesy/src/Network/GRPC/Common/HTTP2Settings.hs | 2 +- grapesy/src/Network/GRPC/Util/TLS.hs | 2 +- grpc-spec/grpc-spec.cabal | 2 +- grpc-spec/src/Network/GRPC/Spec/Call.hs | 2 +- grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs | 2 +- grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs | 2 +- grpc-spec/src/Network/GRPC/Spec/MessageMeta.hs | 2 +- grpc-spec/src/Network/GRPC/Spec/Serialization/TraceContext.hs | 2 +- grpc-spec/src/Network/GRPC/Spec/TraceContext.hs | 2 +- 13 files changed, 13 insertions(+), 13 deletions(-) diff --git a/grapesy/grapesy.cabal b/grapesy/grapesy.cabal index 8a492a53..375f6aa5 100644 --- a/grapesy/grapesy.cabal +++ b/grapesy/grapesy.cabal @@ -150,7 +150,7 @@ library , crypton-x509 >= 1.7 && < 1.8 , crypton-x509-store >= 1.6 && < 1.7 , crypton-x509-system >= 1.6 && < 1.7 - , data-default-class >= 0.1 && < 0.2 + , data-default >= 0.7 && < 0.9 , deepseq >= 1.4 && < 1.6 , exceptions >= 0.10 && < 0.11 , grpc-spec >= 0.1 && < 0.2 diff --git a/grapesy/src/Network/GRPC/Client/Connection.hs b/grapesy/src/Network/GRPC/Client/Connection.hs index f862efe2..5e7e10e0 100644 --- a/grapesy/src/Network/GRPC/Client/Connection.hs +++ b/grapesy/src/Network/GRPC/Client/Connection.hs @@ -29,7 +29,7 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Monad import Control.Monad.Catch -import Data.Default.Class +import Data.Default import GHC.Stack import Network.HPACK qualified as HPACK import Network.HTTP2.Client qualified as HTTP2.Client diff --git a/grapesy/src/Network/GRPC/Common.hs b/grapesy/src/Network/GRPC/Common.hs index bf740398..4de8aa32 100644 --- a/grapesy/src/Network/GRPC/Common.hs +++ b/grapesy/src/Network/GRPC/Common.hs @@ -80,7 +80,7 @@ module Network.GRPC.Common ( , Default(..) ) where -import Data.Default.Class +import Data.Default import Data.Proxy import Network.Socket (PortNumber) diff --git a/grapesy/src/Network/GRPC/Common/Compression.hs b/grapesy/src/Network/GRPC/Common/Compression.hs index d1cfb3fe..c273374c 100644 --- a/grapesy/src/Network/GRPC/Common/Compression.hs +++ b/grapesy/src/Network/GRPC/Common/Compression.hs @@ -28,7 +28,7 @@ module Network.GRPC.Common.Compression ( , insist ) where -import Data.Default.Class +import Data.Default import Data.Foldable (toList) import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty qualified as NE diff --git a/grapesy/src/Network/GRPC/Common/HTTP2Settings.hs b/grapesy/src/Network/GRPC/Common/HTTP2Settings.hs index 8f7bf24e..83514442 100644 --- a/grapesy/src/Network/GRPC/Common/HTTP2Settings.hs +++ b/grapesy/src/Network/GRPC/Common/HTTP2Settings.hs @@ -7,7 +7,7 @@ module Network.GRPC.Common.HTTP2Settings , defaultHTTP2Settings ) where -import Data.Default.Class +import Data.Default import Data.Word -- | HTTP\/2 settings diff --git a/grapesy/src/Network/GRPC/Util/TLS.hs b/grapesy/src/Network/GRPC/Util/TLS.hs index 01cc8717..1074218a 100644 --- a/grapesy/src/Network/GRPC/Util/TLS.hs +++ b/grapesy/src/Network/GRPC/Util/TLS.hs @@ -23,7 +23,7 @@ module Network.GRPC.Util.TLS ( ) where import Control.Exception -import Data.Default.Class +import Data.Default import Data.X509 qualified as X509 import Data.X509.CertificateStore qualified as X509 import System.Environment diff --git a/grpc-spec/grpc-spec.cabal b/grpc-spec/grpc-spec.cabal index c41db5f8..d343f743 100644 --- a/grpc-spec/grpc-spec.cabal +++ b/grpc-spec/grpc-spec.cabal @@ -131,7 +131,7 @@ library , bytestring >= 0.10.12 && < 0.13 , case-insensitive >= 1.2 && < 1.3 , containers >= 0.6 && < 0.8 - , data-default-class >= 0.1 && < 0.2 + , data-default >= 0.7 && < 0.9 , deepseq >= 1.4 && < 1.6 , exceptions >= 0.10 && < 0.11 , hashable >= 1.3 && < 1.5 diff --git a/grpc-spec/src/Network/GRPC/Spec/Call.hs b/grpc-spec/src/Network/GRPC/Spec/Call.hs index 8a03c7f4..6f90eaf0 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Call.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Call.hs @@ -5,7 +5,7 @@ module Network.GRPC.Spec.Call ( , callRequestMetadata ) where -import Data.Default.Class +import Data.Default import Data.Functor.Const import Network.GRPC.Spec.CustomMetadata.Typed diff --git a/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs b/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs index d614defc..5dc9f509 100644 --- a/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs +++ b/grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs @@ -3,7 +3,7 @@ module Network.GRPC.Spec.CustomMetadata.NoMetadata ( ) where import Control.Monad.Catch -import Data.Default.Class +import Data.Default import Network.GRPC.Spec.CustomMetadata.Typed diff --git a/grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs b/grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs index 33851690..a9a800fb 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs @@ -22,7 +22,7 @@ module Network.GRPC.Spec.Headers.Common ( ) where import Data.ByteString qualified as Strict (ByteString) -import Data.Default.Class +import Data.Default import Data.Proxy import GHC.Generics (Generic) diff --git a/grpc-spec/src/Network/GRPC/Spec/MessageMeta.hs b/grpc-spec/src/Network/GRPC/Spec/MessageMeta.hs index da19dfe9..ff106ee4 100644 --- a/grpc-spec/src/Network/GRPC/Spec/MessageMeta.hs +++ b/grpc-spec/src/Network/GRPC/Spec/MessageMeta.hs @@ -5,7 +5,7 @@ module Network.GRPC.Spec.MessageMeta ( ) where import Control.DeepSeq (NFData) -import Data.Default.Class +import Data.Default import Data.Word import GHC.Generics (Generic) diff --git a/grpc-spec/src/Network/GRPC/Spec/Serialization/TraceContext.hs b/grpc-spec/src/Network/GRPC/Spec/Serialization/TraceContext.hs index 51e3b214..c18061d0 100644 --- a/grpc-spec/src/Network/GRPC/Spec/Serialization/TraceContext.hs +++ b/grpc-spec/src/Network/GRPC/Spec/Serialization/TraceContext.hs @@ -13,7 +13,7 @@ import Data.Binary.Get qualified as Get import Data.Binary.Put qualified as Put import Data.ByteString qualified as Strict (ByteString) import Data.ByteString.Lazy qualified as BS.Lazy -import Data.Default.Class +import Data.Default import Data.Maybe (maybeToList) import Data.Word diff --git a/grpc-spec/src/Network/GRPC/Spec/TraceContext.hs b/grpc-spec/src/Network/GRPC/Spec/TraceContext.hs index 6626c73b..c82abcc3 100644 --- a/grpc-spec/src/Network/GRPC/Spec/TraceContext.hs +++ b/grpc-spec/src/Network/GRPC/Spec/TraceContext.hs @@ -12,7 +12,7 @@ module Network.GRPC.Spec.TraceContext ( import Data.ByteString qualified as Strict (ByteString) import Data.ByteString.Base16 qualified as BS.Strict.Base16 import Data.ByteString.Char8 qualified as BS.Strict.Char8 -import Data.Default.Class +import Data.Default import Data.String import GHC.Generics (Generic)