datastar-hs-zlib (empty) → 1.0.0.0

raw patch · 6 files changed

+269/−0 lines, 6 filesdep +basedep +bytestringdep +datastar-hs

Dependencies added: base, bytestring, datastar-hs, datastar-hs-zlib, hspec, streaming-commons, wai, zlib

Files

• CHANGELOG.md +7/−0
• LICENSE +7/−0
• datastar-hs-zlib.cabal +69/−0
• src/Hypermedia/Datastar/Compression/Zlib.hs +68/−0
• test/Hypermedia/Datastar/Compression/ZlibSpec.hs +110/−0
• test/Main.hs +8/−0

@@ -0,0 +1,7 @@+# Revision history for datastar-hs-zlib++## 1.0.0.0 -- 2026-07-04++* First release. `Hypermedia.Datastar.Compression.Zlib` (gzip and deflate+  compressors), split out of `datastar-hs` 1.0.x so the core package has no+  system-library dependencies.

@@ -0,0 +1,7 @@+Copyright © Star Federation++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,69 @@+cabal-version:   3.0+name:            datastar-hs-zlib+version:         1.0.0.0+synopsis:        gzip and deflate compressors for datastar-hs+description:+  @gzip@ and @deflate@ @Content-Encoding@ compressors for+  <https://hackage.haskell.org/package/datastar-hs datastar-hs> SSE streams.+  .+  Links against the system zlib C library. On macOS the headers ship with the+  Xcode Command Line Tools; on Debian/Ubuntu install @zlib1g-dev@. To build+  with no system library at all, add the constraint @zlib +bundled-c-zlib@.+homepage:        https://github.com/starfederation/datastar-haskell+bug-reports:     https://github.com/starfederation/datastar-haskell/issues+license:         MIT+license-file:    LICENSE+author:          Carlo Hamalainen+maintainer:      carlo@carlo-hamalainen.net+category:        Web, Hypermedia+build-type:      Simple+extra-doc-files: CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/starfederation/datastar-haskell.git++common warnings+  ghc-options:+    -Wall+    -Wcompat+    -Wunused-packages+    -Wredundant-constraints+    -Wincomplete-uni-patterns+    -Wincomplete-record-updates++library+  import: warnings+  exposed-modules:+    Hypermedia.Datastar.Compression.Zlib+  hs-source-dirs:  src+  default-language: Haskell2010+  default-extensions:+    ImportQualifiedPost+    LambdaCase+    OverloadedStrings+  build-depends:+    , base       >= 4.14  && < 5+    , bytestring >= 0.10.12 && < 1+    , datastar-hs >= 1.1 && < 1.2+    , streaming-commons >= 0.2.3.1 && < 1++test-suite datastar-hs-zlib-test+  import: warnings+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Main.hs+  other-modules:+    Hypermedia.Datastar.Compression.ZlibSpec+  build-depends:+    , base+    , bytestring+    , datastar-hs+    , datastar-hs-zlib+    , hspec+    , wai+    , zlib+  default-language: Haskell2010+  default-extensions:+    ImportQualifiedPost+    OverloadedStrings

@@ -0,0 +1,68 @@+module Hypermedia.Datastar.Compression.Zlib+  ( gzip+  , gzipWith+  , deflate+  , deflateWith+  , defaultCompressionLevel+  )+where++import Control.Exception (throwIO)++import Data.ByteString qualified as BS+import Data.ByteString.Builder qualified as BSB+import Data.ByteString.Lazy qualified as BL++import Data.Streaming.Zlib+  ( PopperRes (..)+  , WindowBits (..)+  , feedDeflate+  , finishDeflate+  , flushDeflate+  , initDeflate+  )++import Hypermedia.Datastar.WAI (Compressor (..))++defaultCompressionLevel :: Int+defaultCompressionLevel = 6++-- | A gzip 'Compressor' (@Content-Encoding: gzip@) at 'defaultCompressionLevel'.+gzip :: Compressor+gzip = gzipWith defaultCompressionLevel++-- | A gzip 'Compressor' at an explicit zlib level (0–9).+gzipWith :: Int -> Compressor+gzipWith level = zlibCompressor "gzip" level (WindowBits 31)++-- | A zlib/deflate 'Compressor' (@Content-Encoding: deflate@) at 'defaultCompressionLevel'.+deflate :: Compressor+deflate = deflateWith defaultCompressionLevel++-- | A zlib/deflate 'Compressor' at an explicit zlib level (0–9).+deflateWith :: Int -> Compressor+deflateWith level = zlibCompressor "deflate" level (WindowBits 15)++-- WindowBits 31 selects gzip framing, 15 selects zlib/deflate framing.+zlibCompressor :: BS.ByteString -> Int -> WindowBits -> Compressor+zlibCompressor enc level wbits = Compressor enc wrap+ where+  wrap rawWrite rawFlush = do+    def <- initDeflate level wbits++    let drain popper = do+          res <- popper+          case res of+            PRDone -> pure ()+            PRNext bs -> rawWrite (BSB.byteString bs) >> drain popper+            PRError e -> throwIO e++        write builder = do+          popper <- feedDeflate def $ BL.toStrict $ BSB.toLazyByteString builder+          drain popper++        flush = drain (flushDeflate def) >> rawFlush++        finish = drain (finishDeflate def) >> rawFlush++    pure (write, flush, finish)

@@ -0,0 +1,110 @@+module Hypermedia.Datastar.Compression.ZlibSpec (spec) where++import Test.Hspec++import Control.Monad (forM_)++import Codec.Compression.GZip qualified as GZip+import Codec.Compression.Zlib qualified as Zlib+import Data.ByteString qualified as BS+import Data.ByteString.Builder qualified as BSB+import Data.ByteString.Char8 qualified as BS8+import Data.ByteString.Lazy qualified as BL+import Data.IORef++import Network.Wai (defaultRequest, requestHeaders)+import Network.Wai.Internal (Response (..))++import Hypermedia.Datastar+import Hypermedia.Datastar.Compression.Zlib (deflate, gzip)+import Hypermedia.Datastar.Logger (nullLogger)+import Hypermedia.Datastar.WAI (compressorWrap)++{- | Drive a streaming WAI response to completion, returning its response headers+and the full raw body.+-}+runStream (ResponseStream _status headers body) = do+  ref <- newIORef mempty+  body (\chunk -> modifyIORef' ref (<> chunk)) (pure ())+  bytes <- BSB.toLazyByteString <$> readIORef ref+  pure (headers, bytes)+runStream _ = error "expected a streaming response"++spec :: Spec+spec = describe "Hypermedia.Datastar.Compression.Zlib" $ do+  let sendEvents gen = do+        sendPatchElements gen (patchElements "<div id=\"a\">1</div>")+        sendPatchElements gen (patchElements "<div id=\"b\">2</div>")+        sendPatchSignals gen (patchSignals "{\"count\":42}")+      withAccept enc = defaultRequest{requestHeaders = [("Accept-Encoding", enc)]}++      -- (encoding token, compressor, matching decompressor)+      codecs :: [(BS.ByteString, Compressor, BL.ByteString -> BL.ByteString)]+      codecs =+        [ ("gzip", gzip, GZip.decompress)+        , ("deflate", deflate, Zlib.decompress)+        ]++  forM_ codecs $ \(enc, comp, decompress) -> do+    let name = BS8.unpack enc++    it (name <> ": round-trips to the uncompressed stream") $ do+      (_, reference) <- runStream (sseResponse nullLogger sendEvents)+      (headers, compressed) <-+        runStream (sseResponseWith nullLogger [comp] (withAccept enc) sendEvents)+      headers `shouldSatisfy` elem ("Content-Encoding", enc)+      decompress compressed `shouldBe` reference++    it (name <> ": emits output incrementally on flush, not buffered until finish") $ do+      ref <- newIORef mempty+      let rawWrite c = modifyIORef' ref (<> c)+          sizeSoFar = fromIntegral . BL.length . BSB.toLazyByteString <$> readIORef ref+      (write, flush, finish) <- compressorWrap comp rawWrite (pure ())++      write (BSB.byteString "event: datastar-patch-elements\ndata: elements <div>1</div>\n\n")+      flush+      afterFirst <- sizeSoFar++      write (BSB.byteString "event: datastar-patch-elements\ndata: elements <div>2</div>\n\n")+      flush+      afterSecond <- sizeSoFar++      finish+      afterFinish <- sizeSoFar++      -- Each flush must push bytes onto the wire; a compressor that buffered+      -- everything until finish would leave afterFirst == afterSecond == 0.+      afterFirst `shouldSatisfy` (> (0 :: Int))+      afterSecond `shouldSatisfy` (> afterFirst)+      afterFinish `shouldSatisfy` (>= afterSecond)++      -- And the accumulated stream is still a valid, complete stream.+      whole <- BSB.toLazyByteString <$> readIORef ref+      decompress whole+        `shouldBe` "event: datastar-patch-elements\ndata: elements <div>1</div>\n\n\+                   \event: datastar-patch-elements\ndata: elements <div>2</div>\n\n"++  it "declines when the client accepts neither" $ do+    (_, reference) <- runStream (sseResponse nullLogger sendEvents)+    (headers, body) <-+      runStream (sseResponseWith nullLogger [gzip, deflate] (withAccept "br") sendEvents)+    filter ((== "Content-Encoding") . fst) headers `shouldBe` []+    body `shouldBe` reference++  -- With several server compressors offered and a client that accepts all of+  -- them, ServerPriority (the default for sseResponseWith) picks the *server's*+  -- first — so list order, not header order, decides. Verified end-to-end via+  -- the chosen Content-Encoding and that the matching codec decompresses it.+  it "picks the server's first compressor when the client accepts several (gzip first)" $ do+    (_, reference) <- runStream (sseResponse nullLogger sendEvents)+    (headers, compressed) <-+      runStream (sseResponseWith nullLogger [gzip, deflate] (withAccept "deflate, gzip") sendEvents)+    headers `shouldSatisfy` elem ("Content-Encoding", "gzip")+    GZip.decompress compressed `shouldBe` reference++  it "picks the server's first compressor when the client accepts several (deflate first)" $ do+    (_, reference) <- runStream (sseResponse nullLogger sendEvents)+    (headers, compressed) <-+      runStream (sseResponseWith nullLogger [deflate, gzip] (withAccept "deflate, gzip") sendEvents)+    headers `shouldSatisfy` elem ("Content-Encoding", "deflate")+    Zlib.decompress compressed `shouldBe` reference

@@ -0,0 +1,8 @@+module Main where++import Test.Hspec++import Hypermedia.Datastar.Compression.ZlibSpec qualified++main :: IO ()+main = hspec Hypermedia.Datastar.Compression.ZlibSpec.spec