diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index bb740f4..5533e35 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -1,6 +1,6 @@ # This GitHub workflow config has been generated by a script via # -# haskell-ci 'github' 'cabal.project' '--config' 'cabal.haskell-ci' +# haskell-ci 'github' 'cabal.project.ci' # # To regenerate the script (for example after adjusting tested-with) run # @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.17.20240109 +# version: 0.19.20240402 # -# REGENDATA ("0.17.20240109",["github","cabal.project","--config","cabal.haskell-ci"]) +# REGENDATA ("0.19.20240402",["github","cabal.project.ci"]) # name: Haskell-CI on: @@ -28,9 +28,9 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.8.1 + - compiler: ghc-9.8.2 compilerKind: ghc - compilerVersion: 9.8.1 + compilerVersion: 9.8.2 setup-method: ghcup allow-failure: false - compiler: ghc-9.6.4 @@ -62,6 +62,7 @@ jobs: mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) apt-get update @@ -169,9 +170,15 @@ jobs: cat >> cabal.project <> cabal.project.local cat cabal.project cat cabal.project.local - name: dump install plan diff --git a/cabal.haskell-ci b/cabal.haskell-ci index 241002e..ffa544b 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -1,12 +1,2 @@ +copy-fields: all apt: libsnappy-dev - --- Unconstrained build. TODO: Take this out when we drop 8.10.7 --- --- We do this just so we can build with 8.10.7 and bytestring >= 0.11. It's not --- as simple as just saying `installed: -bytestring` since we then need to do --- the same for all libraries in the global db that depend on bytestring, and so --- on transitively. --- --- There is probably a cleaner way to do this, but it's the first thing that --- worked. -installed: -all diff --git a/cabal.project b/cabal.project index a441f78..4a62ee6 100644 --- a/cabal.project +++ b/cabal.project @@ -1,6 +1,10 @@ packages: . +package snappy-c + tests: True + benchmarks: True + source-repository-package type: git - location: https://github.com/FinleyMcIlwaine/bos-snappy - tag: b00b103a8c522aa3adde7e922537ab6b74f73eb0 + location: https://github.com/edsko/snappy.git + tag: 4f6288ea7fff56967a37ddccbd4894fad0a1b6b9 diff --git a/cabal.project.ci b/cabal.project.ci new file mode 100644 index 0000000..0f45a48 --- /dev/null +++ b/cabal.project.ci @@ -0,0 +1,11 @@ +packages: . + +package snappy-c + tests: True + benchmarks: True + ghc-options: -Werror + +source-repository-package + type: git + location: https://github.com/edsko/snappy.git + tag: 4f6288ea7fff56967a37ddccbd4894fad0a1b6b9 diff --git a/snappy-c.cabal b/snappy-c.cabal index 848daa2..7f535c3 100644 --- a/snappy-c.cabal +++ b/snappy-c.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: snappy-c -version: 0.1.0 +version: 0.1.1 synopsis: Bindings to Google's Snappy: A fast compression library description: [Snappy](https://github.com/google/snappy) is a fast (de)compression library. It is written in C++, but a basic @@ -21,7 +21,7 @@ tested-with: GHC==8.10.7 , GHC==9.2.8 , GHC==9.4.8 , GHC==9.6.4 - , GHC==9.8.1 + , GHC==9.8.2 source-repository head type: git @@ -77,7 +77,7 @@ library Codec.Compression.SnappyC.Internal.FrameFormat Codec.Compression.SnappyC.Internal.Util build-depends: - , bytestring >= 0.11 && < 0.13 + , bytestring >= 0.10 && < 0.13 , data-default >= 0.7 && < 0.8 , digest >= 0.0.2 && < 0.0.3 , mtl >= 2.2.2 && < 2.4 @@ -94,7 +94,7 @@ executable snappy-cli build-depends: snappy-c - , bytestring >= 0.11 && < 0.13 + , bytestring >= 0.10 && < 0.13 , conduit >= 1.3.5 && < 1.4 , data-default >= 0.7 && < 0.8 , optparse-applicative >= 0.18 && < 0.19 @@ -119,7 +119,7 @@ test-suite test-snappy-c , snappy-c build-depends: -- External dependencies - , bytestring >= 0.11 && < 0.13 + , bytestring >= 0.10 && < 0.13 , tasty >= 1.5 && < 1.6 , tasty-hunit >= 0.10 && < 0.11 , tasty-quickcheck >= 0.10 && < 0.11 @@ -139,7 +139,7 @@ benchmark bench-snappy-c , snappy-c -- external - , bytestring >= 0.11 && < 0.13 + , bytestring >= 0.10 && < 0.13 , criterion >= 1.6.3 && < 1.7 , deepseq >= 1.4 && < 1.6 , random >= 1.2.1 && < 1.3 @@ -148,4 +148,4 @@ benchmark bench-snappy-c ghc-options: -threaded - -rtsopts \ No newline at end of file + -rtsopts diff --git a/src/Codec/Compression/SnappyC/Raw.hs b/src/Codec/Compression/SnappyC/Raw.hs index 99afc33..3e12f77 100644 --- a/src/Codec/Compression/SnappyC/Raw.hs +++ b/src/Codec/Compression/SnappyC/Raw.hs @@ -21,80 +21,76 @@ import Codec.Compression.SnappyC.Internal.C qualified as C import Data.ByteString.Internal (ByteString(..)) import Foreign import System.IO.Unsafe +import Data.ByteString.Unsafe -- | Compress the input using [Snappy](https://github.com/google/snappy/). -- -- The result is in Snappy raw format, /not/ the framing format. compress :: ByteString -> ByteString -compress (BS sfp slen) = - unsafePerformIO $ do +compress bs = unsafePerformIO $ do + unsafeUseAsCStringLen bs $ \(sptr, slen) -> do let dlen = C.snappy_max_compressed_length (fromIntegral slen) - dfp <- mallocForeignPtrBytes (fromIntegral dlen) - withForeignPtr sfp $ \sptr -> - withForeignPtr dfp $ \dptr -> - with dlen $ \dlen_ptr -> - case - C.snappy_compress - (castPtr sptr) - (fromIntegral slen) - (castPtr dptr) - dlen_ptr - of - 0 -> - BS dfp . fromIntegral <$> peek dlen_ptr - 1 -> - error "impossible: there is no invalid input for compression" - 2 -> - error "impossible: the buffer size is always set correctly" - status -> - error $ - "impossible: unexpected status from snappy_compress: " ++ - show status + dptr <- mallocBytes (fromIntegral dlen) + with dlen $ \dlen_ptr -> + case + C.snappy_compress + (castPtr sptr) + (fromIntegral slen) + (castPtr dptr) + dlen_ptr + of + 0 -> do + len <- fromIntegral <$> peek dlen_ptr + unsafePackMallocCStringLen (dptr, len) + 1 -> + error "impossible: there is no invalid input for compression" + 2 -> + error "impossible: the buffer size is always set correctly" + status -> + error $ + "impossible: unexpected status from snappy_compress: " ++ + show status -- | Decompress the input using [Snappy](https://github.com/google/snappy/). -- -- Returns 'Nothing' if the input is not in Snappy raw format or -- otherwise ill-formed. decompress :: ByteString -> Maybe ByteString -decompress (BS sfp slen) = - unsafePerformIO $ do - withForeignPtr sfp $ - \sptr -> - alloca $ - \dlen_ptr -> - case - C.snappy_uncompressed_length +decompress bs = unsafePerformIO $ do + unsafeUseAsCStringLen bs $ \(sptr, slen) -> + alloca $ \dlen_ptr -> + case + C.snappy_uncompressed_length + (castPtr sptr) + (fromIntegral slen) + dlen_ptr + of + 0 -> do + dlen <- fromIntegral <$> peek dlen_ptr + dptr <- mallocBytes dlen + case + C.snappy_uncompress (castPtr sptr) (fromIntegral slen) + (castPtr dptr) dlen_ptr - of - 0 -> do - dlen <- fromIntegral <$> peek dlen_ptr - dfp <- mallocForeignPtrBytes dlen - withForeignPtr dfp $ - \dptr -> - case - C.snappy_uncompress - (castPtr sptr) - (fromIntegral slen) - (castPtr dptr) - dlen_ptr - of - 0 -> - Just . BS dfp . fromIntegral <$> peek dlen_ptr - 1 -> - -- Invalid input. Successful result from - -- snappy_uncompressed_length does *not* mean the - -- input is completely valid - return Nothing - status -> - error $ - "impossible: decompression failed with status " ++ - show status - 1 -> - return Nothing - status -> - error $ - "impossible: snappy_uncompressed_length failed with " ++ - "status" ++ show status + of + 0 -> do + len <- fromIntegral <$> peek dlen_ptr + Just <$> unsafePackMallocCStringLen (dptr, len) + 1 -> + -- Invalid input. Successful result from + -- snappy_uncompressed_length does *not* mean the + -- input is completely valid + return Nothing + status -> + error $ + "impossible: decompression failed with status " ++ + show status + 1 -> + return Nothing + status -> + error $ + "impossible: snappy_uncompressed_length failed with " ++ + "status" ++ show status