-- Compression.hs: OpenPGP (RFC4880) compression and decompression
-- Copyright © 2012-2015  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
module Codec.Encryption.OpenPGP.Compression
  ( decompressPkt
  , compressPkts
  ) where

import qualified Codec.Compression.BZip as BZip
import qualified Codec.Compression.Zlib as Zlib
import qualified Codec.Compression.Zlib.Raw as ZlibRaw
import Codec.Encryption.OpenPGP.Serialize ()
import Codec.Encryption.OpenPGP.Types
import Data.Binary (get, put)
import Data.Binary.Get (runGetOrFail)
import Data.Binary.Put (runPut)

decompressPkt :: Pkt -> [Pkt]
decompressPkt (CompressedDataPkt algo bs) =
  case runGetOrFail get (dfunc algo bs) of
    Left _ -> []
    Right (_, _, packs) -> unBlock packs
  where
    dfunc ZIP = ZlibRaw.decompress
    dfunc ZLIB = Zlib.decompress
    dfunc BZip2 = BZip.decompress
    dfunc _ = error "Compression algorithm not supported"
decompressPkt p = [p]

compressPkts :: CompressionAlgorithm -> [Pkt] -> Pkt
compressPkts ca packs =
  let bs = runPut $ put (Block packs)
      cbs = cfunc ca bs
   in CompressedDataPkt ca cbs
  where
    cfunc ZIP = ZlibRaw.compress
    cfunc ZLIB = Zlib.compress
    cfunc BZip2 = BZip.compress
    cfunc _ = error "Compression algorithm not supported"