Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

More cleanup and docs #246

Merged
merged 3 commits into from
Oct 25, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion grapesy/grapesy.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion grapesy/src/Network/GRPC/Client/Connection.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion grapesy/src/Network/GRPC/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -80,7 +80,7 @@ module Network.GRPC.Common (
, Default(..)
) where

import Data.Default.Class
import Data.Default
import Data.Proxy
import Network.Socket (PortNumber)

Expand Down
2 changes: 1 addition & 1 deletion grapesy/src/Network/GRPC/Common/Compression.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion grapesy/src/Network/GRPC/Common/HTTP2Settings.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ module Network.GRPC.Common.HTTP2Settings
, defaultHTTP2Settings
) where

import Data.Default.Class
import Data.Default
import Data.Word

-- | HTTP\/2 settings
Expand Down
2 changes: 1 addition & 1 deletion grapesy/src/Network/GRPC/Util/TLS.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion grpc-spec/grpc-spec.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions grpc-spec/src/Network/GRPC/Spec/Call.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
6 changes: 5 additions & 1 deletion grpc-spec/src/Network/GRPC/Spec/Compression.hs
Original file line number Diff line number Diff line change
Expand Up @@ -95,13 +95,15 @@ data CompressionId =
| Custom String
deriving stock (Eq, Ord, Generic)

-- | Serialize compression ID
serializeCompressionId :: CompressionId -> Strict.ByteString
serializeCompressionId Identity = "identity"
serializeCompressionId GZip = "gzip"
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
Expand All @@ -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
Expand All @@ -130,6 +133,7 @@ noCompression = Compression {
, uncompressedSizeThreshold = const False
}

-- | @gzip@
gzip :: Compression
gzip = Compression {
compressionId = GZip
Expand All @@ -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
Expand Down
8 changes: 4 additions & 4 deletions grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Map.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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]
Expand All @@ -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.
Expand Down
10 changes: 1 addition & 9 deletions grpc-spec/src/Network/GRPC/Spec/CustomMetadata/NoMetadata.hs
Original file line number Diff line number Diff line change
@@ -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 Data.Default

import Network.GRPC.Spec.CustomMetadata.Raw
import Network.GRPC.Spec.CustomMetadata.Typed

-- | Indicate the absence of custom metadata
Expand All @@ -26,8 +23,3 @@ instance ParseMetadata NoMetadata where

instance StaticMetadata NoMetadata where
metadataHeaderNames _ = []

data UnexpectedMetadata = UnexpectedMetadata [CustomMetadata]
deriving stock (Show)
deriving anyclass (Exception)

14 changes: 12 additions & 2 deletions grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Raw.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 "
Expand All @@ -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
Expand Down
9 changes: 9 additions & 0 deletions grpc-spec/src/Network/GRPC/Spec/CustomMetadata/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ module Network.GRPC.Spec.CustomMetadata.Typed (
, BuildMetadata(..)
, StaticMetadata(..)
, ParseMetadata(..)
, UnexpectedMetadata(..)
, buildMetadataIO
) where

Expand Down Expand Up @@ -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)

4 changes: 3 additions & 1 deletion grpc-spec/src/Network/GRPC/Spec/Headers/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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
Expand All @@ -77,6 +78,7 @@ data MessageType =
instance Default MessageType where
def = MessageTypeDefault

-- | Interpret 'MessageType'
chooseMessageType ::
IsRPC rpc
=> Proxy rpc -> MessageType -> Maybe Strict.ByteString
Expand Down
14 changes: 13 additions & 1 deletion grpc-spec/src/Network/GRPC/Spec/Headers/Invalid.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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',
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 {}

Expand All @@ -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')
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down
13 changes: 7 additions & 6 deletions grpc-spec/src/Network/GRPC/Spec/Headers/Response.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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))
Expand Down Expand Up @@ -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
Expand Down
Loading