-- 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"