Merge pull request #247 from well-typed/edsko/snappy

Remove references to `SNAPPY` from `grapesy`
well-typed · Oct 25, 2024 · c11e39b · c11e39b
2 parents af94605 + 8ee46de
commit c11e39b
Show file tree

Hide file tree

Showing 18 changed files with 68 additions and 117 deletions.
diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml
@@ -42,9 +42,9 @@ jobs:
             compilerVersion: 9.8.2
             setup-method: ghcup
             allow-failure: false
-          - compiler: ghc-9.6.4
+          - compiler: ghc-9.6.6
             compilerKind: ghc
-            compilerVersion: 9.6.4
+            compilerVersion: 9.6.6
             setup-method: ghcup
             allow-failure: false
           - compiler: ghc-9.4.8

diff --git a/grapesy/demo-client/Demo/Client/Cmdline.hs b/grapesy/demo-client/Demo/Client/Cmdline.hs
@@ -16,7 +16,7 @@ module Demo.Client.Cmdline (
 
 import Prelude
 
-import Data.Foldable (asum)
+import Data.Foldable (asum, toList)
 import Data.Int
 import Data.Kind
 import Data.Maybe (fromMaybe)
@@ -181,22 +181,16 @@ parseServerValidation defaultPub =
             ]
 
 parseCompression :: Opt.Parser Compression
-parseCompression = asum [
-      Opt.flag' Compr.gzip $ mconcat [
-          Opt.long "gzip"
-        , Opt.help "Use GZip compression for all messages"
-        ]
-    , Opt.flag' Compr.deflate $ mconcat [
-          Opt.long "deflate"
-        , Opt.help "Use deflate compression for all messages"
-        ]
-#ifdef SNAPPY
-    , Opt.flag' Compr.snappy $ mconcat [
-          Opt.long "snappy"
-        , Opt.help "Use snappy compression for all messages"
+parseCompression = asum $ map go (toList Compr.allSupportedCompression)
+  where
+    go :: Compression -> Opt.Parser Compression
+    go compr = Opt.flag' compr $ mconcat [
+          Opt.long comprId
+        , Opt.help $ "Use " ++ comprId ++ " compression for all messages"
         ]
-#endif
-    ]
+      where
+        comprId :: String
+        comprId = show (Compr.compressionId compr)
 
 parseAPI :: Opt.Parser API
 parseAPI = asum [

diff --git a/grapesy/grapesy.cabal b/grapesy/grapesy.cabal
@@ -22,7 +22,7 @@ data-files:         route_guide_db.json
 tested-with:        GHC==8.10.7
                   , GHC==9.2.8
                   , GHC==9.4.8
-                  , GHC==9.6.4
+                  , GHC==9.6.6
                   , GHC==9.8.2
                   , GHC==9.10.1
 
@@ -248,7 +248,6 @@ test-suite test-grapesy
     , containers
     , deepseq
     , exceptions
-    , grpc-spec
     , http-types
     , http2
     , mtl
@@ -387,7 +386,6 @@ test-suite test-stress
     , async
     , bytestring
     , exceptions
-    , grpc-spec
     , http2
     , network
     , tls

diff --git a/grapesy/proto/Proto/API/Trivial.hs b/grapesy/proto/Proto/API/Trivial.hs
@@ -7,7 +7,7 @@ module Proto.API.Trivial
   ) where
 
 import Network.GRPC.Common
-import Network.GRPC.Spec
+import Network.GRPC.Common.Binary
 
 {-------------------------------------------------------------------------------
   Trivial RPC

diff --git a/grapesy/src/Network/GRPC/Client/Session.hs b/grapesy/src/Network/GRPC/Client/Session.hs
@@ -109,8 +109,6 @@ instance SupportsClientRpc rpc => InitiateSession (ClientSession rpc) where
           case verifyAllIf connVerifyHeaders responseHeaders of
             Left  err  -> throwIO $ CallSetupInvalidResponseHeaders err
             Right hdrs -> do
-              -- TODO: <https://github.com/well-typed/grapesy/issues/203>
-              -- If we omit this call to 'updateConnectionMeta', no tests fail.
               Connection.updateConnectionMeta conn responseHeaders
               cIn <- getCompression $ requiredResponseCompression hdrs
               return $ FlowStartRegular $ InboundHeaders {

diff --git a/grapesy/src/Network/GRPC/Common/Compression.hs b/grapesy/src/Network/GRPC/Common/Compression.hs
@@ -11,12 +11,7 @@ module Network.GRPC.Common.Compression (
     Compression(..)
   , CompressionId(..)
     -- * Standard compression schemes
-  , noCompression
   , gzip
-  , deflate
-#ifdef SNAPPY
-  , snappy
-#endif
   , allSupportedCompression
     -- * Negotation
   , Negotation(..)

diff --git a/grapesy/src/Network/GRPC/Util/Session/Channel.hs b/grapesy/src/Network/GRPC/Util/Session/Channel.hs
@@ -141,9 +141,6 @@ data RegularFlowState flow = RegularFlowState {
       -- This TMVar is written to for incoming messages ('recvMessageLoop') and
       -- read from for outgoing messages ('sendMessageLoop'). It acts as a
       -- one-place buffer, providing backpressure in both directions.
-      --
-      -- TODO: <https://github.com/well-typed/grapesy/issues/118>.
-      -- It might make sense to generalize this to an @N@-place buffer.
     , flowMsg :: TMVar (StreamElem (Trailers flow) (Message flow))
 
       -- | Trailers

diff --git a/grapesy/test-grapesy/Test/Sanity/Disconnect.hs b/grapesy/test-grapesy/Test/Sanity/Disconnect.hs
@@ -37,7 +37,6 @@ import Network.GRPC.Common
 import Network.GRPC.Server qualified as Server
 import Network.GRPC.Server.Binary qualified as Binary
 import Network.GRPC.Server.Run
-import Network.GRPC.Spec
 
 import Proto.API.Trivial
 

diff --git a/grapesy/test-grapesy/Test/Sanity/StreamingType/NonStreaming.hs b/grapesy/test-grapesy/Test/Sanity/StreamingType/NonStreaming.hs
@@ -18,6 +18,7 @@ import Network.GRPC.Server.StreamType qualified as Server
 import Network.GRPC.Server.StreamType.Binary qualified as Binary
 
 import Test.Driver.ClientServer
+import Data.Foldable (toList)
 
 tests :: TestTree
 tests = testGroup "Test.Sanity.StreamingType.NonStreaming" [
@@ -79,33 +80,29 @@ tests = testGroup "Test.Sanity.StreamingType.NonStreaming" [
                 ]
             ]
         , testGroup "compression" [
-              testCase "gzip" $
-                test_increment def {
-                    clientCompr = Compr.only Compr.gzip
-                  , serverCompr = Compr.only Compr.gzip
-                  }
-            , testCase "deflate" $
-                test_increment def {
-                    clientCompr = Compr.only Compr.deflate
-                  , serverCompr = Compr.only Compr.deflate
-                  }
-#ifdef SNAPPY
-            , testCase "snappy" $
-                test_increment def {
-                    clientCompr = Compr.only Compr.snappy
-                  , serverCompr = Compr.only Compr.snappy
-                  }
-#endif
-            , testCase "clientChoosesUnsupported" $
-                test_increment def {
-                    clientInitCompr = Just Compr.gzip
-                  , serverCompr     = Compr.none
-                  }
-            , testCase "serverChoosesUnsupported" $
-                test_increment def {
-                    clientCompr = Compr.only   Compr.gzip
-                  , serverCompr = Compr.insist Compr.deflate
-                  }
+              testGroup "supported" $
+                let mkTest :: Compr.Compression -> TestTree
+                    mkTest compr = testCase comprId $
+                        test_increment def {
+                            clientCompr = Compr.only compr
+                          , serverCompr = Compr.only compr
+                          }
+                      where
+                        comprId :: String
+                        comprId = show (Compr.compressionId compr)
+                in map mkTest (toList Compr.allSupportedCompression)
+            , testGroup "unsupported" [
+                  testCase "clientChoosesUnsupported" $
+                    test_increment def {
+                        clientInitCompr = Just Compr.gzip
+                      , serverCompr     = Compr.none
+                      }
+                , testCase "serverChoosesUnsupported" $
+                    test_increment def {
+                        clientCompr = Compr.none
+                      , serverCompr = Compr.insist Compr.gzip
+                      }
+                ]
             ]
         ]
     ]

diff --git a/grapesy/test-stress/Test/Stress/Client.hs b/grapesy/test-stress/Test/Stress/Client.hs
@@ -29,7 +29,7 @@ client ::
      Bool
   -> Maybe ServerValidation
   -> PortNumber
-  -> Compression
+  -> Maybe Compression
   -> [Connect]
   -> IO ()
 client v mServerValidation serverPort compr =
@@ -39,7 +39,7 @@ runConnect ::
      Bool
   -> Maybe ServerValidation
   -> PortNumber
-  -> Compression
+  -> Maybe Compression
   -> Connect
   -> IO ()
 runConnect v mServerValidation serverPort compr Connect{..} = do
@@ -60,14 +60,14 @@ runCalls ::
      Bool
   -> Maybe ServerValidation
   -> PortNumber
-  -> Compression
+  -> Maybe Compression
   -> Int
   -> (Int, [Call])
   -> IO ()
 runCalls v mServerValidation serverPort compr callNum (connNum, calls) = do
     say' v serverPort msg
     let connParams = def {
-            connCompression = Compr.insist compr
+            connCompression = maybe Compr.none Compr.insist compr
           , connHTTP2Settings = def {
                 http2TcpAbortiveClose = True
               }
@@ -127,7 +127,7 @@ runCalls v mServerValidation serverPort compr callNum (connNum, calls) = do
              Just _ -> "secure "
              Nothing -> "insecure "
         ++ "server at port " ++ show serverPort ++ " with compression "
-        ++ show (Compr.compressionId compr)
+        ++ maybe "none" (show . Compr.compressionId) compr
 
 runCall :: Bool -> PortNumber -> Connection -> Call -> IO ()
 runCall v p conn =

diff --git a/grapesy/test-stress/Test/Stress/Cmdline.hs b/grapesy/test-stress/Test/Stress/Cmdline.hs
@@ -19,14 +19,16 @@ module Test.Stress.Cmdline
   , getCmdline
   ) where
 
-import Control.Applicative
+import Control.Applicative ((<|>))
+import Data.Foldable (asum, toList)
 import Network.Socket (HostName, PortNumber)
 import Options.Applicative qualified as Opt
 
 import Network.GRPC.Client qualified as Client
 import Network.GRPC.Common
+import Network.GRPC.Common.Compression (Compression)
+import Network.GRPC.Common.Compression qualified as Compr
 import Network.GRPC.Server.Run
-import Network.GRPC.Spec qualified as Spec
 
 import Paths_grapesy
 
@@ -51,7 +53,7 @@ data Role =
         , clientConnects   :: [Connect]
 
           -- | Insist on this compression scheme for all messages
-        , clientCompression :: Spec.Compression
+        , clientCompression :: Maybe Compression
         }
 
       -- | Run the server
@@ -184,7 +186,7 @@ parseClientRole defaultPub =
       <$> parseClientSecurity defaultPub
       <*> parseClientPort
       <*> parseClientConnects
-      <*> parseCompression
+      <*> Opt.optional parseCompression
 
 parseClientSecurity :: FilePath -> Opt.Parser (Maybe Client.ServerValidation)
 parseClientSecurity defaultPub =
@@ -302,36 +304,17 @@ parseCall =
                 , Opt.metavar "N"
                 ])
 
-parseCompression :: Opt.Parser Spec.Compression
-parseCompression =
-        gzip
-    <|> deflate
-#ifdef SNAPPY
-    <|> snappy
-#endif
-    <|> pure Spec.noCompression
+parseCompression :: Opt.Parser Compression
+parseCompression = asum $ map go (toList Compr.allSupportedCompression)
   where
-    gzip :: Opt.Parser Spec.Compression
-    gzip =
-        Opt.flag' Spec.gzip $ mconcat [
-            Opt.long "gzip"
-          , Opt.help "Insist on gzip compression"
-          ]
-
-    deflate :: Opt.Parser Spec.Compression
-    deflate =
-        Opt.flag' Spec.deflate $ mconcat [
-            Opt.long "deflate"
-          , Opt.help "Insist on deflate compression"
-          ]
-#ifdef SNAPPY
-    snappy :: Opt.Parser Spec.Compression
-    snappy =
-        Opt.flag' Spec.snappy $ mconcat [
-            Opt.long "snappy"
-          , Opt.help "Insist on snappy compression"
-          ]
-#endif
+    go :: Compression -> Opt.Parser Compression
+    go compr = Opt.flag' compr $ mconcat [
+          Opt.long comprId
+        , Opt.help $ "Insist on " ++ comprId ++ " compression "
+        ]
+      where
+        comprId :: String
+        comprId = show (Compr.compressionId compr)
 
 -------------------------------------------------------------------------------
 -- Server option parsers

diff --git a/grpc-spec/grpc-spec.cabal b/grpc-spec/grpc-spec.cabal
@@ -17,7 +17,7 @@ extra-doc-files:    CHANGELOG.md
 tested-with:        GHC==8.10.7
                   , GHC==9.2.8
                   , GHC==9.4.8
-                  , GHC==9.6.4
+                  , GHC==9.6.6
                   , GHC==9.8.2
                   , GHC==9.10.1
 

diff --git a/grpc-spec/src/Network/GRPC/Spec.hs b/grpc-spec/src/Network/GRPC/Spec.hs
@@ -51,16 +51,11 @@ module Network.GRPC.Spec (
     -- * Compression
   , CompressionId(..)
   , Compression(..)
-  , serializeCompressionId
-  , deserializeCompressionId
-    -- ** Compression algorithms
   , noCompression
   , gzip
-  , deflate
-#ifdef SNAPPY
-  , snappy
-#endif
   , allSupportedCompression
+  , serializeCompressionId
+  , deserializeCompressionId
     -- * Message metadata
   , OutboundMeta(..)
   , InboundMeta(..)

diff --git a/grpc-spec/src/Network/GRPC/Spec/Compression.hs b/grpc-spec/src/Network/GRPC/Spec/Compression.hs
@@ -7,19 +7,14 @@
 module Network.GRPC.Spec.Compression (
     -- * Definition
     Compression(..)
+  , noCompression
+  , gzip
   , allSupportedCompression
   , compressionIsIdentity
     -- ** ID
   , CompressionId(..)
   , serializeCompressionId
   , deserializeCompressionId
-    -- * Specific coders
-  , noCompression
-  , gzip
-  , deflate
-#ifdef SNAPPY
-  , snappy
-#endif
   ) where
 
 import Codec.Compression.GZip qualified as GZip

diff --git a/tutorials/basics/basics.cabal b/tutorials/basics/basics.cabal
@@ -13,7 +13,7 @@ data-files:         route_guide_db.json
 tested-with:        GHC==8.10.7
                   , GHC==9.2.8
                   , GHC==9.4.8
-                  , GHC==9.6.4
+                  , GHC==9.6.6
                   , GHC==9.8.2
 
 custom-setup

diff --git a/tutorials/lowlevel/lowlevel.cabal b/tutorials/lowlevel/lowlevel.cabal
@@ -13,7 +13,7 @@ data-files:         route_guide_db.json
 tested-with:        GHC==8.10.7
                   , GHC==9.2.8
                   , GHC==9.4.8
-                  , GHC==9.6.4
+                  , GHC==9.6.6
                   , GHC==9.8.2
 
 custom-setup

diff --git a/tutorials/metadata/metadata.cabal b/tutorials/metadata/metadata.cabal
@@ -11,7 +11,7 @@ extra-source-files: proto/fileserver.proto
 tested-with:        GHC==8.10.7
                   , GHC==9.2.8
                   , GHC==9.4.8
-                  , GHC==9.6.4
+                  , GHC==9.6.6
                   , GHC==9.8.2
 
 custom-setup