datastar-hs-zstd (empty) → 1.0.0.0
raw patch · 6 files changed
+313/−0 lines, 6 filesdep +basedep +bytestringdep +datastar-hs
Dependencies added: base, bytestring, datastar-hs, datastar-hs-zlib, datastar-hs-zstd, hspec, http-types, wai, zstd
Files
- CHANGELOG.md +11/−0
- LICENSE +7/−0
- datastar-hs-zstd.cabal +71/−0
- src/Hypermedia/Datastar/Compression/Zstd.hs +131/−0
- test/Hypermedia/Datastar/Compression/ZstdSpec.hs +85/−0
- test/Main.hs +8/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Revision history for datastar-hs-zstd++## 1.0.0.0 -- 2026-09-09++* First release. `Hypermedia.Datastar.Compression.Zstd`, split out of+ `datastar-hs` 1.0.x (where it was behind the `zstd` cabal flag).+* Requires `zstd >= 0.1.4`, the first Hackage release with the streaming+ `flushStream` FFI binding+ ([#3](https://github.com/starfederation/datastar-haskell/issues/3)). The+ `zstd` package bundles the zstd C sources by default, so no system library+ is needed.
+ LICENSE view
@@ -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.
+ datastar-hs-zstd.cabal view
@@ -0,0 +1,71 @@+cabal-version: 3.0+name: datastar-hs-zstd+version: 1.0.0.0+synopsis: zstd compressor for datastar-hs+description:+ @zstd@ @Content-Encoding@ compressor for+ <https://hackage.haskell.org/package/datastar-hs datastar-hs> SSE streams.+ .+ No system library needed: the <https://hackage.haskell.org/package/zstd zstd>+ package bundles the zstd C sources by default (its @standalone@ flag).+ Requires @zstd >= 0.1.4@ for the streaming @flushStream@ binding.+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.Zstd+ 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+ , zstd >= 0.1.4 && < 1++test-suite datastar-hs-zstd-test+ import: warnings+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ Hypermedia.Datastar.Compression.ZstdSpec+ build-depends:+ , base+ , bytestring+ , datastar-hs+ , datastar-hs-zlib+ , datastar-hs-zstd+ , hspec+ , http-types+ , wai+ , zstd+ default-language: Haskell2010+ default-extensions:+ ImportQualifiedPost+ OverloadedStrings
+ src/Hypermedia/Datastar/Compression/Zstd.hs view
@@ -0,0 +1,131 @@+{- |+A 'Compressor' that compresses an SSE stream with zstd (@Content-Encoding: zstd@),+driving libzstd's streaming API directly so each event can be flushed.+-}+module Hypermedia.Datastar.Compression.Zstd+ ( zstd+ , zstdWith+ , defaultZstdLevel+ )+where++import Control.Exception (Exception, throwIO)+import Control.Monad (unless, when)++import Data.ByteString qualified as BS+import Data.ByteString.Builder qualified as BSB+import Data.ByteString.Lazy qualified as BL+import Data.ByteString.Unsafe qualified as BU+import Data.Word (Word8)++import Foreign.ForeignPtr+ ( ForeignPtr+ , finalizeForeignPtr+ , mallocForeignPtrBytes+ , newForeignPtr+ , withForeignPtr+ )+import Foreign.Marshal.Alloc (finalizerFree, malloc)+import Foreign.Ptr (Ptr, castPtr, nullPtr)+import Foreign.Storable (peek, poke)++import Codec.Compression.Zstd.FFI+ ( Buffer (..)+ , In+ , Out+ , compressStream+ , createCStream+ , cstreamOutSize+ , endStream+ , flushStream+ , getErrorName+ , initCStream+ , isError+ , p_freeCStream+ )++import Hypermedia.Datastar.WAI (Compressor (..))++newtype ZstdError = ZstdError String+ deriving (Show)++instance Exception ZstdError++-- | zstd's default compression level (3).+defaultZstdLevel :: Int+defaultZstdLevel = 3++-- | A zstd 'Compressor' (@Content-Encoding: zstd@) at 'defaultZstdLevel'.+zstd :: Compressor+zstd = zstdWith defaultZstdLevel++-- | A zstd 'Compressor' at an explicit compression level (1–22).+zstdWith :: Int -> Compressor+zstdWith level =+ Compressor+ { compressorEncoding = "zstd"+ , compressorWrap = \rawWrite rawFlush -> do+ let out = rawWrite . BSB.byteString+ outSize = fromIntegral cstreamOutSize :: Int++ csPtr <- createCStream+ when (csPtr == nullPtr) $ throwIO (ZstdError "ZSTD_createCStream returned NULL")+ initRet <- initCStream csPtr (fromIntegral level)+ when (isError initRet) $+ throwIO (ZstdError ("ZSTD_initCStream: " <> getErrorName initRet))+ csFp <- newForeignPtr p_freeCStream csPtr++ inFp <- newForeignPtr finalizerFree =<< (malloc :: IO (Ptr (Buffer In)))+ outFp <- newForeignPtr finalizerFree =<< (malloc :: IO (Ptr (Buffer Out)))+ scratchFp <- mallocForeignPtrBytes outSize :: IO (ForeignPtr Word8)++ let+ drainOut outBuf scratch = do+ produced <- fromIntegral . bufPos <$> peek outBuf+ when (produced > 0) $+ out =<< BS.packCStringLen (castPtr scratch, produced)++ resetOut outBuf scratch =+ poke outBuf (Buffer scratch (fromIntegral outSize) 0)++ checkRet ctx ret =+ when (isError ret) $ throwIO (ZstdError (ctx <> ": " <> getErrorName ret))++ write builder =+ let bs = BL.toStrict (BSB.toLazyByteString builder)+ in unless (BS.null bs) $+ BU.unsafeUseAsCStringLen bs $ \(srcPtr, len) ->+ withForeignPtr csFp $ \cs ->+ withForeignPtr inFp $ \inBuf ->+ withForeignPtr outFp $ \outBuf ->+ withForeignPtr scratchFp $ \scratch -> do+ poke inBuf (Buffer (castPtr srcPtr) (fromIntegral len) 0)+ let loop = do+ resetOut outBuf scratch+ checkRet "ZSTD_compressStream" =<< compressStream cs outBuf inBuf+ drainOut outBuf scratch+ consumed <- fromIntegral . bufPos <$> peek inBuf+ when (consumed < len) loop+ loop++ pump name op =+ withForeignPtr csFp $ \cs ->+ withForeignPtr outFp $ \outBuf ->+ withForeignPtr scratchFp $ \scratch -> do+ let loop = do+ resetOut outBuf scratch+ remaining <- op cs outBuf+ checkRet name remaining+ drainOut outBuf scratch+ when (remaining > 0) loop+ loop++ flush = pump "ZSTD_flushStream" flushStream >> rawFlush++ finish = do+ pump "ZSTD_endStream" endStream+ finalizeForeignPtr csFp+ rawFlush++ pure (write, flush, finish)+ }
+ test/Hypermedia/Datastar/Compression/ZstdSpec.hs view
@@ -0,0 +1,85 @@+module Hypermedia.Datastar.Compression.ZstdSpec (spec) where++import Test.Hspec++import Codec.Compression.Zstd.Lazy qualified as Zstd+import Data.ByteString.Builder qualified as BSB+import Data.ByteString.Lazy qualified as BL+import Data.IORef++import Network.HTTP.Types (ResponseHeaders)+import Network.Wai (defaultRequest, requestHeaders)+import Network.Wai.Internal (Response (..))++import Hypermedia.Datastar+import Hypermedia.Datastar.Compression.Zlib (gzip)+import Hypermedia.Datastar.Compression.Zstd (zstd)+import Hypermedia.Datastar.WAI (compressorWrap)++{- | Drive a streaming WAI response to completion, returning its response headers+and the full raw body.+-}+runStream :: Response -> IO (ResponseHeaders, BL.ByteString)+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.Zstd" $ 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)]}++ it "round-trips to the uncompressed stream" $ do+ (_, reference) <- runStream (sseResponse nullLogger sendEvents)+ (headers, compressed) <-+ runStream (sseResponseWith nullLogger [zstd] (withAccept "zstd") sendEvents)+ headers `shouldSatisfy` elem ("Content-Encoding", "zstd")+ Zstd.decompress compressed `shouldBe` reference++ it "declines when the client does not accept zstd" $ do+ (_, reference) <- runStream (sseResponse nullLogger sendEvents)+ (headers, body) <-+ runStream (sseResponseWith nullLogger [zstd] (withAccept "gzip") sendEvents)+ filter ((== "Content-Encoding") . fst) headers `shouldBe` []+ body `shouldBe` reference++ it "is chosen ahead of gzip when offered first and both are accepted" $ do+ (_, reference) <- runStream (sseResponse nullLogger sendEvents)+ (headers, compressed) <-+ runStream (sseResponseWith nullLogger [zstd, gzip] (withAccept "gzip, zstd") sendEvents)+ headers `shouldSatisfy` elem ("Content-Encoding", "zstd")+ Zstd.decompress compressed `shouldBe` reference++ it "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 zstd 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)++ whole <- BSB.toLazyByteString <$> readIORef ref+ Zstd.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"
+ test/Main.hs view
@@ -0,0 +1,8 @@+module Main where++import Test.Hspec++import Hypermedia.Datastar.Compression.ZstdSpec qualified++main :: IO ()+main = hspec Hypermedia.Datastar.Compression.ZstdSpec.spec