-- Serialize.hs: OpenPGP (RFC4880) serialization (using cereal)
-- Copyright © 2012-2025  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
module Codec.Encryption.OpenPGP.Serialize
  (
  -- * Serialization functions
    putSKAddendum
  , getSecretKey
  -- * Utilities
  , parsePkts
  ) where

import Control.Applicative (many, some)
import Control.Lens ((^.), _1)
import Control.Monad (guard, replicateM, replicateM_)
import Crypto.Number.Basic (numBits)
import Crypto.Number.Serialize (i2osp, os2ip)
import qualified Crypto.PubKey.DSA as D
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Types as ECCT
import qualified Crypto.PubKey.RSA as R
import Data.Bifunctor (bimap)
import Data.Binary (Binary, get, put)
import Data.Binary.Get
  ( ByteOffset
  , Get
  , getByteString
  , getLazyByteString
  , getRemainingLazyByteString
  , getWord16be
  , getWord16le
  , getWord32be
  , getWord8
  , runGetOrFail
  )
import Data.Binary.Put
  ( Put
  , putByteString
  , putLazyByteString
  , putWord16be
  , putWord16le
  , putWord32be
  , putWord8
  , runPut
  )
import Data.Bits ((.&.), (.|.), shiftL, shiftR, testBit)
import qualified Data.ByteString as B
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Foldable as F
import Data.List (mapAccumL)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Word (Word16, Word32, Word8)
import Network.URI (nullURI, parseURI, uriToString)

import Codec.Encryption.OpenPGP.Internal
  ( curve2Curve
  , curveFromCurve
  , curveToCurveoidBS
  , curveoidBSToCurve
  , curveoidBSToEdSigningCurve
  , edSigningCurveToCurveoidBS
  , multiplicativeInverse
  , pubkeyToMPIs
  )
import Codec.Encryption.OpenPGP.Types

instance Binary SigSubPacket where
  get = getSigSubPacket
  put = putSigSubPacket

-- instance Binary (Set NotationFlag) where
--     put = putNotationFlagSet
instance Binary CompressionAlgorithm where
  get = toFVal <$> getWord8
  put = putWord8 . fromFVal

instance Binary PubKeyAlgorithm where
  get = toFVal <$> getWord8
  put = putWord8 . fromFVal

instance Binary HashAlgorithm where
  get = toFVal <$> getWord8
  put = putWord8 . fromFVal

instance Binary SymmetricAlgorithm where
  get = toFVal <$> getWord8
  put = putWord8 . fromFVal

instance Binary MPI where
  get = getMPI
  put = putMPI

instance Binary SigType where
  get = toFVal <$> getWord8
  put = putWord8 . fromFVal

instance Binary UserAttrSubPacket where
  get = getUserAttrSubPacket
  put = putUserAttrSubPacket

instance Binary S2K where
  get = getS2K
  put = putS2K

instance Binary PKESK where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary Signature where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary SKESK where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary OnePassSignature where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary SecretKey where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary PublicKey where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary SecretSubkey where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary CompressedData where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary SymEncData where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary Marker where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary LiteralData where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary Trust where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary UserId where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary PublicSubkey where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary UserAttribute where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary SymEncIntegrityProtectedData where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary ModificationDetectionCode where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary OtherPacket where
  get = fmap fromPkt getPkt
  put = putPkt . toPkt

instance Binary Pkt where
  get = getPkt
  put = putPkt

instance Binary a => Binary (Block a) where
  get = Block `fmap` many get
  put = mapM_ put . unBlock

instance Binary PKPayload where
  get = getPKPayload
  put = putPKPayload

instance Binary SignaturePayload where
  get = getSignaturePayload
  put = putSignaturePayload

instance Binary TK where
  get = undefined
  put = putTK

getSigSubPacket :: Get SigSubPacket
getSigSubPacket = do
  l <- fmap fromIntegral getSubPacketLength
  (crit, pt) <- getSigSubPacketType
  getSigSubPacket' pt crit l
  where
    getSigSubPacket' :: Word8 -> Bool -> ByteOffset -> Get SigSubPacket
    getSigSubPacket' pt crit l
      | pt == 2 = do
        et <- fmap ThirtyTwoBitTimeStamp getWord32be
        return $ SigSubPacket crit (SigCreationTime et)
      | pt == 3 = do
        et <- fmap ThirtyTwoBitDuration getWord32be
        return $ SigSubPacket crit (SigExpirationTime et)
      | pt == 4 = do
        e <- get
        return $ SigSubPacket crit (ExportableCertification e)
      | pt == 5 = do
        tl <- getWord8
        ta <- getWord8
        return $ SigSubPacket crit (TrustSignature tl ta)
      | pt == 6 = do
        apdre <- getLazyByteString (l - 2)
        nul <- getWord8
        guard (nul == 0)
        return $ SigSubPacket crit (RegularExpression (BL.copy apdre))
      | pt == 7 = do
        r <- get
        return $ SigSubPacket crit (Revocable r)
      | pt == 9 = do
        et <- fmap ThirtyTwoBitDuration getWord32be
        return $ SigSubPacket crit (KeyExpirationTime et)
      | pt == 11 = do
        sa <- replicateM (fromIntegral (l - 1)) get
        return $ SigSubPacket crit (PreferredSymmetricAlgorithms sa)
      | pt == 12 = do
        rclass <- getWord8
        guard (testBit rclass 7)
        algid <- get
        fp <- getLazyByteString 20
        return $
          SigSubPacket
            crit
            (RevocationKey
               (bsToFFSet . BL.singleton $ rclass .&. 0x7f)
               algid
               (TwentyOctetFingerprint fp))
      | pt == 16 = do
        keyid <- getLazyByteString (l - 1)
        return $ SigSubPacket crit (Issuer (EightOctetKeyId keyid))
      | pt == 20 = do
        flags <- getLazyByteString 4
        nl <- getWord16be
        vl <- getWord16be
        nn <- getLazyByteString (fromIntegral nl)
        nv <- getLazyByteString (fromIntegral vl)
        return $
          SigSubPacket
            crit
            (NotationData (bsToFFSet flags) (NotationName nn) (NotationValue nv))
      | pt == 21 = do
        ha <- replicateM (fromIntegral (l - 1)) get
        return $ SigSubPacket crit (PreferredHashAlgorithms ha)
      | pt == 22 = do
        ca <- replicateM (fromIntegral (l - 1)) get
        return $ SigSubPacket crit (PreferredCompressionAlgorithms ca)
      | pt == 23 = do
        ksps <- getLazyByteString (l - 1)
        return $ SigSubPacket crit (KeyServerPreferences (bsToFFSet ksps))
      | pt == 24 = do
        pks <- getLazyByteString (l - 1)
        return $ SigSubPacket crit (PreferredKeyServer pks)
      | pt == 25 = do
        primacy <- get
        return $ SigSubPacket crit (PrimaryUserId primacy)
      | pt == 26 = do
        url <-
          fmap
            (URL . fromMaybe nullURI . parseURI . T.unpack .
             decodeUtf8With lenientDecode)
            (getByteString (fromIntegral (l - 1)))
        return $ SigSubPacket crit (PolicyURL url)
      | pt == 27 = do
        kfs <- getLazyByteString (l - 1)
        return $ SigSubPacket crit (KeyFlags (bsToFFSet kfs))
      | pt == 28 = do
        uid <- getByteString (fromIntegral (l - 1))
        return $
          SigSubPacket crit (SignersUserId (decodeUtf8With lenientDecode uid))
      | pt == 29 = do
        rcode <- getWord8
        rreason <-
          fmap
            (decodeUtf8With lenientDecode)
            (getByteString (fromIntegral (l - 2)))
        return $ SigSubPacket crit (ReasonForRevocation (toFVal rcode) rreason)
      | pt == 30 = do
        fbs <- getLazyByteString (l - 1)
        return $ SigSubPacket crit (Features (bsToFFSet fbs))
      | pt == 31 = do
        pka <- get
        ha <- get
        hash <- getLazyByteString (l - 3)
        return $ SigSubPacket crit (SignatureTarget pka ha hash)
      | pt == 32 = do
        spbs <- getLazyByteString (l - 1)
        case runGetOrFail get spbs of
            Left (_, _, e) -> fail ("embedded signature subpacket " ++ e)
            Right (_, _, sp) -> return $ SigSubPacket crit (EmbeddedSignature sp)
      | pt == 33 = do
        kv <- getWord8
        fp <-
          getLazyByteString
            (if kv == 4
               then 20
               else 32)
        return $
          SigSubPacket crit (IssuerFingerprint kv (TwentyOctetFingerprint fp))
      | pt > 99 && pt < 111 = do
        payload <- getLazyByteString (l - 1)
        return $ SigSubPacket crit (UserDefinedSigSub pt payload)
      | otherwise = do
        payload <- getLazyByteString (l - 1)
        return $ SigSubPacket crit (OtherSigSub pt payload)

putSigSubPacket :: SigSubPacket -> Put
putSigSubPacket (SigSubPacket crit (SigCreationTime et)) = do
  putSubPacketLength 5
  putSigSubPacketType crit 2
  putWord32be . unThirtyTwoBitTimeStamp $ et
putSigSubPacket (SigSubPacket crit (SigExpirationTime et)) = do
  putSubPacketLength 5
  putSigSubPacketType crit 3
  putWord32be . unThirtyTwoBitDuration $ et
putSigSubPacket (SigSubPacket crit (ExportableCertification e)) = do
  putSubPacketLength 2
  putSigSubPacketType crit 4
  put e
putSigSubPacket (SigSubPacket crit (TrustSignature tl ta)) = do
  putSubPacketLength 3
  putSigSubPacketType crit 5
  put tl
  put ta
putSigSubPacket (SigSubPacket crit (RegularExpression apdre)) = do
  putSubPacketLength . fromIntegral $ (2 + BL.length apdre)
  putSigSubPacketType crit 6
  putLazyByteString apdre
  putWord8 0
putSigSubPacket (SigSubPacket crit (Revocable r)) = do
  putSubPacketLength 2
  putSigSubPacketType crit 7
  put r
putSigSubPacket (SigSubPacket crit (KeyExpirationTime et)) = do
  putSubPacketLength 5
  putSigSubPacketType crit 9
  putWord32be . unThirtyTwoBitDuration $ et
putSigSubPacket (SigSubPacket crit (PreferredSymmetricAlgorithms ess)) = do
  putSubPacketLength . fromIntegral $ (1 + length ess)
  putSigSubPacketType crit 11
  mapM_ put ess
putSigSubPacket (SigSubPacket crit (RevocationKey rclass algid fp)) = do
  putSubPacketLength 23
  putSigSubPacketType crit 12
  putLazyByteString . ffSetToFixedLengthBS (1 :: Int) $
    Set.insert (RClOther 0) rclass
  put algid
  putLazyByteString (unTOF fp) -- 20 octets
putSigSubPacket (SigSubPacket crit (Issuer keyid)) = do
  putSubPacketLength 9
  putSigSubPacketType crit 16
  putLazyByteString (unEOKI keyid) -- 8 octets
putSigSubPacket (SigSubPacket crit (NotationData nfs (NotationName nn) (NotationValue nv))) = do
  putSubPacketLength . fromIntegral $ (9 + BL.length nn + BL.length nv)
  putSigSubPacketType crit 20
  putLazyByteString . ffSetToFixedLengthBS (4 :: Int) $ nfs
  putWord16be . fromIntegral . BL.length $ nn
  putWord16be . fromIntegral . BL.length $ nv
  putLazyByteString nn
  putLazyByteString nv
putSigSubPacket (SigSubPacket crit (PreferredHashAlgorithms ehs)) = do
  putSubPacketLength . fromIntegral $ (1 + length ehs)
  putSigSubPacketType crit 21
  mapM_ put ehs
putSigSubPacket (SigSubPacket crit (PreferredCompressionAlgorithms ecs)) = do
  putSubPacketLength . fromIntegral $ (1 + length ecs)
  putSigSubPacketType crit 22
  mapM_ put ecs
putSigSubPacket (SigSubPacket crit (KeyServerPreferences ksps)) = do
  let kbs = ffSetToBS ksps
  putSubPacketLength . fromIntegral $ (1 + BL.length kbs)
  putSigSubPacketType crit 23
  putLazyByteString kbs
putSigSubPacket (SigSubPacket crit (PreferredKeyServer ks)) = do
  putSubPacketLength . fromIntegral $ (1 + BL.length ks)
  putSigSubPacketType crit 24
  putLazyByteString ks
putSigSubPacket (SigSubPacket crit (PrimaryUserId primacy)) = do
  putSubPacketLength 2
  putSigSubPacketType crit 25
  put primacy
putSigSubPacket (SigSubPacket crit (PolicyURL (URL uri))) = do
  let bs = encodeUtf8 (T.pack (uriToString id uri ""))
  putSubPacketLength . fromIntegral $ (1 + B.length bs)
  putSigSubPacketType crit 26
  putByteString bs
putSigSubPacket (SigSubPacket crit (KeyFlags kfs)) = do
  let kbs = ffSetToBS kfs
  putSubPacketLength . fromIntegral $ (1 + BL.length kbs)
  putSigSubPacketType crit 27
  putLazyByteString kbs
putSigSubPacket (SigSubPacket crit (SignersUserId userid)) = do
  let bs = encodeUtf8 userid
  putSubPacketLength . fromIntegral $ (1 + B.length bs)
  putSigSubPacketType crit 28
  putByteString bs
putSigSubPacket (SigSubPacket crit (ReasonForRevocation rcode rreason)) = do
  let reasonbs = encodeUtf8 rreason
  putSubPacketLength . fromIntegral $ (2 + B.length reasonbs)
  putSigSubPacketType crit 29
  putWord8 . fromFVal $ rcode
  putByteString reasonbs
putSigSubPacket (SigSubPacket crit (Features fs)) = do
  let fbs = ffSetToBS fs
  putSubPacketLength . fromIntegral $ (1 + BL.length fbs)
  putSigSubPacketType crit 30
  putLazyByteString fbs
putSigSubPacket (SigSubPacket crit (SignatureTarget pka ha hash)) = do
  putSubPacketLength . fromIntegral $ (3 + BL.length hash)
  putSigSubPacketType crit 31
  put pka
  put ha
  putLazyByteString hash
putSigSubPacket (SigSubPacket crit (EmbeddedSignature sp)) = do
  let spb = runPut (put sp)
  putSubPacketLength . fromIntegral $ (1 + BL.length spb)
  putSigSubPacketType crit 32
  putLazyByteString spb
putSigSubPacket (SigSubPacket crit (IssuerFingerprint kv fp)) = do
  let fpb = unTOF fp
  putSubPacketLength . fromIntegral $ (2 + BL.length fpb)
  putSigSubPacketType crit 33
  putWord8 kv
  putLazyByteString fpb
putSigSubPacket (SigSubPacket crit (UserDefinedSigSub ptype payload)) =
  putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload))
putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload)) = do
  putSubPacketLength . fromIntegral $ (1 + BL.length payload)
  putSigSubPacketType crit ptype
  putLazyByteString payload

getSubPacketLength :: Get Word32
getSubPacketLength = getSubPacketLength' =<< getWord8
  where
    getSubPacketLength' :: Integral a => Word8 -> Get a
    getSubPacketLength' f
      | f < 192 = return . fromIntegral $ f
      | f < 224 = do
        secondOctet <- getWord8
        return . fromIntegral $ shiftL (fromIntegral (f - 192) :: Int) 8 +
          (fromIntegral secondOctet :: Int) +
          192
      | f == 255 = do
        len <- getWord32be
        return . fromIntegral $ len
      | otherwise = fail "Partial body length invalid."

putSubPacketLength :: Word32 -> Put
putSubPacketLength l
  | l < 192 = putWord8 (fromIntegral l)
  | l < 8384 =
    putWord8 (fromIntegral ((fromIntegral (l - 192) `shiftR` 8) + 192 :: Int)) >>
    putWord8 (fromIntegral (l - 192) .&. 0xff)
  | l <= 0xffffffff = putWord8 255 >> putWord32be (fromIntegral l)
  | otherwise = error ("too big (" ++ show l ++ ")")

getSigSubPacketType :: Get (Bool, Word8)
getSigSubPacketType = do
  x <- getWord8
  return
    (if x .&. 128 == 128
       then (True, x .&. 127)
       else (False, x))

putSigSubPacketType :: Bool -> Word8 -> Put
putSigSubPacketType False sst = putWord8 sst
putSigSubPacketType True sst = putWord8 (sst .|. 0x80)

bsToFFSet :: FutureFlag a => ByteString -> Set a
bsToFFSet bs =
  Set.fromAscList . concat . snd $
  mapAccumL
    (\acc y -> (acc + 8, concatMap (shifty acc y) [0 .. 7]))
    0
    (BL.unpack bs)
  where
    shifty acc y x = [toFFlag (acc + x) | y .&. shiftR 128 x == shiftR 128 x]

ffSetToFixedLengthBS :: (Integral a, FutureFlag b) => a -> Set b -> ByteString
ffSetToFixedLengthBS len ffs =
  BL.take
    (fromIntegral len)
    (BL.append (ffSetToBS ffs) (BL.pack (replicate 5 0)))

ffSetToBS :: FutureFlag a => Set a -> ByteString
ffSetToBS = BL.pack . ffSetToBS'
  where
    ffSetToBS' :: FutureFlag a => Set a -> [Word8]
    ffSetToBS' ks
      | Set.null ks = [] -- FIXME: should this be [0]?
      | otherwise =
        map
          ((foldl (.|.) 0 . map (shiftR 128 . flip mod 8 . fromFFlag) .
            Set.toAscList) .
           (\x -> Set.filter (\y -> fromFFlag y `div` 8 == x) ks))
          [0 .. fromFFlag (Set.findMax ks) `div` 8]

fromS2K :: S2K -> ByteString
fromS2K (Simple hashalgo) = BL.pack [0, fromIntegral . fromFVal $ hashalgo]
fromS2K (Salted hashalgo salt)
  | B.length (unSalt salt) == 8 =
    BL.pack [1, fromIntegral . fromFVal $ hashalgo] `BL.append`
    (BL.fromStrict . unSalt) salt
  | otherwise = error "Confusing salt size"
fromS2K (IteratedSalted hashalgo salt count)
  | B.length (unSalt salt) == 8 =
    BL.pack [3, fromIntegral . fromFVal $ hashalgo] `BL.append`
    (BL.fromStrict . unSalt) salt `BL.snoc`
    encodeIterationCount count
  | otherwise = error "Confusing salt size"
fromS2K (OtherS2K _ bs) = bs

getPacketLength :: Get Integer
getPacketLength = do
  firstOctet <- getWord8
  getPacketLength' firstOctet
  where
    getPacketLength' :: Integral a => Word8 -> Get a
    getPacketLength' f
      | f < 192 = return . fromIntegral $ f
      | f < 224 = do
        secondOctet <- getWord8
        return . fromIntegral $ shiftL (fromIntegral (f - 192) :: Int) 8 +
          (fromIntegral secondOctet :: Int) +
          192
      | f == 255 = do
        len <- getWord32be
        return . fromIntegral $ len
      | otherwise = fail "Partial body length support missing." --FIXME

putPacketLength :: Integer -> Put
putPacketLength l
  | l < 192 = putWord8 (fromIntegral l)
  | l < 8384 =
    putWord8 (fromIntegral ((fromIntegral (l - 192) `shiftR` 8) + 192 :: Int)) >>
    putWord8 (fromIntegral (l - 192) .&. 0xff)
  | l < 0x100000000 = putWord8 255 >> putWord32be (fromIntegral l)
  | otherwise = error "partial body length support needed" -- FIXME

getS2K :: Get S2K
getS2K = getS2K' =<< getWord8
  where
    getS2K' :: Word8 -> Get S2K
    getS2K' t
      | t == 0 = do
        ha <- getWord8
        return $ Simple (toFVal ha)
      | t == 1 = do
        ha <- getWord8
        salt <- getByteString 8
        return $ Salted (toFVal ha) (Salt salt)
      | t == 3 = do
        ha <- getWord8
        salt <- getByteString 8
        count <- getWord8
        return $
          IteratedSalted (toFVal ha) (Salt salt) (decodeIterationCount count)
      | otherwise = do
        bs <- getRemainingLazyByteString
        return $ OtherS2K t bs

putS2K :: S2K -> Put
putS2K (Simple hashalgo) = error ("confused by simple" ++ show hashalgo)
putS2K (Salted hashalgo salt) =
  error ("confused by salted" ++ show hashalgo ++ " by " ++ show salt)
putS2K (IteratedSalted ha salt count) = do
  putWord8 3
  put ha
  putByteString (unSalt salt)
  putWord8 $ encodeIterationCount count
putS2K (OtherS2K t bs) = putWord8 t >> putLazyByteString bs

getPacketTypeAndPayload :: Get (Word8, ByteString)
getPacketTypeAndPayload = do
  tag <- getWord8
  guard (testBit tag 7)
  case tag .&. 0x40 of
    0x00 -> do
      let t = shiftR (tag .&. 0x3c) 2
      case tag .&. 0x03 of
        0 -> do
          len <- getWord8
          bs <- getLazyByteString (fromIntegral len)
          return (t, bs)
        1 -> do
          len <- getWord16be
          bs <- getLazyByteString (fromIntegral len)
          return (t, bs)
        2 -> do
          len <- getWord32be
          bs <- getLazyByteString (fromIntegral len)
          return (t, bs)
        3 -> do
          bs <- getRemainingLazyByteString
          return (t, bs)
        _ -> error "This should never happen (getPacketTypeAndPayload/0x00)."
    0x40 -> do
      len <- fmap fromIntegral getPacketLength
      bs <- getLazyByteString len
      return (tag .&. 0x3f, bs)
    _ -> error "This should never happen (getPacketTypeAndPayload/???)."

getPkt :: Get Pkt
getPkt = do
  (t, pl) <- getPacketTypeAndPayload
  case runGetOrFail (getPkt' t (BL.length pl)) pl of
    Left (_, _, e) -> return $! BrokenPacketPkt e t pl
    Right (_, _, p) -> return p
  where
    getPkt' :: Word8 -> ByteOffset -> Get Pkt
    getPkt' t len
      | t == 1 = do
        pv <- getWord8
        eokeyid <- getLazyByteString 8
        pka <- getWord8
        mpib <- getRemainingLazyByteString
        case runGetOrFail (some getMPI) mpib of
          Left (_, _, e) -> fail ("PKESK MPIs " ++ e)
          Right (_, _, sk) ->
            return $
            PKESKPkt pv (EightOctetKeyId eokeyid) (toFVal pka) (NE.fromList sk)
      | t == 2 = do
        bs <- getRemainingLazyByteString
        case runGetOrFail get bs of
          Left (_, _, e) -> fail ("signature packet " ++ e)
          Right (_, _, sp) -> return $ SignaturePkt sp
      | t == 3 = do
        pv <- getWord8
        symalgo <- getWord8
        s2k <- getS2K
        esk <- getRemainingLazyByteString
        return $
          SKESKPkt
            pv
            (toFVal symalgo)
            s2k
            (if BL.null esk
               then Nothing
               else Just esk)
      | t == 4 = do
        pv <- getWord8
        sigtype <- getWord8
        ha <- getWord8
        pka <- getWord8
        skeyid <- getLazyByteString 8
        nested <- getWord8
        return $
          OnePassSignaturePkt
            pv
            (toFVal sigtype)
            (toFVal ha)
            (toFVal pka)
            (EightOctetKeyId skeyid)
            (nested == 0)
      | t == 5 = do
        bs <- getLazyByteString len
        let ps =
              flip runGetOrFail bs $ do
                pkp <- getPKPayload
                ska <- getSKAddendum pkp
                return $ SecretKeyPkt pkp ska
        case ps of
          Left (_, _, err) -> fail ("secret key " ++ err)
          Right (_, _, key) -> return key
      | t == 6 = do
        pkp <- getPKPayload
        return $ PublicKeyPkt pkp
      | t == 7 = do
        bs <- getLazyByteString len
        let ps =
              flip runGetOrFail bs $ do
                pkp <- getPKPayload
                ska <- getSKAddendum pkp
                return $ SecretSubkeyPkt pkp ska
        case ps of
          Left (_, _, err) -> fail ("secret subkey " ++ err)
          Right (_, _, key) -> return key
      | t == 8 = do
        ca <- getWord8
        cdata <- getLazyByteString (len - 1)
        return $ CompressedDataPkt (toFVal ca) cdata
      | t == 9 = do
        sdata <- getLazyByteString len
        return $ SymEncDataPkt sdata
      | t == 10 = do
        marker <- getLazyByteString len
        return $ MarkerPkt marker
      | t == 11 = do
        dt <- getWord8
        flen <- getWord8
        fn <- getLazyByteString (fromIntegral flen)
        ts <- fmap ThirtyTwoBitTimeStamp getWord32be
        ldata <- getLazyByteString (len - (6 + fromIntegral flen))
        return $ LiteralDataPkt (toFVal dt) fn ts ldata
      | t == 12 = do
        tdata <- getLazyByteString len
        return $ TrustPkt tdata
      | t == 13 = do
        udata <- getByteString (fromIntegral len)
        return . UserIdPkt . decodeUtf8With lenientDecode $ udata
      | t == 14 = do
        bs <- getLazyByteString len
        let ps =
              flip runGetOrFail bs $ do
                pkp <- getPKPayload
                return $ PublicSubkeyPkt pkp
        case ps of
          Left (_, _, err) -> fail ("public subkey " ++ err)
          Right (_, _, key) -> return key
      | t == 17 = do
        bs <- getLazyByteString len
        case runGetOrFail (many getUserAttrSubPacket) bs of
          Left (_, _, err) -> fail ("user attribute " ++ err)
          Right (_, _, uas) -> return $ UserAttributePkt uas
      | t == 18 = do
        pv <- getWord8 -- should be 1
        b <- getLazyByteString (len - 1)
        return $ SymEncIntegrityProtectedDataPkt pv b
      | t == 19 = do
        hash <- getLazyByteString 20
        return $ ModificationDetectionCodePkt hash
      | otherwise = do
        payload <- getLazyByteString len
        return $ OtherPacketPkt t payload

getUserAttrSubPacket :: Get UserAttrSubPacket
getUserAttrSubPacket = do
  l <- fmap fromIntegral getSubPacketLength
  t <- getWord8
  getUserAttrSubPacket' t l
  where
    getUserAttrSubPacket' :: Word8 -> ByteOffset -> Get UserAttrSubPacket
    getUserAttrSubPacket' t l
      | t == 1 = do
        _ <- getWord16le -- ihlen
        hver <- getWord8 -- should be 1
        iformat <- getWord8
        nuls <- getLazyByteString 12 -- should be NULs
        bs <- getLazyByteString (l - 17)
        if hver /= 1 || nuls /= BL.pack (replicate 12 0)
          then fail "Corrupt UAt subpacket"
          else return $ ImageAttribute (ImageHV1 (toFVal iformat)) bs
      | otherwise = do
        bs <- getLazyByteString (l - 1)
        return $ OtherUASub t bs

putUserAttrSubPacket :: UserAttrSubPacket -> Put
putUserAttrSubPacket ua = do
  let sp = runPut $ putUserAttrSubPacket' ua
  putSubPacketLength . fromIntegral . BL.length $ sp
  putLazyByteString sp
  where
    putUserAttrSubPacket' (ImageAttribute (ImageHV1 iformat) idata) = do
      putWord8 1
      putWord16le 16
      putWord8 1
      putWord8 (fromFVal iformat)
      replicateM_ 12 $ putWord8 0
      putLazyByteString idata
    putUserAttrSubPacket' (OtherUASub t bs) = do
      putWord8 t
      putLazyByteString bs

putPkt :: Pkt -> Put
putPkt (PKESKPkt pv eokeyid pka mpis) = do
  putWord8 (0xc0 .|. 1)
  let bsk = runPut $ F.mapM_ put mpis
  putPacketLength . fromIntegral $ 10 + BL.length bsk
  putWord8 pv -- must be 3
  putLazyByteString (unEOKI eokeyid) -- must be 8 octets
  putWord8 $ fromIntegral . fromFVal $ pka
  putLazyByteString bsk
putPkt (SignaturePkt sp) = do
  putWord8 (0xc0 .|. 2)
  let bs = runPut $ put sp
  putLengthThenPayload bs
putPkt (SKESKPkt pv symalgo s2k mesk) = do
  putWord8 (0xc0 .|. 3)
  let bs2k = fromS2K s2k
  let bsk = fromMaybe BL.empty mesk
  putPacketLength . fromIntegral $ 2 + BL.length bs2k + BL.length bsk
  putWord8 pv -- should be 4
  putWord8 $ fromIntegral . fromFVal $ symalgo
  putLazyByteString bs2k
  putLazyByteString bsk
putPkt (OnePassSignaturePkt pv sigtype ha pka skeyid nested) = do
  putWord8 (0xc0 .|. 4)
  let bs =
        runPut $ do
          putWord8 pv -- should be 3
          putWord8 $ fromIntegral . fromFVal $ sigtype
          putWord8 $ fromIntegral . fromFVal $ ha
          putWord8 $ fromIntegral . fromFVal $ pka
          putLazyByteString (unEOKI skeyid)
          putWord8 . fromIntegral . fromEnum $ not nested -- FIXME: what do other values mean?
  putLengthThenPayload bs
putPkt (SecretKeyPkt pkp ska) = do
  putWord8 (0xc0 .|. 5)
  let bs = runPut (putPKPayload pkp >> putSKAddendum ska)
  putLengthThenPayload bs
putPkt (PublicKeyPkt pkp) = do
  putWord8 (0xc0 .|. 6)
  let bs = runPut $ putPKPayload pkp
  putLengthThenPayload bs
putPkt (SecretSubkeyPkt pkp ska) = do
  putWord8 (0xc0 .|. 7)
  let bs = runPut (putPKPayload pkp >> putSKAddendum ska)
  putLengthThenPayload bs
putPkt (CompressedDataPkt ca cdata) = do
  putWord8 (0xc0 .|. 8)
  let bs =
        runPut $ do
          putWord8 $ fromIntegral . fromFVal $ ca
          putLazyByteString cdata
  putLengthThenPayload bs
putPkt (SymEncDataPkt b) = do
  putWord8 (0xc0 .|. 9)
  putLengthThenPayload b
putPkt (MarkerPkt b) = do
  putWord8 (0xc0 .|. 10)
  putLengthThenPayload b
putPkt (LiteralDataPkt dt fn ts b) = do
  putWord8 (0xc0 .|. 11)
  let bs =
        runPut $ do
          putWord8 $ fromIntegral . fromFVal $ dt
          putWord8 $ fromIntegral . BL.length $ fn
          putLazyByteString fn
          putWord32be . unThirtyTwoBitTimeStamp $ ts
          putLazyByteString b
  putLengthThenPayload bs
putPkt (TrustPkt b) = do
  putWord8 (0xc0 .|. 12)
  putLengthThenPayload b
putPkt (UserIdPkt u) = do
  putWord8 (0xc0 .|. 13)
  let bs = encodeUtf8 u
  putPacketLength . fromIntegral $ B.length bs
  putByteString bs
putPkt (PublicSubkeyPkt pkp) = do
  putWord8 (0xc0 .|. 14)
  let bs = runPut $ putPKPayload pkp
  putLengthThenPayload bs
putPkt (UserAttributePkt us) = do
  putWord8 (0xc0 .|. 17)
  let bs = runPut $ mapM_ put us
  putLengthThenPayload bs
putPkt (SymEncIntegrityProtectedDataPkt pv b) = do
  putWord8 (0xc0 .|. 18)
  putPacketLength . fromIntegral $ BL.length b + 1
  putWord8 pv -- should be 1
  putLazyByteString b
putPkt (ModificationDetectionCodePkt hash) = do
  putWord8 (0xc0 .|. 19)
  putLengthThenPayload hash
putPkt (OtherPacketPkt t payload) = do
  putWord8 (0xc0 .|. t) -- FIXME: restrict t
  putLengthThenPayload payload
putPkt (BrokenPacketPkt _ t payload) = putPkt (OtherPacketPkt t payload)

putLengthThenPayload :: ByteString -> Put
putLengthThenPayload bs = do
  putPacketLength . fromIntegral $ BL.length bs
  putLazyByteString bs

getMPI :: Get MPI
getMPI = do
  mpilen <- getWord16be
  bs <- getByteString (fromIntegral (mpilen + 7) `div` 8)
  return $ MPI (os2ip bs)

getPubkey :: PubKeyAlgorithm -> Get PKey
getPubkey RSA = do
  MPI n <- get
  MPI e <- get
  return $
    RSAPubKey
      (RSA_PublicKey (R.PublicKey (fromIntegral . B.length . i2osp $ n) n e))
getPubkey DeprecatedRSAEncryptOnly = getPubkey RSA
getPubkey DeprecatedRSASignOnly = getPubkey RSA
getPubkey DSA = do
  MPI p <- get
  MPI q <- get
  MPI g <- get
  MPI y <- get
  return $ DSAPubKey (DSA_PublicKey (D.PublicKey (D.Params p g q) y))
getPubkey ElgamalEncryptOnly = getPubkey ForbiddenElgamal
getPubkey ForbiddenElgamal = do
  MPI p <- get
  MPI g <- get
  MPI y <- get
  return $ ElGamalPubKey p g y
getPubkey ECDSA = do
  curvelength <- getWord8 -- FIXME: test for 0 or 0xFF as they are reserved
  curveoid <- getByteString (fromIntegral curvelength)
  MPI mpi <- getMPI -- FIXME: check length against curve type?
  case curveoidBSToCurve curveoid of
    Left e -> fail e
    Right Curve25519 -> return $ EdDSAPubKey Ed25519 (EPoint mpi)
    Right curve ->
      case bs2Point (i2osp mpi) of
        Left e -> fail e
        Right point ->
          return . ECDSAPubKey . ECDSA_PublicKey .
          ECDSA.PublicKey (curve2Curve curve) $
          point
getPubkey ECDH = do
  ed <- getPubkey ECDSA -- could be an ECDSA or an EdDSA
  kdflen <- getWord8 -- FIXME: should be 3, test for 0 or 0xFF as they are reserved
  one <- getWord8 -- FIXME: should be 1
  kdfHA <- get
  kdfSA <- get
  return $ ECDHPubKey ed kdfHA kdfSA
getPubkey EdDSA = do
  curvelength <- getWord8 -- FIXME: test for 0 or 0xFF as they are reserved
  curveoid <- getByteString (fromIntegral curvelength)
  MPI mpi <- getMPI -- FIXME: check length against curve type?
  case curveoidBSToEdSigningCurve curveoid of
    Left e -> fail e
    Right Ed25519 -> return . EdDSAPubKey Ed25519 $ EPoint mpi
getPubkey _ = UnknownPKey <$> getRemainingLazyByteString

bs2Point :: B.ByteString -> Either String ECDSA.PublicPoint
bs2Point bs =
  let xy = B.drop 1 bs
   in let l = B.length xy
       in if B.head bs == 0x04
            then return
                   (uncurry
                      ECCT.Point
                      (bimap os2ip os2ip (B.splitAt (div l 2) xy)))
            else Left $ "unknown type of point: " ++ show (B.unpack bs)

putPubkey :: PKey -> Put
putPubkey (UnknownPKey bs) = putLazyByteString bs
putPubkey p@(ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) =
  let Right curveoidbs = curveToCurveoidBS (curveFromCurve curve)
   in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >>
      mapM_ put (pubkeyToMPIs p) -- FIXME: do not output length 0 or 0xff
putPubkey p@(ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) kha ksa) =
  let Right curveoidbs = curveToCurveoidBS (curveFromCurve curve)
   in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >>
      mapM_ put (pubkeyToMPIs p) >>
      putWord8 0x03 >>
      putWord8 0x01 >>
      put kha >>
      put ksa -- FIXME: do not output length 0 or 0xff
putPubkey p@(ECDHPubKey (EdDSAPubKey curve _) kha ksa) =
  let Right curveoidbs = curveToCurveoidBS (ed2ec curve)
   in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >>
      mapM_ put (pubkeyToMPIs p) >>
      putWord8 0x03 >>
      putWord8 0x01 >>
      put kha >>
      put ksa -- FIXME: do not output length 0 or 0xff
  where
    ed2ec Ed25519 = Curve25519
putPubkey p@(EdDSAPubKey curve _) =
  let Right curveoidbs = edSigningCurveToCurveoidBS curve
   in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >>
      mapM_ put (pubkeyToMPIs p) -- FIXME: do not output length 0 or 0xff
putPubkey p = mapM_ put (pubkeyToMPIs p)

getSecretKey :: PKPayload -> Get SKey
getSecretKey pkp
  | _pkalgo pkp `elem` [RSA, DeprecatedRSAEncryptOnly, DeprecatedRSASignOnly] = do
    MPI d <- get
    MPI p <- get
    MPI q <- get
    MPI _ <- get -- u
    let dP = 0
        dQ = 0
        qinv = 0
        pub = (\(RSAPubKey (RSA_PublicKey x)) -> x) (pkp ^. pubkey)
    return $ RSAPrivateKey (RSA_PrivateKey (R.PrivateKey pub d p q dP dQ qinv))
  | _pkalgo pkp == DSA = do
    MPI x <- get
    return $ DSAPrivateKey (DSA_PrivateKey (D.PrivateKey (D.Params 0 0 0) x))
  | _pkalgo pkp `elem` [ElgamalEncryptOnly, ForbiddenElgamal] = do
    MPI x <- get
    return $ ElGamalPrivateKey x
  | _pkalgo pkp == ECDSA = do
    MPI pn <- get
    let pubcurve =
          (\(ECDSAPubKey (ECDSA_PublicKey p)) -> ECDSA.public_curve p)
            (pkp ^. pubkey)
    return $ ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey pubcurve pn))
  | _pkalgo pkp == ECDH -- FIXME: deduplicate this and above
   = do
    MPI pn <- get
    let pubcurve =
          (\(ECDSAPubKey (ECDSA_PublicKey p)) -> ECDSA.public_curve p)
            (pkp ^. pubkey)
    return $ ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey pubcurve pn))

putSKey :: SKey -> Put
putSKey (RSAPrivateKey (RSA_PrivateKey (R.PrivateKey _ d p q _ _ _))) =
  put (MPI d) >> put (MPI p) >> put (MPI q) >> put (MPI u)
  where
    u = multiplicativeInverse q p

putMPI :: MPI -> Put
putMPI (MPI i) = do
  let bs = i2osp i
  putWord16be . fromIntegral . numBits $ i
  putByteString bs

getPKPayload :: Get PKPayload
getPKPayload = do
  version <- getWord8
  ctime <- fmap ThirtyTwoBitTimeStamp getWord32be
  if version `elem` [2, 3]
    then do
      v3e <- getWord16be
      pka <- get
      pk <- getPubkey pka
      return $! PKPayload DeprecatedV3 ctime v3e pka pk
    else do
      pka <- get
      pk <- getPubkey pka
      return $! PKPayload V4 ctime 0 pka pk

putPKPayload :: PKPayload -> Put
putPKPayload (PKPayload DeprecatedV3 ctime v3e pka pk) = do
  putWord8 3
  putWord32be . unThirtyTwoBitTimeStamp $ ctime
  putWord16be v3e
  put pka
  putPubkey pk
putPKPayload (PKPayload V4 ctime _ pka pk) = do
  putWord8 4
  putWord32be . unThirtyTwoBitTimeStamp $ ctime
  put pka
  putPubkey pk

getSKAddendum :: PKPayload -> Get SKAddendum
getSKAddendum pkp = do
  s2kusage <- getWord8
  case s2kusage of
    0 -> do
      sk <- getSecretKey pkp
      checksum <- getWord16be -- FIXME: validate checksum?
      return $ SUUnencrypted sk checksum
    255 -> do
      symenc <- getWord8
      s2k <- getS2K
      case s2k -- FIXME: this is a mess
            of
        OtherS2K _ _ -> return $ SUS16bit (toFVal symenc) s2k mempty BL.empty
        _ -> do
          iv <- getByteString (symEncBlockSize . toFVal $ symenc)
          encryptedblock <- getRemainingLazyByteString
          return $ SUS16bit (toFVal symenc) s2k (IV iv) encryptedblock
    254 -> do
      symenc <- getWord8
      s2k <- getS2K
      case s2k -- FIXME: this is a mess
            of
        OtherS2K _ _ -> return $ SUSSHA1 (toFVal symenc) s2k mempty BL.empty
        _ -> do
          iv <- getByteString (symEncBlockSize . toFVal $ symenc)
          encryptedblock <- getRemainingLazyByteString
          return $ SUSSHA1 (toFVal symenc) s2k (IV iv) encryptedblock
    symenc -> do
      iv <- getByteString (symEncBlockSize . toFVal $ symenc)
      encryptedblock <- getRemainingLazyByteString
      return $ SUSym (toFVal symenc) (IV iv) encryptedblock

putSKAddendum :: SKAddendum -> Put
putSKAddendum (SUSSHA1 symenc s2k iv encryptedblock) = do
  putWord8 254
  put symenc
  put s2k
  putByteString (unIV iv)
  putLazyByteString encryptedblock
putSKAddendum (SUUnencrypted sk checksum) = do
  putWord8 0
  let skb = runPut (putSKey sk)
  putLazyByteString skb
  putWord16be
    (if checksum == 0
       then BL.foldl (\a b -> mod (a + fromIntegral b) 0xffff) (0 :: Word16) skb
       else checksum) -- FIXME: be saner
putSKAddendum _ = error "Type not supported"

symEncBlockSize :: SymmetricAlgorithm -> Int
symEncBlockSize Plaintext = 0
symEncBlockSize IDEA = 8
symEncBlockSize TripleDES = 8
symEncBlockSize CAST5 = 8
symEncBlockSize Blowfish = 8
symEncBlockSize AES128 = 16
symEncBlockSize AES192 = 16
symEncBlockSize AES256 = 16
symEncBlockSize Twofish = 16
symEncBlockSize Camellia128 = 16
symEncBlockSize _ = 8 -- FIXME

decodeIterationCount :: Word8 -> IterationCount
decodeIterationCount c =
  IterationCount
    ((16 + (fromIntegral c .&. 15)) `shiftL` ((fromIntegral c `shiftR` 4) + 6))

encodeIterationCount :: IterationCount -> Word8 -- should this really be a lookup table?
encodeIterationCount 1024 = 0
encodeIterationCount 1088 = 1
encodeIterationCount 1152 = 2
encodeIterationCount 1216 = 3
encodeIterationCount 1280 = 4
encodeIterationCount 1344 = 5
encodeIterationCount 1408 = 6
encodeIterationCount 1472 = 7
encodeIterationCount 1536 = 8
encodeIterationCount 1600 = 9
encodeIterationCount 1664 = 10
encodeIterationCount 1728 = 11
encodeIterationCount 1792 = 12
encodeIterationCount 1856 = 13
encodeIterationCount 1920 = 14
encodeIterationCount 1984 = 15
encodeIterationCount 2048 = 16
encodeIterationCount 2176 = 17
encodeIterationCount 2304 = 18
encodeIterationCount 2432 = 19
encodeIterationCount 2560 = 20
encodeIterationCount 2688 = 21
encodeIterationCount 2816 = 22
encodeIterationCount 2944 = 23
encodeIterationCount 3072 = 24
encodeIterationCount 3200 = 25
encodeIterationCount 3328 = 26
encodeIterationCount 3456 = 27
encodeIterationCount 3584 = 28
encodeIterationCount 3712 = 29
encodeIterationCount 3840 = 30
encodeIterationCount 3968 = 31
encodeIterationCount 4096 = 32
encodeIterationCount 4352 = 33
encodeIterationCount 4608 = 34
encodeIterationCount 4864 = 35
encodeIterationCount 5120 = 36
encodeIterationCount 5376 = 37
encodeIterationCount 5632 = 38
encodeIterationCount 5888 = 39
encodeIterationCount 6144 = 40
encodeIterationCount 6400 = 41
encodeIterationCount 6656 = 42
encodeIterationCount 6912 = 43
encodeIterationCount 7168 = 44
encodeIterationCount 7424 = 45
encodeIterationCount 7680 = 46
encodeIterationCount 7936 = 47
encodeIterationCount 8192 = 48
encodeIterationCount 8704 = 49
encodeIterationCount 9216 = 50
encodeIterationCount 9728 = 51
encodeIterationCount 10240 = 52
encodeIterationCount 10752 = 53
encodeIterationCount 11264 = 54
encodeIterationCount 11776 = 55
encodeIterationCount 12288 = 56
encodeIterationCount 12800 = 57
encodeIterationCount 13312 = 58
encodeIterationCount 13824 = 59
encodeIterationCount 14336 = 60
encodeIterationCount 14848 = 61
encodeIterationCount 15360 = 62
encodeIterationCount 15872 = 63
encodeIterationCount 16384 = 64
encodeIterationCount 17408 = 65
encodeIterationCount 18432 = 66
encodeIterationCount 19456 = 67
encodeIterationCount 20480 = 68
encodeIterationCount 21504 = 69
encodeIterationCount 22528 = 70
encodeIterationCount 23552 = 71
encodeIterationCount 24576 = 72
encodeIterationCount 25600 = 73
encodeIterationCount 26624 = 74
encodeIterationCount 27648 = 75
encodeIterationCount 28672 = 76
encodeIterationCount 29696 = 77
encodeIterationCount 30720 = 78
encodeIterationCount 31744 = 79
encodeIterationCount 32768 = 80
encodeIterationCount 34816 = 81
encodeIterationCount 36864 = 82
encodeIterationCount 38912 = 83
encodeIterationCount 40960 = 84
encodeIterationCount 43008 = 85
encodeIterationCount 45056 = 86
encodeIterationCount 47104 = 87
encodeIterationCount 49152 = 88
encodeIterationCount 51200 = 89
encodeIterationCount 53248 = 90
encodeIterationCount 55296 = 91
encodeIterationCount 57344 = 92
encodeIterationCount 59392 = 93
encodeIterationCount 61440 = 94
encodeIterationCount 63488 = 95
encodeIterationCount 65536 = 96
encodeIterationCount 69632 = 97
encodeIterationCount 73728 = 98
encodeIterationCount 77824 = 99
encodeIterationCount 81920 = 100
encodeIterationCount 86016 = 101
encodeIterationCount 90112 = 102
encodeIterationCount 94208 = 103
encodeIterationCount 98304 = 104
encodeIterationCount 102400 = 105
encodeIterationCount 106496 = 106
encodeIterationCount 110592 = 107
encodeIterationCount 114688 = 108
encodeIterationCount 118784 = 109
encodeIterationCount 122880 = 110
encodeIterationCount 126976 = 111
encodeIterationCount 131072 = 112
encodeIterationCount 139264 = 113
encodeIterationCount 147456 = 114
encodeIterationCount 155648 = 115
encodeIterationCount 163840 = 116
encodeIterationCount 172032 = 117
encodeIterationCount 180224 = 118
encodeIterationCount 188416 = 119
encodeIterationCount 196608 = 120
encodeIterationCount 204800 = 121
encodeIterationCount 212992 = 122
encodeIterationCount 221184 = 123
encodeIterationCount 229376 = 124
encodeIterationCount 237568 = 125
encodeIterationCount 245760 = 126
encodeIterationCount 253952 = 127
encodeIterationCount 262144 = 128
encodeIterationCount 278528 = 129
encodeIterationCount 294912 = 130
encodeIterationCount 311296 = 131
encodeIterationCount 327680 = 132
encodeIterationCount 344064 = 133
encodeIterationCount 360448 = 134
encodeIterationCount 376832 = 135
encodeIterationCount 393216 = 136
encodeIterationCount 409600 = 137
encodeIterationCount 425984 = 138
encodeIterationCount 442368 = 139
encodeIterationCount 458752 = 140
encodeIterationCount 475136 = 141
encodeIterationCount 491520 = 142
encodeIterationCount 507904 = 143
encodeIterationCount 524288 = 144
encodeIterationCount 557056 = 145
encodeIterationCount 589824 = 146
encodeIterationCount 622592 = 147
encodeIterationCount 655360 = 148
encodeIterationCount 688128 = 149
encodeIterationCount 720896 = 150
encodeIterationCount 753664 = 151
encodeIterationCount 786432 = 152
encodeIterationCount 819200 = 153
encodeIterationCount 851968 = 154
encodeIterationCount 884736 = 155
encodeIterationCount 917504 = 156
encodeIterationCount 950272 = 157
encodeIterationCount 983040 = 158
encodeIterationCount 1015808 = 159
encodeIterationCount 1048576 = 160
encodeIterationCount 1114112 = 161
encodeIterationCount 1179648 = 162
encodeIterationCount 1245184 = 163
encodeIterationCount 1310720 = 164
encodeIterationCount 1376256 = 165
encodeIterationCount 1441792 = 166
encodeIterationCount 1507328 = 167
encodeIterationCount 1572864 = 168
encodeIterationCount 1638400 = 169
encodeIterationCount 1703936 = 170
encodeIterationCount 1769472 = 171
encodeIterationCount 1835008 = 172
encodeIterationCount 1900544 = 173
encodeIterationCount 1966080 = 174
encodeIterationCount 2031616 = 175
encodeIterationCount 2097152 = 176
encodeIterationCount 2228224 = 177
encodeIterationCount 2359296 = 178
encodeIterationCount 2490368 = 179
encodeIterationCount 2621440 = 180
encodeIterationCount 2752512 = 181
encodeIterationCount 2883584 = 182
encodeIterationCount 3014656 = 183
encodeIterationCount 3145728 = 184
encodeIterationCount 3276800 = 185
encodeIterationCount 3407872 = 186
encodeIterationCount 3538944 = 187
encodeIterationCount 3670016 = 188
encodeIterationCount 3801088 = 189
encodeIterationCount 3932160 = 190
encodeIterationCount 4063232 = 191
encodeIterationCount 4194304 = 192
encodeIterationCount 4456448 = 193
encodeIterationCount 4718592 = 194
encodeIterationCount 4980736 = 195
encodeIterationCount 5242880 = 196
encodeIterationCount 5505024 = 197
encodeIterationCount 5767168 = 198
encodeIterationCount 6029312 = 199
encodeIterationCount 6291456 = 200
encodeIterationCount 6553600 = 201
encodeIterationCount 6815744 = 202
encodeIterationCount 7077888 = 203
encodeIterationCount 7340032 = 204
encodeIterationCount 7602176 = 205
encodeIterationCount 7864320 = 206
encodeIterationCount 8126464 = 207
encodeIterationCount 8388608 = 208
encodeIterationCount 8912896 = 209
encodeIterationCount 9437184 = 210
encodeIterationCount 9961472 = 211
encodeIterationCount 10485760 = 212
encodeIterationCount 11010048 = 213
encodeIterationCount 11534336 = 214
encodeIterationCount 12058624 = 215
encodeIterationCount 12582912 = 216
encodeIterationCount 13107200 = 217
encodeIterationCount 13631488 = 218
encodeIterationCount 14155776 = 219
encodeIterationCount 14680064 = 220
encodeIterationCount 15204352 = 221
encodeIterationCount 15728640 = 222
encodeIterationCount 16252928 = 223
encodeIterationCount 16777216 = 224
encodeIterationCount 17825792 = 225
encodeIterationCount 18874368 = 226
encodeIterationCount 19922944 = 227
encodeIterationCount 20971520 = 228
encodeIterationCount 22020096 = 229
encodeIterationCount 23068672 = 230
encodeIterationCount 24117248 = 231
encodeIterationCount 25165824 = 232
encodeIterationCount 26214400 = 233
encodeIterationCount 27262976 = 234
encodeIterationCount 28311552 = 235
encodeIterationCount 29360128 = 236
encodeIterationCount 30408704 = 237
encodeIterationCount 31457280 = 238
encodeIterationCount 32505856 = 239
encodeIterationCount 33554432 = 240
encodeIterationCount 35651584 = 241
encodeIterationCount 37748736 = 242
encodeIterationCount 39845888 = 243
encodeIterationCount 41943040 = 244
encodeIterationCount 44040192 = 245
encodeIterationCount 46137344 = 246
encodeIterationCount 48234496 = 247
encodeIterationCount 50331648 = 248
encodeIterationCount 52428800 = 249
encodeIterationCount 54525952 = 250
encodeIterationCount 56623104 = 251
encodeIterationCount 58720256 = 252
encodeIterationCount 60817408 = 253
encodeIterationCount 62914560 = 254
encodeIterationCount 65011712 = 255
encodeIterationCount n = error ("invalid iteration count" ++ show n)

getSignaturePayload :: Get SignaturePayload
getSignaturePayload = do
  pv <- getWord8
  case pv of
    3 -> do
      hashlen <- getWord8
      guard (hashlen == 5)
      st <- getWord8
      ctime <- fmap ThirtyTwoBitTimeStamp getWord32be
      eok <- getLazyByteString 8
      pka <- get
      ha <- get
      left16 <- getWord16be
      mpib <- getRemainingLazyByteString
      case runGetOrFail (some getMPI) mpib of
        Left (_, _, e) -> fail ("v3 sig MPIs " ++ e)
        Right (_, _, mpis) ->
          return $
          SigV3
            (toFVal st)
            ctime
            (EightOctetKeyId eok)
            (toFVal pka)
            (toFVal ha)
            left16
            (NE.fromList mpis)
    4 -> do
      st <- getWord8
      pka <- get
      ha <- get
      hlen <- getWord16be
      hb <- getLazyByteString (fromIntegral hlen)
      let hashed =
            case runGetOrFail (many getSigSubPacket) hb of
              Left (_, _, err) -> fail ("v4 sig hasheds " ++ err)
              Right (_, _, h) -> h
      ulen <- getWord16be
      ub <- getLazyByteString (fromIntegral ulen)
      let unhashed =
            case runGetOrFail (many getSigSubPacket) ub of
              Left (_, _, err) -> fail ("v4 sig unhasheds " ++ err)
              Right (_, _, u) -> u
      left16 <- getWord16be
      mpib <- getRemainingLazyByteString
      case runGetOrFail (some getMPI) mpib of
        Left (_, _, e) -> fail ("v4 sig MPIs " ++ e)
        Right (_, _, mpis) ->
          return $
          SigV4
            (toFVal st)
            (toFVal pka)
            (toFVal ha)
            hashed
            unhashed
            left16
            (NE.fromList mpis)
    _ -> do
      bs <- getRemainingLazyByteString
      return $ SigVOther pv bs

putSignaturePayload :: SignaturePayload -> Put
putSignaturePayload (SigV3 st ctime eok pka ha left16 mpis) = do
  putWord8 3
  putWord8 5 -- hashlen
  put st
  putWord32be . unThirtyTwoBitTimeStamp $ ctime
  putLazyByteString (unEOKI eok)
  put pka
  put ha
  putWord16be left16
  F.mapM_ put mpis
putSignaturePayload (SigV4 st pka ha hashed unhashed left16 mpis) = do
  putWord8 4
  put st
  put pka
  put ha
  let hb = runPut $ mapM_ put hashed
  putWord16be . fromIntegral . BL.length $ hb
  putLazyByteString hb
  let ub = runPut $ mapM_ put unhashed
  putWord16be . fromIntegral . BL.length $ ub
  putLazyByteString ub
  putWord16be left16
  F.mapM_ put mpis
putSignaturePayload (SigVOther pv bs) = do
  putWord8 pv
  putLazyByteString bs

putTK :: TK -> Put
putTK key = do
  let pkp = key ^. tkKey . _1
  maybe
    (put (PublicKey pkp))
    (\ska -> put (SecretKey pkp ska))
    (snd (key ^. tkKey))
  mapM_ (put . Signature) (_tkRevs key)
  mapM_ putUid' (_tkUIDs key)
  mapM_ putUat' (_tkUAts key)
  mapM_ putSub' (_tkSubs key)
  where
    putUid' (u, sps) = put (UserId u) >> mapM_ (put . Signature) sps
    putUat' (us, sps) = put (UserAttribute us) >> mapM_ (put . Signature) sps
    putSub' (p, sps) = put p >> mapM_ (put . Signature) sps

-- | Parse the packets from a ByteString, with no error reporting
parsePkts :: ByteString -> [Pkt]
parsePkts lbs =
  case runGetOrFail (some getPkt) lbs of
    Left (_, _, e) -> []
    Right (_, _, p) -> p