-- Copyright (c) 2016-present, Facebook, Inc.
-- All rights reserved.
--
-- This source code is licensed under the BSD-style license found in
-- the LICENSE file in the root directory of this source tree. An
-- additional grant of patent rights can be found in the PATENTS file
-- in the same directory.

-- |
-- Module      : Codec.Compression.Zstd
-- Copyright   : (c) 2016-present, Facebook, Inc. All rights reserved.
--
-- License     : BSD3
-- Maintainer  : bryano@fb.com
-- Stability   : experimental
-- Portability : GHC
--
-- A fast lossless compression algorithm, targeting real-time
-- compression scenarios at zlib-level and better compression ratios.

module Codec.Compression.Zstd
    (
    -- * Basic pure API
      compress
    , Decompress(..)
    , decompressedSize
    , decompress
    , C.maxCLevel

    -- * Dictionary-based compression
    , Dict
    , mkDict
    , fromDict
    , trainFromSamples
    , getDictID

    -- ** Basic pure API
    , compressUsingDict
    , decompressUsingDict
    ) where

import Codec.Compression.Zstd.Internal
import Codec.Compression.Zstd.Types (Decompress(..), Dict(..), mkDict)
import Data.ByteString.Internal (ByteString(..))
import System.IO.Unsafe (unsafePerformIO)
import qualified Codec.Compression.Zstd.FFI as C

-- | Compress the given data as a single zstd compressed frame.
compress :: Int
         -- ^ Compression level. Must be >= 1 and <= 'C.maxCLevel'.
         -> ByteString
         -- ^ Payload to compress.
         -> ByteString
compress :: Int -> ByteString -> ByteString
compress Int
level ByteString
bs = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
  String
-> (Ptr Word8 -> CSize -> Ptr Word8 -> CSize -> CInt -> IO CSize)
-> Int
-> ByteString
-> IO ByteString
compressWith String
"compress" Ptr Word8 -> CSize -> Ptr Word8 -> CSize -> CInt -> IO CSize
forall dst src.
Ptr dst -> CSize -> Ptr src -> CSize -> CInt -> IO CSize
C.compress Int
level ByteString
bs

-- | Decompress a single-frame payload of known size.  Typically this
-- will be a payload that was compressed with 'compress'.
--
-- /Note:/ This function is not capable of decompressing a payload
-- generated by the streaming or lazy compression APIs.
decompress :: ByteString -> Decompress
decompress :: ByteString -> Decompress
decompress ByteString
bs = IO Decompress -> Decompress
forall a. IO a -> a
unsafePerformIO (IO Decompress -> Decompress) -> IO Decompress -> Decompress
forall a b. (a -> b) -> a -> b
$ (Ptr Word8 -> CSize -> Ptr Word8 -> CSize -> IO CSize)
-> ByteString -> IO Decompress
decompressWith Ptr Word8 -> CSize -> Ptr Word8 -> CSize -> IO CSize
forall dst src. Ptr dst -> CSize -> Ptr src -> CSize -> IO CSize
C.decompress ByteString
bs

-- | Compress the given data as a single zstd compressed frame, using
-- a prebuilt dictionary.
compressUsingDict :: Dict
                  -- ^ Compression dictionary.
                  -> Int
                  -- ^ Compression level. Must be >= 1 and <= 'C.maxCLevel'.
                  -> ByteString
                  -- ^ Payload to compress.
                  -> ByteString
compressUsingDict :: Dict -> Int -> ByteString -> ByteString
compressUsingDict Dict
dict Int
level ByteString
bs =
  IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString)
-> ((CCtx -> IO ByteString) -> IO ByteString)
-> (CCtx -> IO ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CCtx -> IO ByteString) -> IO ByteString
forall a. (CCtx -> IO a) -> IO a
withCCtx ((CCtx -> IO ByteString) -> ByteString)
-> (CCtx -> IO ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ \(CCtx Ptr CCtx
ctx) ->
    Dict -> (Ptr Any -> CSize -> IO ByteString) -> IO ByteString
forall dict a. Dict -> (Ptr dict -> CSize -> IO a) -> IO a
withDict Dict
dict ((Ptr Any -> CSize -> IO ByteString) -> IO ByteString)
-> (Ptr Any -> CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Any
dictPtr CSize
dictLen ->
      let compressor :: Ptr dst -> CSize -> Ptr src -> CSize -> CInt -> IO CSize
compressor Ptr dst
dp CSize
dl Ptr src
sp CSize
sl CInt
l =
            Ptr CCtx
-> Ptr dst
-> CSize
-> Ptr src
-> CSize
-> Ptr Any
-> CSize
-> CInt
-> IO CSize
forall dst src dict.
Ptr CCtx
-> Ptr dst
-> CSize
-> Ptr src
-> CSize
-> Ptr dict
-> CSize
-> CInt
-> IO CSize
C.compressUsingDict Ptr CCtx
ctx Ptr dst
dp CSize
dl Ptr src
sp CSize
sl Ptr Any
dictPtr CSize
dictLen CInt
l
      in String
-> (Ptr Word8 -> CSize -> Ptr Word8 -> CSize -> CInt -> IO CSize)
-> Int
-> ByteString
-> IO ByteString
compressWith String
"compressUsingDict" Ptr Word8 -> CSize -> Ptr Word8 -> CSize -> CInt -> IO CSize
forall dst src.
Ptr dst -> CSize -> Ptr src -> CSize -> CInt -> IO CSize
compressor Int
level ByteString
bs

-- | Decompress a single-frame payload of known size, using a prebuilt
-- dictionary.  Typically this will be a payload that was compressed
-- with 'compressUsingDict'.
--
-- /Note:/ This function is not capable of decompressing a payload
-- generated by the streaming or lazy compression APIs.
decompressUsingDict :: Dict
                    -- ^ Dictionary.
                    -> ByteString
                    -- ^ Payload to decompress.
                    -> Decompress
decompressUsingDict :: Dict -> ByteString -> Decompress
decompressUsingDict Dict
dict ByteString
bs =
  IO Decompress -> Decompress
forall a. IO a -> a
unsafePerformIO (IO Decompress -> Decompress)
-> ((DCtx -> IO Decompress) -> IO Decompress)
-> (DCtx -> IO Decompress)
-> Decompress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DCtx -> IO Decompress) -> IO Decompress
forall a. (DCtx -> IO a) -> IO a
withDCtx ((DCtx -> IO Decompress) -> Decompress)
-> (DCtx -> IO Decompress) -> Decompress
forall a b. (a -> b) -> a -> b
$ \(DCtx Ptr DCtx
ctx) ->
    Dict -> (Ptr Any -> CSize -> IO Decompress) -> IO Decompress
forall dict a. Dict -> (Ptr dict -> CSize -> IO a) -> IO a
withDict Dict
dict ((Ptr Any -> CSize -> IO Decompress) -> IO Decompress)
-> (Ptr Any -> CSize -> IO Decompress) -> IO Decompress
forall a b. (a -> b) -> a -> b
$ \Ptr Any
dictPtr CSize
dictLen ->
      let decompressor :: Ptr dst -> CSize -> Ptr src -> CSize -> IO CSize
decompressor Ptr dst
dp CSize
dl Ptr src
sp CSize
sl =
            Ptr DCtx
-> Ptr dst
-> CSize
-> Ptr src
-> CSize
-> Ptr Any
-> CSize
-> IO CSize
forall dst src dict.
Ptr DCtx
-> Ptr dst
-> CSize
-> Ptr src
-> CSize
-> Ptr dict
-> CSize
-> IO CSize
C.decompressUsingDict Ptr DCtx
ctx Ptr dst
dp CSize
dl Ptr src
sp CSize
sl Ptr Any
dictPtr CSize
dictLen
      in (Ptr Word8 -> CSize -> Ptr Word8 -> CSize -> IO CSize)
-> ByteString -> IO Decompress
decompressWith Ptr Word8 -> CSize -> Ptr Word8 -> CSize -> IO CSize
forall dst src. Ptr dst -> CSize -> Ptr src -> CSize -> IO CSize
decompressor ByteString
bs