-- 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 :: Pkt -> [Pkt]
decompressPkt (CompressedDataPkt CompressionAlgorithm
algo CompressedDataPayload
bs) =
  case Get (Block Pkt)
-> CompressedDataPayload
-> Either
     (CompressedDataPayload, ByteOffset, String)
     (CompressedDataPayload, ByteOffset, Block Pkt)
forall a.
Get a
-> CompressedDataPayload
-> Either
     (CompressedDataPayload, ByteOffset, String)
     (CompressedDataPayload, ByteOffset, a)
runGetOrFail Get (Block Pkt)
forall t. Binary t => Get t
get (CompressionAlgorithm
-> CompressedDataPayload -> CompressedDataPayload
dfunc CompressionAlgorithm
algo CompressedDataPayload
bs) of
    Left (CompressedDataPayload, ByteOffset, String)
_ -> []
    Right (CompressedDataPayload
_, ByteOffset
_, Block Pkt
packs) -> Block Pkt -> [Pkt]
forall a. Block a -> [a]
unBlock Block Pkt
packs
  where
    dfunc :: CompressionAlgorithm
-> CompressedDataPayload -> CompressedDataPayload
dfunc CompressionAlgorithm
ZIP = CompressedDataPayload -> CompressedDataPayload
ZlibRaw.decompress
    dfunc CompressionAlgorithm
ZLIB = CompressedDataPayload -> CompressedDataPayload
Zlib.decompress
    dfunc CompressionAlgorithm
BZip2 = CompressedDataPayload -> CompressedDataPayload
BZip.decompress
    dfunc CompressionAlgorithm
_ = String -> CompressedDataPayload -> CompressedDataPayload
forall a. HasCallStack => String -> a
error String
"Compression algorithm not supported"
decompressPkt Pkt
p = [Pkt
p]

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