-- Compression.hs: OpenPGP (RFC4880) compression and decompression -- Copyright © 2012 Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Compression ( decompressPacket , compressPackets ) 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.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Serialize (get, put) import Data.Serialize.Get (runGet) import Data.Serialize.Put (runPut) decompressPacket :: Packet -> [Packet] decompressPacket (CompressedData algo bs') = case (runGet get . B.concat . BL.toChunks) (decompressPacket' algo bs') of Left _ -> [] Right packs -> unBlock packs where decompressPacket' :: CompressionAlgorithm -> ByteString -> BL.ByteString decompressPacket' ZIP bs = ZlibRaw.decompress $ BL.fromChunks [bs] decompressPacket' ZLIB bs = Zlib.decompress $ BL.fromChunks [bs] decompressPacket' BZip2 bs = BZip.decompress $ BL.fromChunks [bs] decompressPacket' _ _ = error "Compression algorithm not supported" decompressPacket p = [p] compressPackets :: CompressionAlgorithm -> [Packet] -> Packet compressPackets ca packs = do let bs' = runPut $ put (Block packs) let cbs = B.concat . BL.toChunks $ compressPackets' ca bs' CompressedData ca cbs where compressPackets' :: CompressionAlgorithm -> ByteString -> BL.ByteString compressPackets' ZIP bs = ZlibRaw.compress $ BL.fromChunks [bs] compressPackets' ZLIB bs = Zlib.compress $ BL.fromChunks [bs] compressPackets' BZip2 bs = BZip.compress $ BL.fromChunks [bs] compressPackets' _ _ = error "Compression algorithm not supported"