Remove references to SNAPPY from grapesy

It's only `grpc-spec` now that has this flag; `grapesy` instead uses `allSupportedCompression` to figure out which algorithms are supported.
well-typed · Oct 25, 2024 · 8259b3b · 8259b3b
1 parent af94605
commit 8259b3b
Show file tree

Hide file tree

Showing 7 changed files with 55 additions and 97 deletions.
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/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/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
@@ -20,6 +20,7 @@ module Test.Stress.Cmdline
   ) where
 
 import Control.Applicative
+import Data.Foldable (toList)
 import Network.Socket (HostName, PortNumber)
 import Options.Applicative qualified as Opt
 
@@ -51,7 +52,7 @@ data Role =
         , clientConnects   :: [Connect]
 
           -- | Insist on this compression scheme for all messages
-        , clientCompression :: Spec.Compression
+        , clientCompression :: Maybe Spec.Compression
         }
 
       -- | Run the server
@@ -184,7 +185,7 @@ parseClientRole defaultPub =
       <$> parseClientSecurity defaultPub
       <*> parseClientPort
       <*> parseClientConnects
-      <*> parseCompression
+      <*> Opt.optional parseCompression
 
 parseClientSecurity :: FilePath -> Opt.Parser (Maybe Client.ServerValidation)
 parseClientSecurity defaultPub =
@@ -303,35 +304,16 @@ parseCall =
                 ])
 
 parseCompression :: Opt.Parser Spec.Compression
-parseCompression =
-        gzip
-    <|> deflate
-#ifdef SNAPPY
-    <|> snappy
-#endif
-    <|> pure Spec.noCompression
+parseCompression = asum $ map go (toList Spec.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 :: Spec.Compression -> Opt.Parser Spec.Compression
+    go compr = Opt.flag' compr $ mconcat [
+          Opt.long comprId
+        , Opt.help $ "Insist on " ++ comprId ++ " compression "
+        ]
+      where
+        comprId :: String
+        comprId = show (Spec.compressionId compr)
 
 -------------------------------------------------------------------------------
 -- Server option parsers

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