From 7b11f68b218bb6fe93a35a5371ee21a9d49de070 Mon Sep 17 00:00:00 2001
From: Finley McIlwaine <finleymcilwaine@gmail.com>
Date: Mon, 22 Jan 2024 21:12:39 -0800
Subject: [PATCH] WIP: Add deflate compression

---
 demo-client/Demo/Client/Cmdline.hs     |  4 ++++
 docs/demo-client.md                    | 10 +++++-----
 src/Network/GRPC/Common/Compression.hs |  1 +
 src/Network/GRPC/Spec.hs               |  1 +
 src/Network/GRPC/Spec/Compression.hs   | 12 +++++++++++-
 5 files changed, 22 insertions(+), 6 deletions(-)

diff --git a/demo-client/Demo/Client/Cmdline.hs b/demo-client/Demo/Client/Cmdline.hs
index 69851e0d..f006fa82 100644
--- a/demo-client/Demo/Client/Cmdline.hs
+++ b/demo-client/Demo/Client/Cmdline.hs
@@ -180,6 +180,10 @@ parseCompression = asum [
           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"
+        ]
     ]
 
 parseAPI :: Opt.Parser API
diff --git a/docs/demo-client.md b/docs/demo-client.md
index 1379ba41..576aaca0 100644
--- a/docs/demo-client.md
+++ b/docs/demo-client.md
@@ -138,15 +138,15 @@ actually compress anything:
   https://github.com/grpc/grpc/blob/master/examples/python/compression/README.md
 * You need to send a "name" that is long enough that the server actually
   bothers with compression at all.
-* You can also use the `--gzip` command line flag to tell the server to /only/
-  use GZip compression.
+* You can also use the `--gzip` or `--deflate` command line flag to tell the
+  server to *only* use GZip or Deflate compression, respectively.
 
 For example:
 
 ```
-cabal run demo-client -- --gzip sayHello \
-  --name 'John' \
-  --name '0xxxxxxxxxx1xxxxxxxxxx2xxxxxxxxxx3xxxxxxxxxx4xxxxxxxxxx5xxxxxxxxxx'
+cabal run demo-client -- --gzip \
+  sayHello --name 'John' \
+  sayHello --name '0xxxxxxxxxx1xxxxxxxxxx2xxxxxxxxxx3xxxxxxxxxx4xxxxxxxxxx5xxxxxxxxxx'
 ```
 
 Of course, the compression is transparent to the user, but you can observe it
diff --git a/src/Network/GRPC/Common/Compression.hs b/src/Network/GRPC/Common/Compression.hs
index 9fa9657a..afa49fff 100644
--- a/src/Network/GRPC/Common/Compression.hs
+++ b/src/Network/GRPC/Common/Compression.hs
@@ -11,6 +11,7 @@ module Network.GRPC.Common.Compression (
     -- * Standard compression schemes
   , noCompression
   , gzip
+  , deflate
   , allSupportedCompression
     -- * Negotation
   , Negotation(..)
diff --git a/src/Network/GRPC/Spec.hs b/src/Network/GRPC/Spec.hs
index ebf570c4..043fb7c7 100644
--- a/src/Network/GRPC/Spec.hs
+++ b/src/Network/GRPC/Spec.hs
@@ -40,6 +40,7 @@ module Network.GRPC.Spec (
     -- ** Compression algorithms
   , noCompression
   , gzip
+  , deflate
   , allSupportedCompression
     -- * Requests
   , RequestHeaders(..)
diff --git a/src/Network/GRPC/Spec/Compression.hs b/src/Network/GRPC/Spec/Compression.hs
index f6d727b8..0c215d9d 100644
--- a/src/Network/GRPC/Spec/Compression.hs
+++ b/src/Network/GRPC/Spec/Compression.hs
@@ -15,9 +15,11 @@ module Network.GRPC.Spec.Compression (
     -- * Specific coders
   , noCompression
   , gzip
+  , deflate
   ) where
 
 import Codec.Compression.GZip qualified as GZip
+import Codec.Compression.Zlib.Raw qualified as Deflate
 import Data.ByteString qualified as Strict (ByteString)
 import Data.ByteString.Lazy qualified as Lazy (ByteString)
 import Data.ByteString.UTF8 qualified as BS.Strict.UTF8
@@ -50,7 +52,7 @@ instance Show Compression where
 -- The order of this list is important: algorithms listed earlier are preferred
 -- over algorithms listed later.
 allSupportedCompression :: NonEmpty Compression
-allSupportedCompression = gzip :| [noCompression]
+allSupportedCompression = gzip :| [deflate, noCompression]
 
 {-------------------------------------------------------------------------------
   Compression ID
@@ -110,4 +112,12 @@ gzip = Compression {
       compressionId = GZip
     , compress      = GZip.compress
     , decompress    = GZip.decompress
+    }
+
+-- TODO: We should deal with exceptions during decompression
+deflate :: Compression
+deflate = Compression {
+      compressionId = Deflate
+    , compress      = Deflate.compress
+    , decompress    = Deflate.decompress
     }
\ No newline at end of file