{-# LINE 1 "src/LibBrotli.hsc" #-}
{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE CApiFFI            #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards    #-}

-- Copyright (C) 2016  Herbert Valerio Riedel
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- | Internal low-level bindings to libbrotli
module LibBrotli
   ( CompressParams(..), defaultCompressParams
   , CompressionLevel(..), CompressionWindowSize(..), CompressionMode(..)
   , DecompressParams(..), defaultDecompressParams
   , BrotliState(..), BrotliEncOp(..)
   , newBrotliEncoder, newBrotliDecoder
   , finalizeBrotliEncoder, finalizeBrotliDecoder
   , runBrotliEncoder, runBrotliDecoder
   , readBrotliEncoder, readBrotliDecoder
   , brotliEncoderVersion, brotliDecoderVersion
   , BrotliDecoderErrorCode(..), showBrotliDecoderErrorCode
   ) where

import           Control.Applicative
import           Control.Monad
import           Control.Exception
import           Control.Monad.ST.Strict (ST)
import           Control.Monad.ST.Unsafe (unsafeIOToST)
import           Data.ByteString (ByteString)
import           Data.Typeable (Typeable)
import           Foreign
import           Foreign.C
import           System.IO.Unsafe as Unsafe (unsafePerformIO)
import           Prelude
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import           Control.Monad.Trans.Maybe (MaybeT(..))



allocaPoke :: Storable x => x -> (Ptr x -> IO b) -> IO b
allocaPoke v0 act = alloca $ \pv -> do { poke pv v0; act pv }

packBS :: Ptr Word8 -> CSize -> IO ByteString
packBS p sz
  | sz > 0    = BS.packCStringLen (castPtr p, fromIntegral sz)
  | otherwise = pure BS.empty

----------------------------------------------------------------------------

type BrotliBool = Int32
{-# LINE 63 "src/LibBrotli.hsc" #-}

fromBrotliBool :: BrotliBool -> Maybe Bool
fromBrotliBool 1  = Just True
{-# LINE 66 "src/LibBrotli.hsc" #-}
fromBrotliBool 0 = Just False
{-# LINE 67 "src/LibBrotli.hsc" #-}
fromBrotliBool _ = Nothing

toBrotliBool :: Bool -> BrotliBool
toBrotliBool False =  0
{-# LINE 71 "src/LibBrotli.hsc" #-}
toBrotliBool True  =  1
{-# LINE 72 "src/LibBrotli.hsc" #-}

----------------------------------------------------------------------------

-- | Errors signalled by the Brotli decoder. Use 'showBrotliDecoderErrorCode' to convert the numeric code into an error message.
newtype BrotliDecoderErrorCode = BrotliDecoderErrorCode Int deriving (Eq,Show,Typeable)

instance Exception BrotliDecoderErrorCode

-- | Convert numeric 'BrotliDecoderErrorCode' into textual error message.
{-# NOINLINE showBrotliDecoderErrorCode #-}
showBrotliDecoderErrorCode :: BrotliDecoderErrorCode -> String
showBrotliDecoderErrorCode (BrotliDecoderErrorCode ec) = Unsafe.unsafePerformIO $ do
  bufptr <- c_BrotliDecoderErrorString (fromIntegral ec)
  if bufptr == nullPtr then pure "" else peekCAString bufptr

----------------------------------------------------------------------------

-- internal state enumeration
data BrotliState
    = BSNeedsInput -- NB: initial state
    | BSHasOutput
    | BSFinished
    | BSFail
    | BSInternalError -- the impossible happened
    deriving (Eq,Show)

type HsBrotliState = Word32
{-# LINE 99 "src/LibBrotli.hsc" #-}

fromHsBrotliState :: HsBrotliState -> BrotliState
fromHsBrotliState x = case x of
  0 -> BSNeedsInput
{-# LINE 103 "src/LibBrotli.hsc" #-}
  1  -> BSHasOutput
{-# LINE 104 "src/LibBrotli.hsc" #-}
  2    -> BSFinished
{-# LINE 105 "src/LibBrotli.hsc" #-}
  3        -> BSFail
{-# LINE 106 "src/LibBrotli.hsc" #-}
  _                          -> BSInternalError

----------------------------------------------------------------------------

-- | Set of parameters for compression. The defaults are 'defaultCompressParams'.
data CompressParams = CompressParams
    { compressLevel :: !CompressionLevel -- ^ 'CompressParams' field: See documentation of 'CompressionLevel'
    , compressWindowSize :: !CompressionWindowSize -- ^ 'CompressParams' field: See documentation of 'CompressionWindowSize'
    , compressMode  :: !CompressionMode  -- ^ 'CompressParams' field: See documentation of 'CompressionMode'
    , compressSizeHint :: !Word32 -- ^ 'CompressParams' field: Estimated total input size. The default value is @0@, which means that the total input size is unknown.
    }

-- | Set of parameters for decompression. The defaults are
-- 'defaultDecompressParams'.
data DecompressParams = DecompressParams
    { decompressDisableRingBufferReallocation :: !Bool -- ^ 'DecompressParams' field: If 'True', ring buffer is allocated according to window size, despite the real size of the content. (default: 'False')
    }

-- | The default set of parameters for compression. This is typically
-- used with the 'Codec.Compression.Brotli.compressWith' function with specific parameters
-- overridden.
defaultCompressParams :: CompressParams
defaultCompressParams = CompressParams {..}
  where
    compressLevel      = maxBound
    compressWindowSize = CompressionWindowBits22
    compressMode       = CompressionModeGeneric
    compressSizeHint   = 0

-- | The default set of parameters for decompression. This is
-- typically used with the 'Codec.Compression.Brotli.decompressWith' function with specific
-- parameters overridden.
defaultDecompressParams :: DecompressParams
defaultDecompressParams = DecompressParams False

-- | C pointer to @BrotliEncoderState@
newtype BrotliEncoder = BrotliEncoder (ForeignPtr BrotliEncoder)

-- | C pointer to @BrotliDecoderState@
newtype BrotliDecoder = BrotliDecoder (ForeignPtr BrotliDecoder)

newBrotliEncoder :: CompressParams -> ST s (Maybe BrotliEncoder)
newBrotliEncoder CompressParams{..} = unsafeIOToST $ runMaybeT $ do
    fp <- MaybeT createBrotliEncoder

    unless (11 == qualityParm) $ do
{-# LINE 152 "src/LibBrotli.hsc" #-}
      rc <- setParm fp 1 qualityParm
{-# LINE 153 "src/LibBrotli.hsc" #-}
      unless rc $ fail "invalid BROTLI_PARAM_QUALITY"

    unless (0 == modeParm) $ do
{-# LINE 156 "src/LibBrotli.hsc" #-}
      rc <- setParm fp 0 modeParm
{-# LINE 157 "src/LibBrotli.hsc" #-}
      unless rc $ fail "invalid BROTLI_PARAM_MODE"

    unless (22 == winParm) $ do
{-# LINE 160 "src/LibBrotli.hsc" #-}
      unless ((10 <= winParm) && (winParm <= 24)) $
{-# LINE 161 "src/LibBrotli.hsc" #-}
        fail "invalid BROTLI_PARAM_LGWIN (internal inconsistency)"

      rc <- setParm fp 2 winParm
{-# LINE 164 "src/LibBrotli.hsc" #-}
      unless rc $ fail "invalid BROTLI_PARAM_LGWIN"

    unless (0 == compressSizeHint) $ do
      rc <- setParm fp 5 compressSizeHint
{-# LINE 168 "src/LibBrotli.hsc" #-}
      unless rc $ fail "invalid BROTLI_PARAM_SIZE_HINT"

    pure fp
  where
    setParm (BrotliEncoder fp) k v = MaybeT (withForeignPtr fp $ \p -> fromBrotliBool <$> c_BrotliEncoderSetParameter p k v)

    qualityParm = fromIntegral (fromEnum compressLevel)
    winParm = fromIntegral (fromEnum compressWindowSize)
    modeParm    = case compressMode of
                    CompressionModeGeneric -> 0
{-# LINE 178 "src/LibBrotli.hsc" #-}
                    CompressionModeText    -> 1
{-# LINE 179 "src/LibBrotli.hsc" #-}
                    CompressionModeFont    -> 2
{-# LINE 180 "src/LibBrotli.hsc" #-}

newBrotliDecoder :: DecompressParams -> ST s (Maybe BrotliDecoder)
newBrotliDecoder DecompressParams{..} = unsafeIOToST $ runMaybeT $ do
    fp <- MaybeT createBrotliDecoder

    when decompressDisableRingBufferReallocation $ do
      rc <- setParm fp 0
{-# LINE 187 "src/LibBrotli.hsc" #-}
                       (fromIntegral $ toBrotliBool decompressDisableRingBufferReallocation)
      unless rc $ fail "invalid BROTLI_DECODER_PARAM_DISABLE_RING_BUFFER_REALLOCATION"

    pure fp
  where
    setParm (BrotliDecoder fp) k v = MaybeT (withForeignPtr fp $ \p -> fromBrotliBool <$> c_BrotliDecoderSetParameter p k v)

createBrotliEncoder :: IO (Maybe BrotliEncoder)
createBrotliEncoder = mask_ $ do
    p <- c_BrotliEncoderCreateInstance nullPtr nullPtr nullPtr
    case () of
      _ | p == nullPtr -> pure Nothing
        | otherwise -> do
            !fp <- newForeignPtr cp_BrotliEncoderDestroyInstance p
            pure (Just (BrotliEncoder fp))

createBrotliDecoder :: IO (Maybe BrotliDecoder)
createBrotliDecoder = mask_ $ do
    p <- c_BrotliDecoderCreateInstance nullPtr nullPtr nullPtr
    case () of
      _ | p == nullPtr -> pure Nothing
        | otherwise -> do
            !fp <- newForeignPtr cp_BrotliDecoderDestroyInstance p
            pure (Just (BrotliDecoder fp))

finalizeBrotliEncoder :: BrotliEncoder -> ST s ()
finalizeBrotliEncoder (BrotliEncoder s) = unsafeIOToST (finalizeForeignPtr s)

finalizeBrotliDecoder :: BrotliDecoder -> ST s ()
finalizeBrotliDecoder (BrotliDecoder s) = unsafeIOToST (finalizeForeignPtr s)

data BrotliEncOp
     = BrotliEncOpProcess
     | BrotliEncOpFlush
     | BrotliEncOpFinish
--   | BrotliEncOpEmitMetadata -- TODO

runBrotliEncoder :: BrotliEncoder
                 -> ByteString
                 -> BrotliEncOp
                 -> ST s (BrotliState,Int) {- (state, unused-input) -}
runBrotliEncoder (BrotliEncoder fp) ibs action0
  = unsafeIOToST $ withForeignPtr fp $ \encPtr -> do
      BS.unsafeUseAsCStringLen ibs $ \(ibsptr, ibslen) ->
        allocaPoke (fromIntegral ibslen) $ \availIn ->
          allocaPoke ibsptr $ \nextIn -> do
            allocaPoke 0 $ \availOut -> do
              rc <- fromHsBrotliState <$>
                    c_BrotliEncoderCompressStream encPtr action availIn (castPtr nextIn) availOut nullPtr nullPtr
              availIn' <- fromIntegral <$> peek availIn
              pure (rc, availIn')
  where
    action = case action0 of
               BrotliEncOpProcess -> 0
{-# LINE 241 "src/LibBrotli.hsc" #-}
               BrotliEncOpFinish  -> 2
{-# LINE 242 "src/LibBrotli.hsc" #-}
               BrotliEncOpFlush   -> 1
{-# LINE 243 "src/LibBrotli.hsc" #-}

runBrotliDecoder :: BrotliDecoder
                 -> ByteString
                 -> ST s (BrotliState,BrotliDecoderErrorCode,Int {- unused-input -})
runBrotliDecoder (BrotliDecoder fp) ibs
  = unsafeIOToST $ withForeignPtr fp $ \encPtr -> do
      BS.unsafeUseAsCStringLen ibs $ \(ibsptr, ibslen) ->
        allocaPoke (fromIntegral ibslen) $ \availIn ->
          allocaPoke ibsptr $ \nextIn -> do
            allocaPoke 0 $ \availOut -> do
              rc <- fromHsBrotliState <$>
                    c_BrotliDecoderDecompressStream encPtr availIn (castPtr nextIn) availOut nullPtr nullPtr
              availIn' <- fromIntegral <$> peek availIn
              ecode <- BrotliDecoderErrorCode <$> if rc == BSFail
                then fromIntegral <$> c_BrotliDecoderGetErrorCode encPtr
                else pure 0
              pure (rc, ecode, availIn')

readBrotliEncoder :: BrotliEncoder -> Int {- max-output -} -> ST s (BrotliState, ByteString)
readBrotliEncoder (BrotliEncoder fp) maxobs
  = unsafeIOToST $ withForeignPtr fp $ \encPtr -> do
      allocaPoke (fromIntegral maxobs) $ \availOutPtr -> do
        alloca $ \obsptrptr -> do
          rc <- fromHsBrotliState <$>
                c_BrotliEncoderTakeOutput encPtr availOutPtr obsptrptr
          availOut' <- peek availOutPtr
          obsptr <- peek obsptrptr
          buf <- packBS obsptr availOut'
          pure (rc, buf)

readBrotliDecoder :: BrotliDecoder -> Int {- max-output -} -> ST s (BrotliState, ByteString)
readBrotliDecoder (BrotliDecoder fp) maxobs
  = unsafeIOToST $ withForeignPtr fp $ \encPtr -> do
      allocaPoke (fromIntegral maxobs) $ \availOutPtr -> do
        alloca $ \obsptrptr -> do
          rc <- fromHsBrotliState <$>
                c_BrotliDecoderTakeOutput encPtr availOutPtr obsptrptr
          availOut' <- peek availOutPtr
          obsptr <- peek obsptrptr
          buf <- packBS obsptr availOut'
          pure (rc, buf)

----------------------------------------------------------------------------

-- | Encoding profile
data CompressionMode
    = CompressionModeGeneric -- ^ Format-agnostic default mode
    | CompressionModeText    -- ^ UTF-8 formatted text data
    | CompressionModeFont    -- ^ Compression mode used in WOFF 2.0
    deriving (Eq,Read,Show,Typeable)

-- | Compression quality setting
data CompressionLevel
    = CompressionLevel0 -- ^ fastest/lowest compression level
    | CompressionLevel1
    | CompressionLevel2
    | CompressionLevel3
    | CompressionLevel4
    | CompressionLevel5
    | CompressionLevel6
    | CompressionLevel7
    | CompressionLevel8
    | CompressionLevel9
    | CompressionLevel10
    | CompressionLevel11 -- ^ slowest/highest compression level (default)
    deriving (Eq,Ord,Read,Show,Enum,Typeable,Bounded)

-- | Recommended sliding LZ77 window size.
--
-- The encoder may reduce this value (if e.g. input is much smaller than window size).
--
data CompressionWindowSize
    = CompressionWindowBits10 -- ^ 1008 bytes
    | CompressionWindowBits11 -- ^ 2032 bytes
    | CompressionWindowBits12 -- ^ 4080 bytes
    | CompressionWindowBits13 -- ^ 8176 bytes
    | CompressionWindowBits14 -- ^ 16368 bytes
    | CompressionWindowBits15 -- ^ 32752 bytes
    | CompressionWindowBits16 -- ^ 65520 bytes
    | CompressionWindowBits17 -- ^ 131056 bytes
    | CompressionWindowBits18 -- ^ 262128 bytes
    | CompressionWindowBits19 -- ^ 524272 bytes
    | CompressionWindowBits20 -- ^ 1048560 bytes
    | CompressionWindowBits21 -- ^ 2097136 bytes
    | CompressionWindowBits22 -- ^ 4194288 bytes (default)
    | CompressionWindowBits23 -- ^ 8388592 bytes
    | CompressionWindowBits24 -- ^ 16777200 bytes
    deriving (Eq,Ord,Read,Show,Typeable,Bounded)

-- | This 'Enum' instance is offset by 10.
--
-- >>> toEnum CompressionWindowBits10
-- 10
--
-- >>> fromEnum 22 :: CompressionWindowSize
-- CompressionWindowBits22
--
instance Enum CompressionWindowSize where
  toEnum i = case i of
    10 -> CompressionWindowBits10
    11 -> CompressionWindowBits11
    12 -> CompressionWindowBits12
    13 -> CompressionWindowBits13
    14 -> CompressionWindowBits14
    15 -> CompressionWindowBits15
    16 -> CompressionWindowBits16
    17 -> CompressionWindowBits17
    18 -> CompressionWindowBits18
    19 -> CompressionWindowBits19
    20 -> CompressionWindowBits20
    21 -> CompressionWindowBits21
    22 -> CompressionWindowBits22
    23 -> CompressionWindowBits23
    24 -> CompressionWindowBits24
    _  -> error "toEnum(CompressionWindowSize): bad argument"

  fromEnum x = case x of
    CompressionWindowBits10 -> 10
    CompressionWindowBits11 -> 11
    CompressionWindowBits12 -> 12
    CompressionWindowBits13 -> 13
    CompressionWindowBits14 -> 14
    CompressionWindowBits15 -> 15
    CompressionWindowBits16 -> 16
    CompressionWindowBits17 -> 17
    CompressionWindowBits18 -> 18
    CompressionWindowBits19 -> 19
    CompressionWindowBits20 -> 20
    CompressionWindowBits21 -> 21
    CompressionWindowBits22 -> 22
    CompressionWindowBits23 -> 23
    CompressionWindowBits24 -> 24

----------------------------------------------------------------------------
-- FFI imports
--
-- encoder

foreign import capi "hs_brotli.h BrotliEncoderCreateInstance"
    c_BrotliEncoderCreateInstance :: Ptr () -> Ptr () -> Ptr () -> IO (Ptr BrotliEncoder)

-- foreign import capi "hs_brotli.h BrotliEncoderDestroyInstance"
--     c_BrotliEncoderDestroyInstance :: Ptr BrotliEncoder -> IO ()

foreign import capi "hs_brotli.h &BrotliEncoderDestroyInstance"
    cp_BrotliEncoderDestroyInstance :: FunPtr (Ptr BrotliEncoder -> IO ())

foreign import capi "hs_brotli.h HsBrotliEncoderCompressStream"
    c_BrotliEncoderCompressStream :: Ptr BrotliEncoder
                                  -> Word32
{-# LINE 393 "src/LibBrotli.hsc" #-}
                                  -> Ptr CSize       {- available_in -}
                                  -> Ptr (Ptr Word8) {- next_in -}
                                  -> Ptr CSize       {- available_out -}
                                  -> Ptr (Ptr Word8) {- next_out -}
                                  -> Ptr CSize       {- total_out -}
                                  -> IO HsBrotliState

-- foreign import capi unsafe "hs_brotli.h BrotliEncoderIsFinished"
--     c_BrotliEncoderIsFinished :: Ptr BrotliEncoder -> IO BrotliBool
--
-- foreign import capi unsafe "hs_brotli.h BrotliEncoderHasMoreOutput"
--     c_BrotliEncoderHasMoreOutput :: Ptr BrotliEncoder -> IO BrotliBool

foreign import capi unsafe "hs_brotli.h HsBrotliEncoderTakeOutput"
    c_BrotliEncoderTakeOutput :: Ptr BrotliEncoder -> Ptr CSize -> Ptr (Ptr Word8) -> IO HsBrotliState

-- e.g. 0x01000000
foreign import capi unsafe "hs_brotli.h BrotliEncoderVersion" brotliEncoderVersion :: Word32


-- BROTLI_BOOL BrotliEncoderSetParameter(BrotliEncoderState *state, BrotliEncoderParameter param, uint32_t value)

foreign import capi unsafe "hs_brotli.h BrotliEncoderSetParameter"
    c_BrotliEncoderSetParameter :: Ptr BrotliEncoder -> Word32 -> Word32 -> IO BrotliBool
{-# LINE 417 "src/LibBrotli.hsc" #-}

----------------------------------------------------------------------------
-- decoder

foreign import capi "hs_brotli.h BrotliDecoderCreateInstance"
    c_BrotliDecoderCreateInstance :: Ptr () -> Ptr () -> Ptr () -> IO (Ptr BrotliDecoder)

-- foreign import capi "hs_brotli.h BrotliDecoderDestroyInstance"
--     c_BrotliDecoderDestroyInstance :: Ptr BrotliDecoder -> IO ()

foreign import capi "hs_brotli.h &BrotliDecoderDestroyInstance"
    cp_BrotliDecoderDestroyInstance :: FunPtr (Ptr BrotliDecoder -> IO ())

foreign import capi "hs_brotli.h HsBrotliDecoderDecompressStream"
    c_BrotliDecoderDecompressStream :: Ptr BrotliDecoder
                                    -> Ptr CSize       {- available_in -}
                                    -> Ptr (Ptr Word8) {- next_in -}
                                    -> Ptr CSize       {- available_out -}
                                    -> Ptr (Ptr Word8) {- next_out -}
                                    -> Ptr CSize       {- total_out -}
                                    -> IO Word32
{-# LINE 438 "src/LibBrotli.hsc" #-}

-- foreign import capi unsafe "hs_brotli.h BrotliDecoderIsFinished"
--     c_BrotliDecoderIsFinished :: Ptr BrotliDecoder -> IO BrotliBool
--
-- foreign import capi unsafe "hs_brotli.h BrotliDecoderHasMoreOutput"
--     c_BrotliDecoderHasMoreOutput :: Ptr BrotliDecoder -> IO BrotliBool

foreign import capi unsafe "hs_brotli.h HsBrotliDecoderTakeOutput"
    c_BrotliDecoderTakeOutput :: Ptr BrotliDecoder -> Ptr CSize -> Ptr (Ptr Word8) -> IO HsBrotliState

-- e.g. 0x01000000
foreign import capi unsafe "hs_brotli.h BrotliDecoderVersion" brotliDecoderVersion :: Word32

foreign import capi unsafe "hs_brotli.h BrotliDecoderSetParameter"
    c_BrotliDecoderSetParameter :: Ptr BrotliDecoder -> Word32 -> Word32 -> IO BrotliBool
{-# LINE 453 "src/LibBrotli.hsc" #-}

foreign import capi unsafe "hs_brotli.h BrotliDecoderGetErrorCode"
    c_BrotliDecoderGetErrorCode :: Ptr BrotliDecoder -> IO Int32
{-# LINE 456 "src/LibBrotli.hsc" #-}

foreign import capi unsafe "hs_brotli.h HsBrotliDecoderErrorString"
    c_BrotliDecoderErrorString :: Int32 -> IO CString
{-# LINE 459 "src/LibBrotli.hsc" #-}