-- Serialize.hs: OpenPGP (RFC9580) serialization (using binary)
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleInstances #-}

module Codec.Encryption.OpenPGP.Serialize
  (
  -- * Serialization functions
    putPkt
  , putPktEither
  , putSKAddendum
  , getSecretKey
  , putSKeyForPKPayload
  -- * Utilities
  , dearmorIfAsciiArmored
  , dearmorIfAsciiArmoredLenient
  , looksLikeAsciiArmor
  , armorPayloadsOfType
  , singleArmorPayloadOfType
  , singleClearSignedBlock
  , recommendedArmorType
  , WireRepInput(..)
  , wireRepRefFromInput
  , PktParseError(..)
  , parsePkts
  , parsePktsEither
  , parsePktsWithWireRep
  , conduitParsePktsWithWireRep
  ) where

import Control.Applicative (many, some)
import Control.Arrow ((***))
import Control.Lens ((^.), _1)
import Control.Monad (guard, replicateM, replicateM_, when)
import Crypto.Number.Basic (numBits)
import Crypto.Number.ModArithmetic (inverse)
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
  , bytesRead
  , getByteString
  , getLazyByteString
  , getRemainingLazyByteString
  , getWord16be
  , getWord16le
  , getWord32be
  , getWord8
  , lookAhead
  , 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.ByteString.Lazy.Char8 as BLC8
import qualified Data.Foldable as F
import Data.Int (Int64)
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
  , leftPadTo
  , pubkeyToMPIs
  )
import Codec.Encryption.OpenPGP.Policy (signatureV6SaltSizeForHashAlgorithm)
import Codec.Encryption.OpenPGP.Types
import qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA
import Codec.Encryption.OpenPGP.ASCIIArmor.Types (Armor(..), ArmorType(..))
import Data.Conduit (ConduitT, await, yield)
import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as BTypes
import qualified Codec.Encryption.OpenPGP.Types.Internal.PKITypes as P

instance Binary SigSubPacket where
  get :: Get SigSubPacket
get = Get SigSubPacket
getSigSubPacket
  put :: SigSubPacket -> Put
put = SigSubPacket -> Put
putSigSubPacket

-- instance Binary (Set NotationFlag) where
--     put = putNotationFlagSet
instance Binary CompressionAlgorithm where
  get :: Get CompressionAlgorithm
get = Word8 -> CompressionAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal (Word8 -> CompressionAlgorithm)
-> Get Word8 -> Get CompressionAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  put :: CompressionAlgorithm -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put)
-> (CompressionAlgorithm -> Word8) -> CompressionAlgorithm -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompressionAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal

instance Binary PubKeyAlgorithm where
  get :: Get PubKeyAlgorithm
get = Word8 -> PubKeyAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal (Word8 -> PubKeyAlgorithm) -> Get Word8 -> Get PubKeyAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  put :: PubKeyAlgorithm -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put)
-> (PubKeyAlgorithm -> Word8) -> PubKeyAlgorithm -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal

instance Binary HashAlgorithm where
  get :: Get HashAlgorithm
get = Word8 -> HashAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal (Word8 -> HashAlgorithm) -> Get Word8 -> Get HashAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  put :: HashAlgorithm -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (HashAlgorithm -> Word8) -> HashAlgorithm -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal

instance Binary SymmetricAlgorithm where
  get :: Get SymmetricAlgorithm
get = Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal (Word8 -> SymmetricAlgorithm)
-> Get Word8 -> Get SymmetricAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  put :: SymmetricAlgorithm -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put)
-> (SymmetricAlgorithm -> Word8) -> SymmetricAlgorithm -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal

instance Binary MPI where
  get :: Get MPI
get = Get MPI
getMPI
  put :: MPI -> Put
put = MPI -> Put
putMPI

instance Binary SigType where
  get :: Get SigType
get = Word8 -> SigType
forall a. FutureVal a => Word8 -> a
toFVal (Word8 -> SigType) -> Get Word8 -> Get SigType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  put :: SigType -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (SigType -> Word8) -> SigType -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigType -> Word8
forall a. FutureVal a => a -> Word8
fromFVal

instance Binary UserAttrSubPacket where
  get :: Get UserAttrSubPacket
get = Get UserAttrSubPacket
getUserAttrSubPacket
  put :: UserAttrSubPacket -> Put
put = UserAttrSubPacket -> Put
putUserAttrSubPacket

instance Binary S2K where
  get :: Get S2K
get = Get S2K
getS2K
  put :: S2K -> Put
put = S2K -> Put
putS2K

instance Binary (PKESK 'PKESKV3) where
  get :: Get (PKESK 'PKESKV3)
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get (PKESK 'PKESKV3)) -> Get (PKESK 'PKESKV3)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get (PKESK 'PKESKV3))
-> (PKESK 'PKESKV3 -> Get (PKESK 'PKESKV3))
-> Either String (PKESK 'PKESKV3)
-> Get (PKESK 'PKESKV3)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get (PKESK 'PKESKV3)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail PKESK 'PKESKV3 -> Get (PKESK 'PKESKV3)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (PKESK 'PKESKV3) -> Get (PKESK 'PKESKV3))
-> (Pkt -> Either String (PKESK 'PKESKV3))
-> Pkt
-> Get (PKESK 'PKESKV3)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String (PKESK 'PKESKV3)
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: PKESK 'PKESKV3 -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (PKESK 'PKESKV3 -> Pkt) -> PKESK 'PKESKV3 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKESK 'PKESKV3 -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary (PKESK 'PKESKV6) where
  get :: Get (PKESK 'PKESKV6)
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get (PKESK 'PKESKV6)) -> Get (PKESK 'PKESKV6)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get (PKESK 'PKESKV6))
-> (PKESK 'PKESKV6 -> Get (PKESK 'PKESKV6))
-> Either String (PKESK 'PKESKV6)
-> Get (PKESK 'PKESKV6)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get (PKESK 'PKESKV6)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail PKESK 'PKESKV6 -> Get (PKESK 'PKESKV6)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (PKESK 'PKESKV6) -> Get (PKESK 'PKESKV6))
-> (Pkt -> Either String (PKESK 'PKESKV6))
-> Pkt
-> Get (PKESK 'PKESKV6)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String (PKESK 'PKESKV6)
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: PKESK 'PKESKV6 -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (PKESK 'PKESKV6 -> Pkt) -> PKESK 'PKESKV6 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKESK 'PKESKV6 -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary Signature where
  get :: Get Signature
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get Signature) -> Get Signature
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get Signature)
-> (Signature -> Get Signature)
-> Either String Signature
-> Get Signature
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get Signature
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Signature -> Get Signature
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Signature -> Get Signature)
-> (Pkt -> Either String Signature) -> Pkt -> Get Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String Signature
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: Signature -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (Signature -> Pkt) -> Signature -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary (SKESK 'SKESKV4) where
  get :: Get (SKESK 'SKESKV4)
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get (SKESK 'SKESKV4)) -> Get (SKESK 'SKESKV4)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get (SKESK 'SKESKV4))
-> (SKESK 'SKESKV4 -> Get (SKESK 'SKESKV4))
-> Either String (SKESK 'SKESKV4)
-> Get (SKESK 'SKESKV4)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get (SKESK 'SKESKV4)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail SKESK 'SKESKV4 -> Get (SKESK 'SKESKV4)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (SKESK 'SKESKV4) -> Get (SKESK 'SKESKV4))
-> (Pkt -> Either String (SKESK 'SKESKV4))
-> Pkt
-> Get (SKESK 'SKESKV4)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String (SKESK 'SKESKV4)
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: SKESK 'SKESKV4 -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (SKESK 'SKESKV4 -> Pkt) -> SKESK 'SKESKV4 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SKESK 'SKESKV4 -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary (SKESK 'SKESKV6) where
  get :: Get (SKESK 'SKESKV6)
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get (SKESK 'SKESKV6)) -> Get (SKESK 'SKESKV6)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get (SKESK 'SKESKV6))
-> (SKESK 'SKESKV6 -> Get (SKESK 'SKESKV6))
-> Either String (SKESK 'SKESKV6)
-> Get (SKESK 'SKESKV6)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get (SKESK 'SKESKV6)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail SKESK 'SKESKV6 -> Get (SKESK 'SKESKV6)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (SKESK 'SKESKV6) -> Get (SKESK 'SKESKV6))
-> (Pkt -> Either String (SKESK 'SKESKV6))
-> Pkt
-> Get (SKESK 'SKESKV6)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String (SKESK 'SKESKV6)
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: SKESK 'SKESKV6 -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (SKESK 'SKESKV6 -> Pkt) -> SKESK 'SKESKV6 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SKESK 'SKESKV6 -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary (OnePassSignature 'OPSV3) where
  get :: Get (OnePassSignature 'OPSV3)
get = Get Pkt
getPkt Get Pkt
-> (Pkt -> Get (OnePassSignature 'OPSV3))
-> Get (OnePassSignature 'OPSV3)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get (OnePassSignature 'OPSV3))
-> (OnePassSignature 'OPSV3 -> Get (OnePassSignature 'OPSV3))
-> Either String (OnePassSignature 'OPSV3)
-> Get (OnePassSignature 'OPSV3)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get (OnePassSignature 'OPSV3)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail OnePassSignature 'OPSV3 -> Get (OnePassSignature 'OPSV3)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (OnePassSignature 'OPSV3)
 -> Get (OnePassSignature 'OPSV3))
-> (Pkt -> Either String (OnePassSignature 'OPSV3))
-> Pkt
-> Get (OnePassSignature 'OPSV3)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String (OnePassSignature 'OPSV3)
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: OnePassSignature 'OPSV3 -> Put
put = Pkt -> Put
putPkt (Pkt -> Put)
-> (OnePassSignature 'OPSV3 -> Pkt)
-> OnePassSignature 'OPSV3
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnePassSignature 'OPSV3 -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary (OnePassSignature 'OPSV6) where
  get :: Get (OnePassSignature 'OPSV6)
get = Get Pkt
getPkt Get Pkt
-> (Pkt -> Get (OnePassSignature 'OPSV6))
-> Get (OnePassSignature 'OPSV6)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get (OnePassSignature 'OPSV6))
-> (OnePassSignature 'OPSV6 -> Get (OnePassSignature 'OPSV6))
-> Either String (OnePassSignature 'OPSV6)
-> Get (OnePassSignature 'OPSV6)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get (OnePassSignature 'OPSV6)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail OnePassSignature 'OPSV6 -> Get (OnePassSignature 'OPSV6)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (OnePassSignature 'OPSV6)
 -> Get (OnePassSignature 'OPSV6))
-> (Pkt -> Either String (OnePassSignature 'OPSV6))
-> Pkt
-> Get (OnePassSignature 'OPSV6)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String (OnePassSignature 'OPSV6)
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: OnePassSignature 'OPSV6 -> Put
put = Pkt -> Put
putPkt (Pkt -> Put)
-> (OnePassSignature 'OPSV6 -> Pkt)
-> OnePassSignature 'OPSV6
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnePassSignature 'OPSV6 -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary SecretKey where
  get :: Get SecretKey
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get SecretKey) -> Get SecretKey
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get SecretKey)
-> (SecretKey -> Get SecretKey)
-> Either String SecretKey
-> Get SecretKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get SecretKey
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail SecretKey -> Get SecretKey
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SecretKey -> Get SecretKey)
-> (Pkt -> Either String SecretKey) -> Pkt -> Get SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String SecretKey
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: SecretKey -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (SecretKey -> Pkt) -> SecretKey -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary PublicKey where
  get :: Get PublicKey
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get PublicKey) -> Get PublicKey
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get PublicKey)
-> (PublicKey -> Get PublicKey)
-> Either String PublicKey
-> Get PublicKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get PublicKey
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail PublicKey -> Get PublicKey
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String PublicKey -> Get PublicKey)
-> (Pkt -> Either String PublicKey) -> Pkt -> Get PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String PublicKey
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: PublicKey -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (PublicKey -> Pkt) -> PublicKey -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary SecretSubkey where
  get :: Get SecretSubkey
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get SecretSubkey) -> Get SecretSubkey
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get SecretSubkey)
-> (SecretSubkey -> Get SecretSubkey)
-> Either String SecretSubkey
-> Get SecretSubkey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get SecretSubkey
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail SecretSubkey -> Get SecretSubkey
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SecretSubkey -> Get SecretSubkey)
-> (Pkt -> Either String SecretSubkey) -> Pkt -> Get SecretSubkey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String SecretSubkey
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: SecretSubkey -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (SecretSubkey -> Pkt) -> SecretSubkey -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretSubkey -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary CompressedData where
  get :: Get CompressedData
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get CompressedData) -> Get CompressedData
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get CompressedData)
-> (CompressedData -> Get CompressedData)
-> Either String CompressedData
-> Get CompressedData
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get CompressedData
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail CompressedData -> Get CompressedData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String CompressedData -> Get CompressedData)
-> (Pkt -> Either String CompressedData)
-> Pkt
-> Get CompressedData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String CompressedData
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: CompressedData -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (CompressedData -> Pkt) -> CompressedData -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompressedData -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary SymEncData where
  get :: Get SymEncData
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get SymEncData) -> Get SymEncData
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get SymEncData)
-> (SymEncData -> Get SymEncData)
-> Either String SymEncData
-> Get SymEncData
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get SymEncData
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail SymEncData -> Get SymEncData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SymEncData -> Get SymEncData)
-> (Pkt -> Either String SymEncData) -> Pkt -> Get SymEncData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String SymEncData
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: SymEncData -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (SymEncData -> Pkt) -> SymEncData -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymEncData -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary Marker where
  get :: Get Marker
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get Marker) -> Get Marker
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get Marker)
-> (Marker -> Get Marker) -> Either String Marker -> Get Marker
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get Marker
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Marker -> Get Marker
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Marker -> Get Marker)
-> (Pkt -> Either String Marker) -> Pkt -> Get Marker
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String Marker
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: Marker -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (Marker -> Pkt) -> Marker -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Marker -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary LiteralData where
  get :: Get LiteralData
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get LiteralData) -> Get LiteralData
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get LiteralData)
-> (LiteralData -> Get LiteralData)
-> Either String LiteralData
-> Get LiteralData
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get LiteralData
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail LiteralData -> Get LiteralData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String LiteralData -> Get LiteralData)
-> (Pkt -> Either String LiteralData) -> Pkt -> Get LiteralData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String LiteralData
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: LiteralData -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (LiteralData -> Pkt) -> LiteralData -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiteralData -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary Trust where
  get :: Get Trust
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get Trust) -> Get Trust
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get Trust)
-> (Trust -> Get Trust) -> Either String Trust -> Get Trust
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get Trust
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Trust -> Get Trust
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Trust -> Get Trust)
-> (Pkt -> Either String Trust) -> Pkt -> Get Trust
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String Trust
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: Trust -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (Trust -> Pkt) -> Trust -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trust -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary UserId where
  get :: Get UserId
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get UserId) -> Get UserId
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get UserId)
-> (UserId -> Get UserId) -> Either String UserId -> Get UserId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get UserId
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail UserId -> Get UserId
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String UserId -> Get UserId)
-> (Pkt -> Either String UserId) -> Pkt -> Get UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String UserId
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: UserId -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (UserId -> Pkt) -> UserId -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary PublicSubkey where
  get :: Get PublicSubkey
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get PublicSubkey) -> Get PublicSubkey
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get PublicSubkey)
-> (PublicSubkey -> Get PublicSubkey)
-> Either String PublicSubkey
-> Get PublicSubkey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get PublicSubkey
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail PublicSubkey -> Get PublicSubkey
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String PublicSubkey -> Get PublicSubkey)
-> (Pkt -> Either String PublicSubkey) -> Pkt -> Get PublicSubkey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String PublicSubkey
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: PublicSubkey -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (PublicSubkey -> Pkt) -> PublicSubkey -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicSubkey -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary UserAttribute where
  get :: Get UserAttribute
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get UserAttribute) -> Get UserAttribute
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get UserAttribute)
-> (UserAttribute -> Get UserAttribute)
-> Either String UserAttribute
-> Get UserAttribute
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get UserAttribute
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail UserAttribute -> Get UserAttribute
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String UserAttribute -> Get UserAttribute)
-> (Pkt -> Either String UserAttribute) -> Pkt -> Get UserAttribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String UserAttribute
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: UserAttribute -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (UserAttribute -> Pkt) -> UserAttribute -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserAttribute -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary SymEncIntegrityProtectedData where
  get :: Get SymEncIntegrityProtectedData
get = Get Pkt
getPkt Get Pkt
-> (Pkt -> Get SymEncIntegrityProtectedData)
-> Get SymEncIntegrityProtectedData
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get SymEncIntegrityProtectedData)
-> (SymEncIntegrityProtectedData
    -> Get SymEncIntegrityProtectedData)
-> Either String SymEncIntegrityProtectedData
-> Get SymEncIntegrityProtectedData
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get SymEncIntegrityProtectedData
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail SymEncIntegrityProtectedData -> Get SymEncIntegrityProtectedData
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SymEncIntegrityProtectedData
 -> Get SymEncIntegrityProtectedData)
-> (Pkt -> Either String SymEncIntegrityProtectedData)
-> Pkt
-> Get SymEncIntegrityProtectedData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String SymEncIntegrityProtectedData
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: SymEncIntegrityProtectedData -> Put
put = Pkt -> Put
putPkt (Pkt -> Put)
-> (SymEncIntegrityProtectedData -> Pkt)
-> SymEncIntegrityProtectedData
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymEncIntegrityProtectedData -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary ModificationDetectionCode where
  get :: Get ModificationDetectionCode
get = Get Pkt
getPkt Get Pkt
-> (Pkt -> Get ModificationDetectionCode)
-> Get ModificationDetectionCode
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get ModificationDetectionCode)
-> (ModificationDetectionCode -> Get ModificationDetectionCode)
-> Either String ModificationDetectionCode
-> Get ModificationDetectionCode
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get ModificationDetectionCode
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ModificationDetectionCode -> Get ModificationDetectionCode
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ModificationDetectionCode
 -> Get ModificationDetectionCode)
-> (Pkt -> Either String ModificationDetectionCode)
-> Pkt
-> Get ModificationDetectionCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String ModificationDetectionCode
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: ModificationDetectionCode -> Put
put = Pkt -> Put
putPkt (Pkt -> Put)
-> (ModificationDetectionCode -> Pkt)
-> ModificationDetectionCode
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModificationDetectionCode -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary OtherPacket where
  get :: Get OtherPacket
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get OtherPacket) -> Get OtherPacket
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Get OtherPacket)
-> (OtherPacket -> Get OtherPacket)
-> Either String OtherPacket
-> Get OtherPacket
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get OtherPacket
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail OtherPacket -> Get OtherPacket
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String OtherPacket -> Get OtherPacket)
-> (Pkt -> Either String OtherPacket) -> Pkt -> Get OtherPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String OtherPacket
forall a. Packet a => Pkt -> Either String a
fromPktEither
  put :: OtherPacket -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (OtherPacket -> Pkt) -> OtherPacket -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherPacket -> Pkt
forall a. Packet a => a -> Pkt
toPkt

instance Binary Pkt where
  get :: Get Pkt
get = Get Pkt
getPkt
  put :: Pkt -> Put
put = Pkt -> Put
putPkt

instance Binary a => Binary (Block a) where
  get :: Get (Block a)
get = [a] -> Block a
forall a. [a] -> Block a
Block ([a] -> Block a) -> Get [a] -> Get (Block a)
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get a -> Get [a]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get a
forall t. Binary t => Get t
get
  put :: Block a -> Put
put = (a -> Put) -> [a] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Put
forall t. Binary t => t -> Put
put ([a] -> Put) -> (Block a -> [a]) -> Block a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block a -> [a]
forall a. Block a -> [a]
unBlock

instance Binary SomePKPayload where
  get :: Get SomePKPayload
get = Get SomePKPayload
getPKPayload
  put :: SomePKPayload -> Put
put = SomePKPayload -> Put
putPKPayload

instance Binary SignaturePayload where
  get :: Get SignaturePayload
get = Get SignaturePayload
getSignaturePayload
  put :: SignaturePayload -> Put
put = SignaturePayload -> Put
putSignaturePayload

instance Binary TKUnknown where
  get :: Get TKUnknown
get = String -> Get TKUnknown
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Binary TKUnknown decode is not implemented"
  put :: TKUnknown -> Put
put = TKUnknown -> Put
putTK

getSigSubPacket :: Get SigSubPacket
getSigSubPacket :: Get SigSubPacket
getSigSubPacket = do
  l <- (Word32 -> Int64) -> Get Word32 -> Get Int64
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word32
getSubPacketLength
  (crit, pt) <- getSigSubPacketType
  getSigSubPacket' pt crit l
  where
    getSigSubPacket' :: Word8 -> Bool -> ByteOffset -> Get SigSubPacket
    getSigSubPacket' :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getSigSubPacket' Word8
pt Bool
crit Int64
l
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
2 = do
        et <- (Word32 -> ThirtyTwoBitTimeStamp)
-> Get Word32 -> Get ThirtyTwoBitTimeStamp
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> ThirtyTwoBitTimeStamp
ThirtyTwoBitTimeStamp Get Word32
getWord32be
        return $ SigSubPacket crit (SigCreationTime et)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
3 = do
        et <- (Word32 -> ThirtyTwoBitDuration)
-> Get Word32 -> Get ThirtyTwoBitDuration
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> ThirtyTwoBitDuration
ThirtyTwoBitDuration Get Word32
getWord32be
        return $ SigSubPacket crit (SigExpirationTime et)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
4 = do
        e <- Get Bool
forall t. Binary t => Get t
get
        return $ SigSubPacket crit (ExportableCertification e)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
5 = do
        tl <- Get Word8
getWord8
        ta <- getWord8
        return $ SigSubPacket crit (TrustSignature tl ta)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
6 = do
        apdre <- Int64 -> Get ByteString
getLazyByteString (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
2)
        nul <- getWord8
        guard (nul == 0)
        return $ SigSubPacket crit (RegularExpression (BL.copy apdre))
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
7 = do
        r <- Get Bool
forall t. Binary t => Get t
get
        return $ SigSubPacket crit (Revocable r)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
9 = do
        et <- (Word32 -> ThirtyTwoBitDuration)
-> Get Word32 -> Get ThirtyTwoBitDuration
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> ThirtyTwoBitDuration
ThirtyTwoBitDuration Get Word32
getWord32be
        return $ SigSubPacket crit (KeyExpirationTime et)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
11 = do
        sa <- Int -> Get SymmetricAlgorithm -> Get [SymmetricAlgorithm]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)) Get SymmetricAlgorithm
forall t. Binary t => Get t
get
        return $ SigSubPacket crit (PreferredSymmetricAlgorithms sa)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
12 = do
        rclass <- Get Word8
getWord8
        guard (testBit rclass 7)
        algid <- get
        fp <- getLazyByteString (fromIntegral l - 3)
        return $
          SigSubPacket
            crit
            (RevocationKey
               (bsToFFSet . BL.singleton $ rclass .&. 0x7f)
               algid
               (Fingerprint fp))
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
16 = do
        keyid <- Int64 -> Get ByteString
getLazyByteString (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
        return $ SigSubPacket crit (Issuer (EightOctetKeyId keyid))
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
20 = do
        flags <- Int64 -> Get ByteString
getLazyByteString Int64
4
        nl <- getWord16be
        vl <- getWord16be
        nn <- getLazyByteString (fromIntegral nl)
        nv <- getLazyByteString (fromIntegral vl)
        return $
          SigSubPacket
            crit
            (NotationData (bsToFFSet flags) (NotationName nn) (NotationValue nv))
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
21 = do
        ha <- Int -> Get HashAlgorithm -> Get [HashAlgorithm]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)) Get HashAlgorithm
forall t. Binary t => Get t
get
        return $ SigSubPacket crit (PreferredHashAlgorithms ha)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
22 = do
        ca <- Int -> Get CompressionAlgorithm -> Get [CompressionAlgorithm]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)) Get CompressionAlgorithm
forall t. Binary t => Get t
get
        return $ SigSubPacket crit (PreferredCompressionAlgorithms ca)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
23 = do
        ksps <- Int64 -> Get ByteString
getLazyByteString (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
        return $ SigSubPacket crit (KeyServerPreferences (bsToFFSet ksps))
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
24 = do
        pks <- Int64 -> Get ByteString
getLazyByteString (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
        return $ SigSubPacket crit (PreferredKeyServer pks)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
25 = do
        primacy <- Get Bool
forall t. Binary t => Get t
get
        return $ SigSubPacket crit (PrimaryUserId primacy)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
26 = do
        url <-
          (ByteString -> URL) -> Get ByteString -> Get URL
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (URI -> URL
URL (URI -> URL) -> (ByteString -> URI) -> ByteString -> URL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe URI
nullURI (Maybe URI -> URI)
-> (ByteString -> Maybe URI) -> ByteString -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
parseURI (String -> Maybe URI)
-> (ByteString -> String) -> ByteString -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode)
            (Int -> Get ByteString
getByteString (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)))
        return $ SigSubPacket crit (PolicyURL url)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
27 = do
        kfs <- Int64 -> Get ByteString
getLazyByteString (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
        return $ SigSubPacket crit (KeyFlags (bsToFFSet kfs))
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
28 = do
        uid <- Int -> Get ByteString
getByteString (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1))
        return $
          SigSubPacket crit (SignersUserId (decodeUtf8With lenientDecode uid))
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
29 = do
        rcode <- Get Word8
getWord8
        rreason <-
          fmap
            (decodeUtf8With lenientDecode)
            (getByteString (fromIntegral (l - 2)))
        return $ SigSubPacket crit (ReasonForRevocation (toFVal rcode) rreason)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
30 = do
        fbs <- Int64 -> Get ByteString
getLazyByteString (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
        return $ SigSubPacket crit (Features (bsToFFSet fbs))
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
31 = do
        pka <- Get PubKeyAlgorithm
forall t. Binary t => Get t
get
        ha <- get
        hash <- getLazyByteString (l - 3)
        return $ SigSubPacket crit (SignatureTarget pka ha hash)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
32 = do
        spbs <- Int64 -> Get ByteString
getLazyByteString (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
        case runGetOrFail get spbs of
            Left (ByteString
_, Int64
_, String
e) -> String -> Get SigSubPacket
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"embedded signature subpacket " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e)
            Right (ByteString
_, Int64
_, SignaturePayload
sp) -> SigSubPacket -> Get SigSubPacket
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SigSubPacket -> Get SigSubPacket)
-> SigSubPacket -> Get SigSubPacket
forall a b. (a -> b) -> a -> b
$ Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
crit (SignaturePayload -> SigSubPacketPayload
EmbeddedSignature SignaturePayload
sp)
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
33 = do
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
l Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
22 Bool -> Bool -> Bool
&& Int64
l Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
34) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
          String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid issuer fingerprint subpacket length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
l)
        kv <- Get Word8
getWord8
        let fpLen = Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
2
        when (fpLen /= 20 && fpLen /= 32) $
          fail ("invalid issuer fingerprint length: " ++ show fpLen)
        case BTypes.packetVersionToIssuerFingerprintVersion kv of
          Maybe IssuerFingerprintVersion
Nothing ->
            String -> Get SigSubPacket
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid issuer fingerprint version marker: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
kv)
          Just IssuerFingerprintVersion
ifVersion -> do
            fp <-
              case Word8
kv of
                Word8
4 -> Int64 -> Get ByteString
getLazyByteString (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
fpLen)
                Word8
6 -> Int64 -> Get ByteString
getLazyByteString (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
fpLen)
                Word8
_ -> String -> Get ByteString
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid issuer fingerprint version marker: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
kv)
            return $
              SigSubPacket crit (IssuerFingerprint ifVersion (Fingerprint fp))
      | Word8
pt Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
99 Bool -> Bool -> Bool
&& Word8
pt Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
111 = do
        payload <- Int64 -> Get ByteString
getLazyByteString (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
        return $ SigSubPacket crit (UserDefinedSigSub pt payload)
      | Bool
otherwise = do
        payload <- Int64 -> Get ByteString
getLazyByteString (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
        return $ SigSubPacket crit (OtherSigSub pt payload)

putSigSubPacket :: SigSubPacket -> Put
putSigSubPacket :: SigSubPacket -> Put
putSigSubPacket (SigSubPacket Bool
crit (SigCreationTime ThirtyTwoBitTimeStamp
et)) = do
  Word32 -> Put
putSubPacketLength Word32
5
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
2
  Word32 -> Put
putWord32be (Word32 -> Put)
-> (ThirtyTwoBitTimeStamp -> Word32)
-> ThirtyTwoBitTimeStamp
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp (ThirtyTwoBitTimeStamp -> Put) -> ThirtyTwoBitTimeStamp -> Put
forall a b. (a -> b) -> a -> b
$ ThirtyTwoBitTimeStamp
et
putSigSubPacket (SigSubPacket Bool
crit (SigExpirationTime ThirtyTwoBitDuration
et)) = do
  Word32 -> Put
putSubPacketLength Word32
5
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
3
  Word32 -> Put
putWord32be (Word32 -> Put)
-> (ThirtyTwoBitDuration -> Word32) -> ThirtyTwoBitDuration -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitDuration -> Word32
unThirtyTwoBitDuration (ThirtyTwoBitDuration -> Put) -> ThirtyTwoBitDuration -> Put
forall a b. (a -> b) -> a -> b
$ ThirtyTwoBitDuration
et
putSigSubPacket (SigSubPacket Bool
crit (ExportableCertification Bool
e)) = do
  Word32 -> Put
putSubPacketLength Word32
2
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
4
  Bool -> Put
forall t. Binary t => t -> Put
put Bool
e
putSigSubPacket (SigSubPacket Bool
crit (TrustSignature Word8
tl Word8
ta)) = do
  Word32 -> Put
putSubPacketLength Word32
3
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
5
  Word8 -> Put
forall t. Binary t => t -> Put
put Word8
tl
  Word8 -> Put
forall t. Binary t => t -> Put
put Word8
ta
putSigSubPacket (SigSubPacket Bool
crit (RegularExpression ByteString
apdre)) = do
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int64 -> Word32) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ (Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
apdre)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
6
  ByteString -> Put
putLazyByteString ByteString
apdre
  Word8 -> Put
putWord8 Word8
0
putSigSubPacket (SigSubPacket Bool
crit (Revocable Bool
r)) = do
  Word32 -> Put
putSubPacketLength Word32
2
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
7
  Bool -> Put
forall t. Binary t => t -> Put
put Bool
r
putSigSubPacket (SigSubPacket Bool
crit (KeyExpirationTime ThirtyTwoBitDuration
et)) = do
  Word32 -> Put
putSubPacketLength Word32
5
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
9
  Word32 -> Put
putWord32be (Word32 -> Put)
-> (ThirtyTwoBitDuration -> Word32) -> ThirtyTwoBitDuration -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitDuration -> Word32
unThirtyTwoBitDuration (ThirtyTwoBitDuration -> Put) -> ThirtyTwoBitDuration -> Put
forall a b. (a -> b) -> a -> b
$ ThirtyTwoBitDuration
et
putSigSubPacket (SigSubPacket Bool
crit (PreferredSymmetricAlgorithms [SymmetricAlgorithm]
ess)) = do
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int -> Word32) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [SymmetricAlgorithm] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SymmetricAlgorithm]
ess)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
11
  (SymmetricAlgorithm -> Put) -> [SymmetricAlgorithm] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put [SymmetricAlgorithm]
ess
putSigSubPacket (SigSubPacket Bool
crit (RevocationKey Set RevocationClass
rclass PubKeyAlgorithm
algid Fingerprint
fp)) = do
  let fpLen :: Int64
fpLen = ByteString -> Int64
BL.length (Fingerprint -> ByteString
unFingerprint Fingerprint
fp)
  Word32 -> Put
putSubPacketLength (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
3 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
fpLen))  -- type(1) + rclass(1) + algid(1) + fingerprint
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
12
  ByteString -> Put
putLazyByteString (ByteString -> Put)
-> (Set RevocationClass -> ByteString)
-> Set RevocationClass
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Set RevocationClass -> ByteString
forall a b. (Integral a, FutureFlag b) => a -> Set b -> ByteString
ffSetToFixedLengthBS (Int
1 :: Int) (Set RevocationClass -> Put) -> Set RevocationClass -> Put
forall a b. (a -> b) -> a -> b
$
    RevocationClass -> Set RevocationClass -> Set RevocationClass
forall a. Ord a => a -> Set a -> Set a
Set.insert (Word8 -> RevocationClass
RClOther Word8
0) Set RevocationClass
rclass
  PubKeyAlgorithm -> Put
forall t. Binary t => t -> Put
put PubKeyAlgorithm
algid
  ByteString -> Put
putLazyByteString (Fingerprint -> ByteString
unFingerprint Fingerprint
fp)
putSigSubPacket (SigSubPacket Bool
crit (Issuer EightOctetKeyId
keyid)) = do
  Word32 -> Put
putSubPacketLength Word32
9
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
16
  ByteString -> Put
putLazyByteString (EightOctetKeyId -> ByteString
unEOKI EightOctetKeyId
keyid) -- 8 octets
putSigSubPacket (SigSubPacket Bool
crit (NotationData Set NotationFlag
nfs (NotationName ByteString
nn) (NotationValue ByteString
nv))) = do
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int64 -> Word32) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ (Int64
9 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
nn Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
nv)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
20
  ByteString -> Put
putLazyByteString (ByteString -> Put)
-> (Set NotationFlag -> ByteString) -> Set NotationFlag -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Set NotationFlag -> ByteString
forall a b. (Integral a, FutureFlag b) => a -> Set b -> ByteString
ffSetToFixedLengthBS (Int
4 :: Int) (Set NotationFlag -> Put) -> Set NotationFlag -> Put
forall a b. (a -> b) -> a -> b
$ Set NotationFlag
nfs
  Word16 -> Put
putWord16be (Word16 -> Put) -> (ByteString -> Word16) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> (ByteString -> Int64) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
nn
  Word16 -> Put
putWord16be (Word16 -> Put) -> (ByteString -> Word16) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> (ByteString -> Int64) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
nv
  ByteString -> Put
putLazyByteString ByteString
nn
  ByteString -> Put
putLazyByteString ByteString
nv
putSigSubPacket (SigSubPacket Bool
crit (PreferredHashAlgorithms [HashAlgorithm]
ehs)) = do
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int -> Word32) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [HashAlgorithm] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HashAlgorithm]
ehs)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
21
  (HashAlgorithm -> Put) -> [HashAlgorithm] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HashAlgorithm -> Put
forall t. Binary t => t -> Put
put [HashAlgorithm]
ehs
putSigSubPacket (SigSubPacket Bool
crit (PreferredCompressionAlgorithms [CompressionAlgorithm]
ecs)) = do
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int -> Word32) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [CompressionAlgorithm] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CompressionAlgorithm]
ecs)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
22
  (CompressionAlgorithm -> Put) -> [CompressionAlgorithm] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CompressionAlgorithm -> Put
forall t. Binary t => t -> Put
put [CompressionAlgorithm]
ecs
putSigSubPacket (SigSubPacket Bool
crit (KeyServerPreferences Set KSPFlag
ksps)) = do
  let kbs :: ByteString
kbs = Set KSPFlag -> ByteString
forall a. FutureFlag a => Set a -> ByteString
ffSetToBS Set KSPFlag
ksps
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int64 -> Word32) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
kbs)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
23
  ByteString -> Put
putLazyByteString ByteString
kbs
putSigSubPacket (SigSubPacket Bool
crit (PreferredKeyServer ByteString
ks)) = do
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int64 -> Word32) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
ks)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
24
  ByteString -> Put
putLazyByteString ByteString
ks
putSigSubPacket (SigSubPacket Bool
crit (PrimaryUserId Bool
primacy)) = do
  Word32 -> Put
putSubPacketLength Word32
2
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
25
  Bool -> Put
forall t. Binary t => t -> Put
put Bool
primacy
putSigSubPacket (SigSubPacket Bool
crit (PolicyURL (URL URI
uri))) = do
  let bs :: ByteString
bs = Text -> ByteString
encodeUtf8 (String -> Text
T.pack ((String -> String) -> URI -> String -> String
uriToString String -> String
forall a. a -> a
id URI
uri String
""))
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int -> Word32) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
bs)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
26
  ByteString -> Put
putByteString ByteString
bs
putSigSubPacket (SigSubPacket Bool
crit (KeyFlags Set KeyFlag
kfs)) = do
  let kbs :: ByteString
kbs = Set KeyFlag -> ByteString
forall a. FutureFlag a => Set a -> ByteString
ffSetToBS Set KeyFlag
kfs
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int64 -> Word32) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
kbs)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
27
  ByteString -> Put
putLazyByteString ByteString
kbs
putSigSubPacket (SigSubPacket Bool
crit (SignersUserId Text
userid)) = do
  let bs :: ByteString
bs = Text -> ByteString
encodeUtf8 Text
userid
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int -> Word32) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
bs)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
28
  ByteString -> Put
putByteString ByteString
bs
putSigSubPacket (SigSubPacket Bool
crit (ReasonForRevocation RevocationCode
rcode Text
rreason)) = do
  let reasonbs :: ByteString
reasonbs = Text -> ByteString
encodeUtf8 Text
rreason
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int -> Word32) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
reasonbs)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
29
  Word8 -> Put
putWord8 (Word8 -> Put)
-> (RevocationCode -> Word8) -> RevocationCode -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RevocationCode -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (RevocationCode -> Put) -> RevocationCode -> Put
forall a b. (a -> b) -> a -> b
$ RevocationCode
rcode
  ByteString -> Put
putByteString ByteString
reasonbs
putSigSubPacket (SigSubPacket Bool
crit (Features Set FeatureFlag
fs)) = do
  let fbs :: ByteString
fbs = Set FeatureFlag -> ByteString
forall a. FutureFlag a => Set a -> ByteString
ffSetToBS Set FeatureFlag
fs
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int64 -> Word32) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
fbs)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
30
  ByteString -> Put
putLazyByteString ByteString
fbs
putSigSubPacket (SigSubPacket Bool
crit (SignatureTarget PubKeyAlgorithm
pka HashAlgorithm
ha ByteString
hash)) = do
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int64 -> Word32) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ (Int64
3 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
hash)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
31
  PubKeyAlgorithm -> Put
forall t. Binary t => t -> Put
put PubKeyAlgorithm
pka
  HashAlgorithm -> Put
forall t. Binary t => t -> Put
put HashAlgorithm
ha
  ByteString -> Put
putLazyByteString ByteString
hash
putSigSubPacket (SigSubPacket Bool
crit (EmbeddedSignature SignaturePayload
sp)) = do
  let spb :: ByteString
spb = Put -> ByteString
runPut (SignaturePayload -> Put
forall t. Binary t => t -> Put
put SignaturePayload
sp)
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int64 -> Word32) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
spb)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
32
  ByteString -> Put
putLazyByteString ByteString
spb
putSigSubPacket (SigSubPacket Bool
crit (IssuerFingerprint IssuerFingerprintVersion
kv Fingerprint
fp)) = do
  let kv' :: Word8
kv' = IssuerFingerprintVersion -> Word8
BTypes.issuerFingerprintVersionToPacketVersion IssuerFingerprintVersion
kv
  let fpb :: ByteString
fpb = Fingerprint -> ByteString
unFingerprint Fingerprint
fp
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int64
BL.length ByteString
fpb Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
20 Bool -> Bool -> Bool
&& ByteString -> Int64
BL.length ByteString
fpb Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
32) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
    String -> Put
forall a. HasCallStack => String -> a
error (String
"invalid issuer fingerprint length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show (ByteString -> Int64
BL.length ByteString
fpb))
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int64 -> Word32) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ (Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
fpb)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
33
  Word8 -> Put
putWord8 Word8
kv'
  ByteString -> Put
putLazyByteString ByteString
fpb
putSigSubPacket (SigSubPacket Bool
crit (UserDefinedSigSub Word8
ptype ByteString
payload)) =
  SigSubPacket -> Put
putSigSubPacket (Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
crit (Word8 -> ByteString -> SigSubPacketPayload
OtherSigSub Word8
ptype ByteString
payload))
putSigSubPacket (SigSubPacket Bool
crit (OtherSigSub Word8
ptype ByteString
payload)) = do
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (Int64 -> Word32) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ (Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
payload)
  Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
ptype
  ByteString -> Put
putLazyByteString ByteString
payload

getSubPacketLength :: Get Word32
getSubPacketLength :: Get Word32
getSubPacketLength = Word8 -> Get Word32
forall a. Integral a => Word8 -> Get a
getSubPacketLength' (Word8 -> Get Word32) -> Get Word8 -> Get Word32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
  where
    getSubPacketLength' :: Integral a => Word8 -> Get a
    getSubPacketLength' :: forall a. Integral a => Word8 -> Get a
getSubPacketLength' Word8
f
      | Word8
f Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
192 = a -> Get a
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> (Word8 -> a) -> Word8 -> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Get a) -> Word8 -> Get a
forall a b. (a -> b) -> a -> b
$ Word8
f
      | Word8
f Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
224 = do
        secondOctet <- Get Word8
getWord8
        return . fromIntegral $ shiftL (fromIntegral (f - 192) :: Int) 8 +
          (fromIntegral secondOctet :: Int) +
          192
      | Word8
f Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
255 = do
        len <- Get Word32
getWord32be
        return . fromIntegral $ len
      | Bool
otherwise = String -> Get a
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Partial body length invalid."

putSubPacketLength :: Word32 -> Put
putSubPacketLength :: Word32 -> Put
putSubPacketLength Word32
l
  | Word32
l Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
192 = Word8 -> Put
putWord8 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l)
  | Word32
l Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
8384 =
    Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
l Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
192) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
192 :: Int)) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Word8 -> Put
putWord8 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
l Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
192) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xff)
  | Word32
l Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0xffffffff = Word8 -> Put
putWord8 Word8
255 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32be (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l)
  | Bool
otherwise = String -> Put
forall a. HasCallStack => String -> a
error (String
"too big (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")

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

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

bsToFFSet :: FutureFlag a => ByteString -> Set a
bsToFFSet :: forall a. FutureFlag a => ByteString -> Set a
bsToFFSet ByteString
bs =
  [a] -> Set a
forall a. Eq a => [a] -> Set a
Set.fromAscList ([a] -> Set a) -> ((Int, [[a]]) -> [a]) -> (Int, [[a]]) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ((Int, [[a]]) -> [[a]]) -> (Int, [[a]]) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [[a]]) -> [[a]]
forall a b. (a, b) -> b
snd ((Int, [[a]]) -> Set a) -> (Int, [[a]]) -> Set a
forall a b. (a -> b) -> a -> b
$
  (Int -> Word8 -> (Int, [a])) -> Int -> [Word8] -> (Int, [[a]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
    (\Int
acc Word8
y -> (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8, (Int -> [a]) -> [Int] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Word8 -> Int -> [a]
forall {a} {a}.
(Bits a, Num a, FutureFlag a) =>
Int -> a -> Int -> [a]
shifty Int
acc Word8
y) [Int
0 .. Int
7]))
    Int
0
    (ByteString -> [Word8]
BL.unpack ByteString
bs)
  where
    shifty :: Int -> a -> Int -> [a]
shifty Int
acc a
y Int
x = [Int -> a
forall a. FutureFlag a => Int -> a
toFFlag (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) | a
y a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
128 Int
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
128 Int
x]

ffSetToFixedLengthBS :: (Integral a, FutureFlag b) => a -> Set b -> ByteString
ffSetToFixedLengthBS :: forall a b. (Integral a, FutureFlag b) => a -> Set b -> ByteString
ffSetToFixedLengthBS a
len Set b
ffs =
  Int64 -> ByteString -> ByteString
BL.take
    (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len)
    (ByteString -> ByteString -> ByteString
BL.append (Set b -> ByteString
forall a. FutureFlag a => Set a -> ByteString
ffSetToBS Set b
ffs) ([Word8] -> ByteString
BL.pack (Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
5 Word8
0)))

ffSetToBS :: FutureFlag a => Set a -> ByteString
ffSetToBS :: forall a. FutureFlag a => Set a -> ByteString
ffSetToBS = [Word8] -> ByteString
BL.pack ([Word8] -> ByteString)
-> (Set a -> [Word8]) -> Set a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [Word8]
forall a. FutureFlag a => Set a -> [Word8]
ffSetToBS'
  where
    ffSetToBS' :: FutureFlag a => Set a -> [Word8]
    ffSetToBS' :: forall a. FutureFlag a => Set a -> [Word8]
ffSetToBS' Set a
ks
      -- Emit a single zero octet for an empty flag set so encoded flag
      -- subpackets always carry an explicit flags byte.
      | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
ks = [Word8
0]
      | Bool
otherwise =
        (Int -> Word8) -> [Int] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map
          (((Word8 -> Word8 -> Word8) -> Word8 -> [Word8] -> Word8
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.|.) Word8
0 ([Word8] -> Word8) -> (Set a -> [Word8]) -> Set a -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Word8) -> [a] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftR Word8
128 (Int -> Word8) -> (a -> Int) -> a -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
8 (Int -> Int) -> (a -> Int) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. FutureFlag a => a -> Int
fromFFlag) ([a] -> [Word8]) -> (Set a -> [a]) -> Set a -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Set a -> [a]
forall a. Set a -> [a]
Set.toAscList) (Set a -> Word8) -> (Int -> Set a) -> Int -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (\Int
x -> (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\a
y -> a -> Int
forall a. FutureFlag a => a -> Int
fromFFlag a
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x) Set a
ks))
          [Int
0 .. a -> Int
forall a. FutureFlag a => a -> Int
fromFFlag (Set a -> a
forall a. Set a -> a
Set.findMax Set a
ks) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8]

fromS2K :: S2K -> ByteString
fromS2K :: S2K -> ByteString
fromS2K (Simple HashAlgorithm
hashalgo) = [Word8] -> ByteString
BL.pack [Word8
0, Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (HashAlgorithm -> Word8) -> HashAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (HashAlgorithm -> Word8) -> HashAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ HashAlgorithm
hashalgo]
fromS2K (Salted HashAlgorithm
hashalgo Salt8
salt) =
  [Word8] -> ByteString
BL.pack [Word8
1, Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (HashAlgorithm -> Word8) -> HashAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (HashAlgorithm -> Word8) -> HashAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ HashAlgorithm
hashalgo] ByteString -> ByteString -> ByteString
`BL.append`
  (ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Salt8 -> ByteString) -> Salt8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt8 -> ByteString
unSalt8) Salt8
salt
fromS2K (IteratedSalted HashAlgorithm
hashalgo Salt8
salt IterationCount
count) =
  [Word8] -> ByteString
BL.pack [Word8
3, Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (HashAlgorithm -> Word8) -> HashAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (HashAlgorithm -> Word8) -> HashAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ HashAlgorithm
hashalgo] ByteString -> ByteString -> ByteString
`BL.append`
  (ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Salt8 -> ByteString) -> Salt8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt8 -> ByteString
unSalt8) Salt8
salt ByteString -> Word8 -> ByteString
`BL.snoc`
  IterationCount -> Word8
encodeIterationCount IterationCount
count
fromS2K (Argon2 Salt16
salt Word8
t Word8
p Word8
encodedM) =
  [Word8] -> ByteString
BL.pack [Word8
4] ByteString -> ByteString -> ByteString
`BL.append` (ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Salt16 -> ByteString) -> Salt16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt16 -> ByteString
unSalt16) Salt16
salt ByteString -> ByteString -> ByteString
`BL.append`
  [Word8] -> ByteString
BL.pack [Word8
t, Word8
p, Word8
encodedM]
fromS2K (OtherS2K Word8
_ ByteString
bs) = ByteString
bs

getPacketLength :: Get Integer
getPacketLength :: Get Integer
getPacketLength = do
  firstOctet <- Get Word8
getWord8
  lenOrPartial <- lengthOctetToLength firstOctet
  case lenOrPartial of
    Left Integer
_ ->
      String -> Get Integer
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Partial body length is invalid in this context"
    Right Integer
len -> Integer -> Get Integer
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
len
  where
    lengthOctetToLength :: Word8 -> Get (Either Integer Integer)
    lengthOctetToLength :: Word8 -> Get (Either Integer Integer)
lengthOctetToLength Word8
f
      | Word8
f Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
192 = Either Integer Integer -> Get (Either Integer Integer)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Integer Integer -> Get (Either Integer Integer))
-> (Word8 -> Either Integer Integer)
-> Word8
-> Get (Either Integer Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Either Integer Integer
forall a b. b -> Either a b
Right (Integer -> Either Integer Integer)
-> (Word8 -> Integer) -> Word8 -> Either Integer Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Get (Either Integer Integer))
-> Word8 -> Get (Either Integer Integer)
forall a b. (a -> b) -> a -> b
$ Word8
f
      | Word8
f Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
224 = do
        secondOctet <- Get Word8
getWord8
        return . Right . fromIntegral $
          shiftL (fromIntegral (f - 192) :: Int) 8 +
          (fromIntegral secondOctet :: Int) +
          192
      | Word8
f Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
255 =
        Either Integer Integer -> Get (Either Integer Integer)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Integer Integer -> Get (Either Integer Integer))
-> (Integer -> Either Integer Integer)
-> Integer
-> Get (Either Integer Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Either Integer Integer
forall a b. a -> Either a b
Left (Integer -> Either Integer Integer)
-> (Integer -> Integer) -> Integer -> Either Integer Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Get (Either Integer Integer))
-> Integer -> Get (Either Integer Integer)
forall a b. (a -> b) -> a -> b
$ (Integer
1 :: Integer) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
f Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f)
      | Bool
otherwise = do
        len <- Get Word32
getWord32be
        return . Right . fromIntegral $ len

putPacketLength :: Integer -> Put
putPacketLength :: Integer -> Put
putPacketLength Integer
l
  | Integer
l Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
192 = Word8 -> Put
putWord8 (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
l)
  | Integer
l Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
8384 =
    Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
192) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
192 :: Int)) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Word8 -> Put
putWord8 (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
192) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xff)
  | Integer
l Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0x100000000 = Word8 -> Put
putWord8 Word8
255 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32be (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
l)
  | Bool
otherwise = String -> Put
forall a. HasCallStack => String -> a
error String
"packet length exceeds 32-bit definite length encoding"

putPartialLength :: Word8 -> Put
putPartialLength :: Word8 -> Put
putPartialLength Word8
n = Word8 -> Put
putWord8 (Word8
224 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
n)

getPacketLengthFromOctet :: Word8 -> Get (Either Int64 Int64)
getPacketLengthFromOctet :: Word8 -> Get (Either Int64 Int64)
getPacketLengthFromOctet Word8
f
  | Word8
f Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
192 = Either Int64 Int64 -> Get (Either Int64 Int64)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int64 Int64 -> Get (Either Int64 Int64))
-> (Word8 -> Either Int64 Int64)
-> Word8
-> Get (Either Int64 Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Either Int64 Int64
forall a b. b -> Either a b
Right (Int64 -> Either Int64 Int64)
-> (Word8 -> Int64) -> Word8 -> Either Int64 Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Get (Either Int64 Int64))
-> Word8 -> Get (Either Int64 Int64)
forall a b. (a -> b) -> a -> b
$ Word8
f
  | Word8
f Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
224 = do
    secondOctet <- Get Word8
getWord8
    return . Right . fromIntegral $
      shiftL (fromIntegral (f - 192) :: Int) 8 +
      (fromIntegral secondOctet :: Int) +
      192
  | Word8
f Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
255 =
    Either Int64 Int64 -> Get (Either Int64 Int64)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int64 Int64 -> Get (Either Int64 Int64))
-> (Integer -> Either Int64 Int64)
-> Integer
-> Get (Either Int64 Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Either Int64 Int64
forall a b. a -> Either a b
Left (Int64 -> Either Int64 Int64)
-> (Integer -> Int64) -> Integer -> Either Int64 Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Get (Either Int64 Int64))
-> Integer -> Get (Either Int64 Int64)
forall a b. (a -> b) -> a -> b
$ (Integer
1 :: Integer) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
f Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f)
  | Bool
otherwise = do
    len <- Get Word32
getWord32be
    return . Right . fromIntegral $ len

getS2K :: Get S2K
getS2K :: Get S2K
getS2K = Word8 -> Get S2K
getS2K' (Word8 -> Get S2K) -> Get Word8 -> Get S2K
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
  where
    getS2K' :: Word8 -> Get S2K
    getS2K' :: Word8 -> Get S2K
getS2K' Word8
t
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = do
        ha <- Get Word8
getWord8
        return $ Simple (toFVal ha)
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 = do
        ha <- Get Word8
getWord8
        salt <- getByteString 8
        return $ Salted (toFVal ha) (Salt8 salt)
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
3 = do
        ha <- Get Word8
getWord8
        salt <- getByteString 8
        count <- getWord8
        return $
          IteratedSalted (toFVal ha) (Salt8 salt) (decodeIterationCount count)
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
4 = do
        salt <- Int -> Get ByteString
getByteString Int
16
        passes <- getWord8
        parallelism <- getWord8
        encodedM <- getWord8
        return $ Argon2 (Salt16 salt) passes parallelism encodedM
      | Bool
otherwise = do
        bs <- Get ByteString
getRemainingLazyByteString
        return $ OtherS2K t bs

putS2K :: S2K -> Put
putS2K :: S2K -> Put
putS2K (Simple HashAlgorithm
hashalgo) = String -> Put
forall a. HasCallStack => String -> a
error (String
"confused by simple" String -> String -> String
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
hashalgo)
putS2K (Salted HashAlgorithm
hashalgo Salt8
salt) =
  String -> Put
forall a. HasCallStack => String -> a
error (String
"confused by salted" String -> String -> String
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
hashalgo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" by " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Salt8 -> String
forall a. Show a => a -> String
show Salt8
salt)
putS2K (IteratedSalted HashAlgorithm
ha Salt8
salt IterationCount
count) = do
  Word8 -> Put
putWord8 Word8
3
  HashAlgorithm -> Put
forall t. Binary t => t -> Put
put HashAlgorithm
ha
  ByteString -> Put
putByteString (Salt8 -> ByteString
unSalt8 Salt8
salt)
  Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ IterationCount -> Word8
encodeIterationCount IterationCount
count
putS2K (Argon2 Salt16
salt Word8
t Word8
p Word8
encodedM) = do
  Word8 -> Put
putWord8 Word8
4
  ByteString -> Put
putByteString (Salt16 -> ByteString
unSalt16 Salt16
salt)
  Word8 -> Put
putWord8 Word8
t
  Word8 -> Put
putWord8 Word8
p
  Word8 -> Put
putWord8 Word8
encodedM
putS2K (OtherS2K Word8
t ByteString
bs) = Word8 -> Put
putWord8 Word8
t Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
putLazyByteString ByteString
bs

v6SaltSizeForHashAlgorithm :: HashAlgorithm -> Maybe Word8
v6SaltSizeForHashAlgorithm :: HashAlgorithm -> Maybe Word8
v6SaltSizeForHashAlgorithm = HashAlgorithm -> Maybe Word8
signatureV6SaltSizeForHashAlgorithm

getPacketTypeAndPayload :: Get (Word8, ByteString)
getPacketTypeAndPayload :: Get (Word8, ByteString)
getPacketTypeAndPayload = do
  tag <- Get Word8
getWord8
  guard (testBit tag 7)
  case tag .&. 0x40 of
    Word8
0x00 -> do
      let t :: Word8
t = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftR (Word8
tag Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3c) Int
2
      case Word8
tag Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x03 of
        Word8
0 -> do
          len <- Get Word8
getWord8
          bs <- getLazyByteString (fromIntegral len)
          return (t, bs)
        Word8
1 -> do
          len <- Get Word16
getWord16be
          bs <- getLazyByteString (fromIntegral len)
          return (t, bs)
        Word8
2 -> do
          len <- Get Word32
getWord32be
          bs <- getLazyByteString (fromIntegral len)
          return (t, bs)
        Word8
3 -> do
          bs <- Get ByteString
getRemainingLazyByteString
          return (t, bs)
        Word8
_ -> String -> Get (Word8, ByteString)
forall a. HasCallStack => String -> a
error String
"This should never happen (getPacketTypeAndPayload/0x00)."
    Word8
0x40 -> do
      firstLenOctet <- Get Word8
getWord8
      bs <- getPacketPayloadFromLengthOctet firstLenOctet
      return (tag .&. 0x3f, bs)
    Word8
_ -> String -> Get (Word8, ByteString)
forall a. HasCallStack => String -> a
error String
"This should never happen (getPacketTypeAndPayload/???)."
  where
    getPacketPayloadFromLengthOctet :: Word8 -> Get ByteString
    getPacketPayloadFromLengthOctet :: Word8 -> Get ByteString
getPacketPayloadFromLengthOctet Word8
lenOctet = do
      lenOrPartial <- Word8 -> Get (Either Int64 Int64)
getPacketLengthFromOctet Word8
lenOctet
      case lenOrPartial of
        Right Int64
len -> Int64 -> Get ByteString
getLazyByteString Int64
len
        Left Int64
partialLen -> do
          chunk <- Int64 -> Get ByteString
getLazyByteString Int64
partialLen
          rest <- getRemainingPartialPayload
          return (chunk <> rest)
    getRemainingPartialPayload :: Get ByteString
    getRemainingPartialPayload :: Get ByteString
getRemainingPartialPayload = do
      lenOctet <- Get Word8
getWord8
      lenOrPartial <- getPacketLengthFromOctet lenOctet
      case lenOrPartial of
        Right Int64
len -> Int64 -> Get ByteString
getLazyByteString Int64
len
        Left Int64
partialLen -> do
          chunk <- Int64 -> Get ByteString
getLazyByteString Int64
partialLen
          (chunk <>) <$> getRemainingPartialPayload

getPkt :: Get Pkt
getPkt :: Get Pkt
getPkt = do
  (t, pl) <- Get (Word8, ByteString)
getPacketTypeAndPayload
  case runGetOrFail (getPkt' t (BL.length pl)) pl of
    Left (ByteString
_, Int64
_, String
e) -> Pkt -> Get Pkt
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pkt -> Get Pkt) -> Pkt -> Get Pkt
forall a b. (a -> b) -> a -> b
$! String -> Word8 -> ByteString -> Pkt
BrokenPacketPkt String
e Word8
t ByteString
pl
    Right (ByteString
_, Int64
_, Pkt
p) -> Pkt -> Get Pkt
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Pkt
p
  where
    parseLegacyPKESK :: PacketVersion -> BL.ByteString -> Either String Pkt
    parseLegacyPKESK :: Word8 -> ByteString -> Either String Pkt
parseLegacyPKESK Word8
pv ByteString
body = do
      (_, _, (eokeyid, pkaRaw, mpib)) <-
        ((ByteString, Int64, String) -> String)
-> ((ByteString, Int64, (ByteString, Word8, ByteString))
    -> (ByteString, Int64, (ByteString, Word8, ByteString)))
-> Either
     (ByteString, Int64, String)
     (ByteString, Int64, (ByteString, Word8, ByteString))
-> Either
     String (ByteString, Int64, (ByteString, Word8, ByteString))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (\(ByteString
_, Int64
_, String
e) -> String
e) (ByteString, Int64, (ByteString, Word8, ByteString))
-> (ByteString, Int64, (ByteString, Word8, ByteString))
forall a. a -> a
id (Either
   (ByteString, Int64, String)
   (ByteString, Int64, (ByteString, Word8, ByteString))
 -> Either
      String (ByteString, Int64, (ByteString, Word8, ByteString)))
-> Either
     (ByteString, Int64, String)
     (ByteString, Int64, (ByteString, Word8, ByteString))
-> Either
     String (ByteString, Int64, (ByteString, Word8, ByteString))
forall a b. (a -> b) -> a -> b
$
        Get (ByteString, Word8, ByteString)
-> ByteString
-> Either
     (ByteString, Int64, String)
     (ByteString, Int64, (ByteString, Word8, ByteString))
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail
          (do eokeyid <- Int64 -> Get ByteString
getLazyByteString Int64
8
              pka <- getWord8
              mpib <- getRemainingLazyByteString
              pure (eokeyid, pka, mpib))
          ByteString
body
      let pka = Word8 -> PubKeyAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
pkaRaw
      sk <- parseLegacyPKESKMPIs pka mpib
      pure $
        PKESKPkt
          (PKESKPayloadV3Packet (PKESKPayloadV3 pv (EightOctetKeyId eokeyid) pka sk))

    parseLegacyPKESKMPIs :: PubKeyAlgorithm -> BL.ByteString -> Either String (NE.NonEmpty MPI)
    parseLegacyPKESKMPIs :: PubKeyAlgorithm -> ByteString -> Either String (NonEmpty MPI)
parseLegacyPKESKMPIs PubKeyAlgorithm
pka ByteString
mpib = do
      case PubKeyAlgorithm -> ByteString -> Either String (NonEmpty MPI)
parseLegacyPKESKMPIsStrict PubKeyAlgorithm
pka ByteString
mpib of
        Right NonEmpty MPI
sk -> NonEmpty MPI -> Either String (NonEmpty MPI)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty MPI
sk
        Left String
strictErr
          | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
X25519 ->
              case ByteString -> Either String (NonEmpty MPI)
parseLegacyPKESKX25519V3Octets ByteString
mpib of
                Right NonEmpty MPI
sk -> NonEmpty MPI -> Either String (NonEmpty MPI)
forall a b. b -> Either a b
Right NonEmpty MPI
sk
                Left String
octetErr ->
                  String -> Either String (NonEmpty MPI)
forall a b. a -> Either a b
Left
                    (String
strictErr String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     String
"; also failed to parse RFC9580 X25519 v3 octet layout: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     String
octetErr)
          | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
ECDH ->
              case ByteString -> Either String (NonEmpty MPI)
parseLegacyPKESKECDHOctets ByteString
mpib of
                Right NonEmpty MPI
sk -> NonEmpty MPI -> Either String (NonEmpty MPI)
forall a b. b -> Either a b
Right NonEmpty MPI
sk
                Left String
octetErr ->
                  String -> Either String (NonEmpty MPI)
forall a b. a -> Either a b
Left
                    (String
strictErr String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     String
"; also failed to parse RFC6637 ECDH v3 octet layout: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     String
octetErr)
          | Bool
otherwise -> String -> Either String (NonEmpty MPI)
forall a b. a -> Either a b
Left String
strictErr

    parseLegacyPKESKMPIsStrict ::
         PubKeyAlgorithm -> BL.ByteString -> Either String (NE.NonEmpty MPI)
    parseLegacyPKESKMPIsStrict :: PubKeyAlgorithm -> ByteString -> Either String (NonEmpty MPI)
parseLegacyPKESKMPIsStrict PubKeyAlgorithm
pka ByteString
mpib = do
      (rest, _, sk) <-
        ((ByteString, Int64, String) -> String)
-> ((ByteString, Int64, [MPI]) -> (ByteString, Int64, [MPI]))
-> Either (ByteString, Int64, String) (ByteString, Int64, [MPI])
-> Either String (ByteString, Int64, [MPI])
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (\(ByteString
_, Int64
_, String
e) -> String
e) (ByteString, Int64, [MPI]) -> (ByteString, Int64, [MPI])
forall a. a -> a
id (Either (ByteString, Int64, String) (ByteString, Int64, [MPI])
 -> Either String (ByteString, Int64, [MPI]))
-> Either (ByteString, Int64, String) (ByteString, Int64, [MPI])
-> Either String (ByteString, Int64, [MPI])
forall a b. (a -> b) -> a -> b
$
        Get [MPI]
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, [MPI])
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (PubKeyAlgorithm -> Get [MPI]
parserForLegacyPKESKMPIs PubKeyAlgorithm
pka) ByteString
mpib
      if BL.null rest
        then pure (NE.fromList sk)
        else
          Left
            ("unexpected trailing PKESK MPI data for algorithm " ++ show pka)

    parseLegacyPKESKX25519V3Octets :: BL.ByteString -> Either String (NE.NonEmpty MPI)
    parseLegacyPKESKX25519V3Octets :: ByteString -> Either String (NonEmpty MPI)
parseLegacyPKESKX25519V3Octets ByteString
mpib = do
      if ByteString -> Int64
BL.length ByteString
mpib Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
33
        then String -> Either String ()
forall a b. a -> Either a b
Left String
"X25519 v3 PKESK octet layout is too short"
        else () -> Either String ()
forall a b. b -> Either a b
Right ()
      let ephemeral :: ByteString
ephemeral = ByteString -> ByteString
BL.toStrict (Int64 -> ByteString -> ByteString
BL.take Int64
32 ByteString
mpib)
          eskLen :: Int
eskLen = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
BL.index ByteString
mpib Int64
32) :: Int
          eskWithAlgo :: ByteString
eskWithAlgo = ByteString -> ByteString
BL.toStrict (Int64 -> ByteString -> ByteString
BL.drop Int64
33 ByteString
mpib)
      if Int
eskLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Int
B.length ByteString
eskWithAlgo
        then String -> Either String ()
forall a b. a -> Either a b
Left String
"X25519 v3 PKESK octet layout has inconsistent ESK length"
        else () -> Either String ()
forall a b. b -> Either a b
Right ()
      if ByteString -> Bool
B.null ByteString
eskWithAlgo
        then String -> Either String ()
forall a b. a -> Either a b
Left String
"X25519 v3 PKESK octet layout must include a symmetric algorithm octet"
        else () -> Either String ()
forall a b. b -> Either a b
Right ()
      let symAlgo :: Word8
symAlgo = HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
eskWithAlgo
      if Word8
symAlgo Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal SymmetricAlgorithm
AES128), Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal SymmetricAlgorithm
AES192), Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal SymmetricAlgorithm
AES256)]
        then NonEmpty MPI -> Either String (NonEmpty MPI)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
ephemeral), Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
eskWithAlgo)])
        else
          String -> Either String (NonEmpty MPI)
forall a b. a -> Either a b
Left
            (String
"X25519 v3 PKESK octet layout has unsupported symmetric algorithm octet " String -> String -> String
forall a. [a] -> [a] -> [a]
++
             Word8 -> String
forall a. Show a => a -> String
show Word8
symAlgo)

    -- | Parse an RFC 6637 §8 ECDH PKESKv3 body as MPI(ephemeral) || 1-octet-count || C.
    -- This is the interoperable wire format produced by GnuPG and other RFC-compliant
    -- implementations. hOpenPGP previously wrote both fields as MPIs; this fallback
    -- allows reading RFC-compliant packets when the strict two-MPI path fails.
    parseLegacyPKESKECDHOctets :: BL.ByteString -> Either String (NE.NonEmpty MPI)
    parseLegacyPKESKECDHOctets :: ByteString -> Either String (NonEmpty MPI)
parseLegacyPKESKECDHOctets ByteString
mpib = do
      (rest, _, ephMPI) <-
        ((ByteString, Int64, String) -> String)
-> ((ByteString, Int64, MPI) -> (ByteString, Int64, MPI))
-> Either (ByteString, Int64, String) (ByteString, Int64, MPI)
-> Either String (ByteString, Int64, MPI)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (\(ByteString
_, Int64
_, String
e) -> String
e) (ByteString, Int64, MPI) -> (ByteString, Int64, MPI)
forall a. a -> a
id (Either (ByteString, Int64, String) (ByteString, Int64, MPI)
 -> Either String (ByteString, Int64, MPI))
-> Either (ByteString, Int64, String) (ByteString, Int64, MPI)
-> Either String (ByteString, Int64, MPI)
forall a b. (a -> b) -> a -> b
$ Get MPI
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, MPI)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get MPI
getMPI ByteString
mpib
      let restBS = ByteString -> ByteString
BL.toStrict ByteString
rest
      when (B.null restBS) $
        Left "ECDH v3 PKESK RFC6637 octet layout: missing wrapped-key length octet after ephemeral MPI"
      let wrappedLen = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
restBS) :: Int
          wrapped = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
restBS
      when (wrappedLen /= B.length wrapped) $
        Left
          ("ECDH v3 PKESK RFC6637 octet layout: wrapped key length field " ++
           show wrappedLen ++ " does not match body length " ++ show (B.length wrapped))
      when (wrappedLen < 24 || wrappedLen `mod` 8 /= 0) $
        Left
          ("ECDH v3 PKESK RFC6637 octet layout: wrapped key length " ++
           show wrappedLen ++ " is not a valid RFC 3394 wrapped key size")
      pure (ephMPI NE.:| [MPI (os2ip wrapped)])

    parserForLegacyPKESKMPIs :: PubKeyAlgorithm -> Get [MPI]
    parserForLegacyPKESKMPIs :: PubKeyAlgorithm -> Get [MPI]
parserForLegacyPKESKMPIs PubKeyAlgorithm
pka =
      case PubKeyAlgorithm -> Maybe Int
expectedLegacyPKESKMPIArity PubKeyAlgorithm
pka of
        Just Int
mpiCount -> Int -> Get MPI -> Get [MPI]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
mpiCount Get MPI
getMPI
        Maybe Int
Nothing -> Get MPI -> Get [MPI]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Get MPI
getMPI

    expectedLegacyPKESKMPIArity :: PubKeyAlgorithm -> Maybe Int
    expectedLegacyPKESKMPIArity :: PubKeyAlgorithm -> Maybe Int
expectedLegacyPKESKMPIArity PubKeyAlgorithm
pka
      | PubKeyAlgorithm
pka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
RSA, PubKeyAlgorithm
DeprecatedRSAEncryptOnly] = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
      | PubKeyAlgorithm
pka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
ElgamalEncryptOnly, PubKeyAlgorithm
ForbiddenElgamal, PubKeyAlgorithm
ECDH, PubKeyAlgorithm
X25519] = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2
      | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing

    validateV4SKESKEncryptedSessionKeyS2K :: S2K -> Maybe BL.ByteString -> Get ()
    validateV4SKESKEncryptedSessionKeyS2K :: S2K -> Maybe ByteString -> Get ()
validateV4SKESKEncryptedSessionKeyS2K S2K
_ Maybe ByteString
Nothing = () -> Get ()
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    validateV4SKESKEncryptedSessionKeyS2K Simple {} (Just ByteString
_) =
      String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
        String
"v4 SKESK packets with encrypted session keys must not use Simple S2K"
    validateV4SKESKEncryptedSessionKeyS2K S2K
_ (Just ByteString
_) = () -> Get ()
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    parseV6PKESK :: BL.ByteString -> Either String Pkt
    parseV6PKESK :: ByteString -> Either String Pkt
parseV6PKESK ByteString
body = do
      (_, _, (recipientKeyIdentifier, pka, esk)) <-
        ((ByteString, Int64, String) -> String)
-> ((ByteString, Int64, (ByteString, Word8, ByteString))
    -> (ByteString, Int64, (ByteString, Word8, ByteString)))
-> Either
     (ByteString, Int64, String)
     (ByteString, Int64, (ByteString, Word8, ByteString))
-> Either
     String (ByteString, Int64, (ByteString, Word8, ByteString))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (\(ByteString
_, Int64
_, String
e) -> String
e) (ByteString, Int64, (ByteString, Word8, ByteString))
-> (ByteString, Int64, (ByteString, Word8, ByteString))
forall a. a -> a
id (Either
   (ByteString, Int64, String)
   (ByteString, Int64, (ByteString, Word8, ByteString))
 -> Either
      String (ByteString, Int64, (ByteString, Word8, ByteString)))
-> Either
     (ByteString, Int64, String)
     (ByteString, Int64, (ByteString, Word8, ByteString))
-> Either
     String (ByteString, Int64, (ByteString, Word8, ByteString))
forall a b. (a -> b) -> a -> b
$
        Get (ByteString, Word8, ByteString)
-> ByteString
-> Either
     (ByteString, Int64, String)
     (ByteString, Int64, (ByteString, Word8, ByteString))
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail
          (do keyIdentifierLen <- Get Word8
getWord8
              recipientKeyIdentifier <- getLazyByteString (fromIntegral keyIdentifierLen)
              pka <- getWord8
              esk <- getRemainingLazyByteString
              pure (recipientKeyIdentifier, pka, esk))
          ByteString
body
      validateV6PKESKRecipientIdentifier recipientKeyIdentifier
      pure $
        PKESKPkt
          (PKESKPayloadV6Packet (PKESKPayloadV6 recipientKeyIdentifier (toFVal pka) esk))
      where
        validateV6PKESKRecipientIdentifier :: BL.ByteString -> Either String ()
        validateV6PKESKRecipientIdentifier :: ByteString -> Either String ()
validateV6PKESKRecipientIdentifier ByteString
rid =
          case ByteString -> Int64
BL.length ByteString
rid of
            Int64
0 -> () -> Either String ()
forall a b. b -> Either a b
Right ()
            Int64
20 -> () -> Either String ()
forall a b. b -> Either a b
Right ()
            Int64
32 -> () -> Either String ()
forall a b. b -> Either a b
Right ()
            Int64
21 -> ByteString -> Either String ()
validateVersionedFingerprint ByteString
rid
            Int64
33 -> ByteString -> Either String ()
validateVersionedFingerprint ByteString
rid
            Int64
ridLen ->
              String -> Either String ()
forall a b. a -> Either a b
Left
                (String
"invalid PKESK v6 recipient identifier length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 Int64 -> String
forall a. Show a => a -> String
show Int64
ridLen String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 String
" (expected 0, 20, 21, 32, or 33)")

        validateVersionedFingerprint :: BL.ByteString -> Either String ()
        validateVersionedFingerprint :: ByteString -> Either String ()
validateVersionedFingerprint ByteString
rid =
          let keyVersion :: Word8
keyVersion = HasCallStack => ByteString -> Word8
ByteString -> Word8
BL.head ByteString
rid
              fingerprintLen :: Int64
fingerprintLen = ByteString -> Int64
BL.length (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BL.tail ByteString
rid)
           in case Word8
keyVersion of
                Word8
4 ->
                  if Int64
fingerprintLen Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
20
                    then () -> Either String ()
forall a b. b -> Either a b
Right ()
                    else
                      String -> Either String ()
forall a b. a -> Either a b
Left
                        (String
"PKESK v6 recipient identifier length/version mismatch: key version 4 requires fingerprint length 20, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         Int64 -> String
forall a. Show a => a -> String
show Int64
fingerprintLen)
                Word8
6 ->
                  if Int64
fingerprintLen Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
32
                    then () -> Either String ()
forall a b. b -> Either a b
Right ()
                    else
                      String -> Either String ()
forall a b. a -> Either a b
Left
                        (String
"PKESK v6 recipient identifier length/version mismatch: key version 6 requires fingerprint length 32, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         Int64 -> String
forall a. Show a => a -> String
show Int64
fingerprintLen)
                Word8
_ ->
                  String -> Either String ()
forall a b. a -> Either a b
Left
                    (String
"invalid PKESK v6 recipient key version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     Word8 -> String
forall a. Show a => a -> String
show Word8
keyVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (expected 4 or 6)")

    getPkt' :: Word8 -> ByteOffset -> Get Pkt
    getPkt' :: Word8 -> Int64 -> Get Pkt
getPkt' Word8
t Int64
len
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 = do
        pv <- Get Word8
getWord8
        body <- getRemainingLazyByteString
        if pv == 6
          then case parseV6PKESK body of
                 Right Pkt
pkt -> Pkt -> Get Pkt
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Pkt
pkt
                 Left String
v6Err -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"PKESK v6 parse failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v6Err)
          else case parseLegacyPKESK pv body of
                 Right Pkt
pkt -> Pkt -> Get Pkt
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Pkt
pkt
                 Left String
legacyErr -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"PKESK MPIs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
legacyErr)
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
2 = do
        bs <- Get ByteString
getRemainingLazyByteString
        case runGetOrFail get bs of
          Left (ByteString
_, Int64
_, String
e) -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"signature packet " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e)
          Right (ByteString
_, Int64
_, SignaturePayload
sp) -> Pkt -> Get Pkt
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pkt -> Get Pkt) -> Pkt -> Get Pkt
forall a b. (a -> b) -> a -> b
$ SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
3 = do
        pv <- Get Word8
getWord8
        let getV6SKESKParams = do
              symalgoWord <- Get Word8
getWord8
              aeadWord <- getWord8
              s2kLen <- getWord8
              s2kBytes <- getLazyByteString (fromIntegral s2kLen)
              s2k <-
                case runGetOrFail getS2K s2kBytes of
                  Left (ByteString
_, Int64
_, String
err) -> String -> Get S2K
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
                  Right (ByteString
rest, Int64
_, S2K
parsed)
                    | Bool -> Bool
not (ByteString -> Bool
BL.null ByteString
rest) -> String -> Get S2K
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected trailing bytes in v6 SKESK S2K specifier"
                    | Bool
otherwise -> S2K -> Get S2K
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure S2K
parsed
              let symalgo = Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
symalgoWord
                  aead = Word8 -> AEADAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
aeadWord
                  ivLen = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (AEADAlgorithm -> Int
aeadNonceSize AEADAlgorithm
aead)
              iv <- getLazyByteString ivLen
              pure (symalgo, aead, s2k, iv)
        case pv of
          Word8
6 -> do
            paramsLen <- Get Word8
getWord8
            params <- getLazyByteString (fromIntegral paramsLen)
            (symalgo, aead, s2k, iv) <-
              case runGetOrFail getV6SKESKParams params of
                Left (ByteString
_, Int64
_, String
err) -> String -> Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
                Right (ByteString
rest, Int64
_, (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
parsed)
                  | Bool -> Bool
not (ByteString -> Bool
BL.null ByteString
rest) -> String -> Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected trailing v6 SKESK parameters"
                  | Bool
otherwise -> (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
-> Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
parsed
            payload <- getRemainingLazyByteString
            when (BL.length payload < 16) $
              fail "v6 SKESK payload must include encrypted session key and authentication tag"
            let (esk, tag) = BL.splitAt (BL.length payload - 16) payload
            return $
              SKESKPkt
                (SKESKPayloadV6Packet
                  (SKESKPayloadV6
                  symalgo
                  aead
                  s2k
                  iv
                  esk
                  tag))
          Word8
4 -> do
            symalgo <- Get Word8
getWord8
            s2k <- getS2K
            esk <- getRemainingLazyByteString
            let mesk = if ByteString -> Bool
BL.null ByteString
esk then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
esk
            validateV4SKESKEncryptedSessionKeyS2K s2k mesk
            return $
              SKESKPkt
                (SKESKPayloadV4Packet
                  (SKESKPayloadV4
                  (toFVal symalgo)
                  s2k
                  mesk))
          Word8
_ -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unsupported SKESK packet version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
pv)
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
4 = do
        pv <- Get Word8
getWord8
        sigtype <- toFVal <$> getWord8
        ha <- toFVal <$> getWord8
        pka <- toFVal <$> getWord8
        case pv of
          Word8
3 -> do
            skeyid <- Int64 -> Get ByteString
getLazyByteString Int64
8
            nested <- getWord8 >>= parseOPSNestedFlag
            return $
              OnePassSignaturePkt
                (OPSPayloadV3Packet
                  (OPSPayloadV3
                  pv
                  sigtype
                  ha
                  pka
                  (EightOctetKeyId skeyid)
                  nested))
          Word8
6 -> do
            saltSize <- Get Word8
getWord8
            expectedSaltSize <-
              maybe
                (fail ("signature hash algorithm does not define a V6 salt size: " ++ show ha))
                pure
                (v6SaltSizeForHashAlgorithm ha)
            when (saltSize /= expectedSaltSize) $
              fail
                ("OPS v6 salt size mismatch for " ++
                 show ha ++ ": expected " ++ show expectedSaltSize ++ ", got " ++ show saltSize)
            salt <- SignatureSalt <$> getLazyByteString (fromIntegral saltSize)
            signerFingerprint <- getLazyByteString 32
            nested <- getWord8 >>= parseOPSNestedFlag
            return $
              OnePassSignaturePkt
                (OPSPayloadV6Packet
                  (OPSPayloadV6
                  sigtype
                  ha
                  pka
                  salt
                  signerFingerprint
                  nested))
          Word8
_ -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unsupported OPS version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
pv)
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
5 = do
        bs <- Int64 -> Get ByteString
getLazyByteString Int64
len
        let ps =
              (Get Pkt
 -> ByteString
 -> Either (ByteString, Int64, String) (ByteString, Int64, Pkt))
-> ByteString
-> Get Pkt
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Pkt
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail ByteString
bs (Get Pkt
 -> Either (ByteString, Int64, String) (ByteString, Int64, Pkt))
-> Get Pkt
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a b. (a -> b) -> a -> b
$ do
                pkp <- Get SomePKPayload
getPKPayload
                ska <- getSKAddendum pkp
                return $ SecretKeyPkt pkp ska
        case ps of
          Left (ByteString
_, Int64
_, String
err) -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"secret key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
          Right (ByteString
_, Int64
_, Pkt
pkt) -> Pkt -> Get Pkt
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Pkt
pkt
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
6 = do
        pkp <- Get SomePKPayload
getPKPayload
        return $ PublicKeyPkt pkp
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
7 = do
        bs <- Int64 -> Get ByteString
getLazyByteString Int64
len
        let ps =
              (Get Pkt
 -> ByteString
 -> Either (ByteString, Int64, String) (ByteString, Int64, Pkt))
-> ByteString
-> Get Pkt
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Pkt
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail ByteString
bs (Get Pkt
 -> Either (ByteString, Int64, String) (ByteString, Int64, Pkt))
-> Get Pkt
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a b. (a -> b) -> a -> b
$ do
                pkp <- Get SomePKPayload
getPKPayload
                ska <- getSKAddendum pkp
                return $ SecretSubkeyPkt pkp ska
        case ps of
          Left (ByteString
_, Int64
_, String
err) -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"secret subkey " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
          Right (ByteString
_, Int64
_, Pkt
pkt) -> Pkt -> Get Pkt
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Pkt
pkt
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
8 = do
        ca <- Get Word8
getWord8
        cdata <- getLazyByteString (len - 1)
        return $ CompressedDataPkt (toFVal ca) cdata
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
9 = do
        sdata <- Int64 -> Get ByteString
getLazyByteString Int64
len
        return $ SymEncDataPkt sdata
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10 = do
        marker <- Int64 -> Get ByteString
getLazyByteString Int64
len
        return $ MarkerPkt marker
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
11 = do
        dt <- Get Word8
getWord8
        flen <- getWord8
        fn <- getLazyByteString (fromIntegral flen)
        ts <- fmap ThirtyTwoBitTimeStamp getWord32be
        ldata <- getLazyByteString (len - (6 + fromIntegral flen))
        return $ LiteralDataPkt (toFVal dt) fn ts ldata
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
12 = do
        tdata <- Int64 -> Get ByteString
getLazyByteString Int64
len
        return $ TrustPkt tdata
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13 = do
        udata <- Int -> Get ByteString
getByteString (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len)
        return . UserIdPkt . decodeUtf8With lenientDecode $ udata
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
14 = do
        bs <- Int64 -> Get ByteString
getLazyByteString Int64
len
        let ps =
              (Get Pkt
 -> ByteString
 -> Either (ByteString, Int64, String) (ByteString, Int64, Pkt))
-> ByteString
-> Get Pkt
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Pkt
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail ByteString
bs (Get Pkt
 -> Either (ByteString, Int64, String) (ByteString, Int64, Pkt))
-> Get Pkt
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a b. (a -> b) -> a -> b
$ do
                pkp <- Get SomePKPayload
getPKPayload
                return $ PublicSubkeyPkt pkp
        case ps of
          Left (ByteString
_, Int64
_, String
err) -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"public subkey " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
          Right (ByteString
_, Int64
_, Pkt
pkt) -> Pkt -> Get Pkt
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Pkt
pkt
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
17 = do
        bs <- Int64 -> Get ByteString
getLazyByteString Int64
len
        case runGetOrFail (many getUserAttrSubPacket) bs of
          Left (ByteString
_, Int64
_, String
err) -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"user attribute " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
          Right (ByteString
_, Int64
_, [UserAttrSubPacket]
uas) -> Pkt -> Get Pkt
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pkt -> Get Pkt) -> Pkt -> Get Pkt
forall a b. (a -> b) -> a -> b
$ [UserAttrSubPacket] -> Pkt
UserAttributePkt [UserAttrSubPacket]
uas
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
18 = do
        pv <- Get Word8
getWord8
        case pv of
          Word8
1 -> do
            b <- Int64 -> Get ByteString
getLazyByteString (Int64
len Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
            return $ SymEncIntegrityProtectedDataPkt (SEIPD1 pv b)
          Word8
2 -> do
            Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
len Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
36) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
              String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SEIPD v2 packet too short"
            symalgo <- Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal (Word8 -> SymmetricAlgorithm)
-> Get Word8 -> Get SymmetricAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
            aeadalgo <- toFVal <$> getWord8
            chunkSize <- getWord8
            salt <- Salt <$> getByteString 32
            encrypted <- getLazyByteString (len - 36)
            validateSEIPDv2Header symalgo aeadalgo chunkSize encrypted
            return $
              SymEncIntegrityProtectedDataPkt
                (SEIPD2
                  symalgo
                  aeadalgo
                  chunkSize
                  salt
                  encrypted)
          Word8
_ -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unsupported SEIPD version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
pv)
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
19 = do
        hash <- Int64 -> Get ByteString
getLazyByteString Int64
20
        return $ ModificationDetectionCodePkt hash
      | Bool
otherwise = do
        payload <- Int64 -> Get ByteString
getLazyByteString Int64
len
        return $ OtherPacketPkt t payload

getUserAttrSubPacket :: Get UserAttrSubPacket
getUserAttrSubPacket :: Get UserAttrSubPacket
getUserAttrSubPacket = do
  l <- (Word32 -> Int64) -> Get Word32 -> Get Int64
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word32
getSubPacketLength
  t <- getWord8
  getUserAttrSubPacket' t l
  where
    getUserAttrSubPacket' :: Word8 -> ByteOffset -> Get UserAttrSubPacket
    getUserAttrSubPacket' :: Word8 -> Int64 -> Get UserAttrSubPacket
getUserAttrSubPacket' Word8
t Int64
l
      | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 = do
        _ <- Get Word16
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
      | Bool
otherwise = do
        bs <- Int64 -> Get ByteString
getLazyByteString (Int64
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
        return $ OtherUASub t bs

putUserAttrSubPacket :: UserAttrSubPacket -> Put
putUserAttrSubPacket :: UserAttrSubPacket -> Put
putUserAttrSubPacket UserAttrSubPacket
ua = do
  let sp :: ByteString
sp = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ UserAttrSubPacket -> Put
putUserAttrSubPacket' UserAttrSubPacket
ua
  Word32 -> Put
putSubPacketLength (Word32 -> Put) -> (ByteString -> Word32) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> (ByteString -> Int64) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
sp
  ByteString -> Put
putLazyByteString ByteString
sp
  where
    putUserAttrSubPacket' :: UserAttrSubPacket -> Put
putUserAttrSubPacket' (ImageAttribute (ImageHV1 ImageFormat
iformat) ByteString
idata) = do
      Word8 -> Put
putWord8 Word8
1
      Word16 -> Put
putWord16le Word16
16
      Word8 -> Put
putWord8 Word8
1
      Word8 -> Put
putWord8 (ImageFormat -> Word8
forall a. FutureVal a => a -> Word8
fromFVal ImageFormat
iformat)
      Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
12 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
putWord8 Word8
0
      ByteString -> Put
putLazyByteString ByteString
idata
    putUserAttrSubPacket' (OtherUASub Word8
t ByteString
bs) = do
      Word8 -> Put
putWord8 Word8
t
      ByteString -> Put
putLazyByteString ByteString
bs

-- | Serialize PKESKv3 session-key material.
-- For ECDH and X25519 the RFC 6637 §8 / RFC 9580 §5.1.6 wire format is used:
-- MPI(ephemeral_key) || 1-octet-count || wrapped_session_key_bytes.
-- All other algorithms use the standard MPI sequence.
putPKESKv3SessionKeyMaterial :: PubKeyAlgorithm -> NE.NonEmpty MPI -> Put
putPKESKv3SessionKeyMaterial :: PubKeyAlgorithm -> NonEmpty MPI -> Put
putPKESKv3SessionKeyMaterial PubKeyAlgorithm
pka NonEmpty MPI
mpis
  | PubKeyAlgorithm
pka PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
ECDH, PubKeyAlgorithm
X25519]
  , (MPI
ephMPI NE.:| [MPI
wrappedMPI]) <- NonEmpty MPI
mpis = do
      MPI -> Put
forall t. Binary t => t -> Put
put MPI
ephMPI
      let rawWrapped :: ByteString
rawWrapped = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp (MPI -> Integer
unMPI MPI
wrappedMPI)
          -- Left-pad to the nearest valid RFC 3394 wrapped-key length so that
          -- leading-zero bytes stripped by i2osp are restored.
          targetLen :: Int
targetLen = Int -> [Int] -> Int
forall {p}. p -> [p] -> p
headDef (ByteString -> Int
B.length ByteString
rawWrapped) ((Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
B.length ByteString
rawWrapped) [Int
32, Int
40, Int
48])
          paddedWrapped :: ByteString
paddedWrapped = Int -> ByteString -> ByteString
leftPadTo Int
targetLen ByteString
rawWrapped
      Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
paddedWrapped))
      ByteString -> Put
putByteString ByteString
paddedWrapped
  | Bool
otherwise = (MPI -> Put) -> NonEmpty MPI -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ MPI -> Put
forall t. Binary t => t -> Put
put NonEmpty MPI
mpis
  where
    headDef :: p -> [p] -> p
headDef p
d [] = p
d
    headDef p
_ (p
x:[p]
_) = p
x

putPkt :: Pkt -> Put
putPkt :: Pkt -> Put
putPkt (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 Word8
pv EightOctetKeyId
eokeyid PubKeyAlgorithm
pka NonEmpty MPI
mpis))) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
1)
  let bsk :: ByteString
bsk = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ PubKeyAlgorithm -> NonEmpty MPI -> Put
putPKESKv3SessionKeyMaterial PubKeyAlgorithm
pka NonEmpty MPI
mpis
  Integer -> Put
putPacketLength (Integer -> Put) -> (Int64 -> Integer) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ Int64
10 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
bsk
  Word8 -> Put
putWord8 Word8
pv -- must be 3
  ByteString -> Put
putLazyByteString (EightOctetKeyId -> ByteString
unEOKI EightOctetKeyId
eokeyid) -- must be 8 octets
  Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (PubKeyAlgorithm -> Word8) -> PubKeyAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (PubKeyAlgorithm -> Word8) -> PubKeyAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ PubKeyAlgorithm
pka
  ByteString -> Put
putLazyByteString ByteString
bsk
putPkt (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 ByteString
recipientKeyIdentifier PubKeyAlgorithm
pka ByteString
esk))) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
1)
  let keyIdentifierLen :: Int64
keyIdentifierLen = ByteString -> Int64
BL.length ByteString
recipientKeyIdentifier
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
keyIdentifierLen Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
255) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
    String -> Put
forall a. HasCallStack => String -> a
error String
"PKESK v6 recipient key identifier must fit in one octet"
  Integer -> Put
putPacketLength (Integer -> Put) -> (Int64 -> Integer) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ Int64
3 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
keyIdentifierLen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
esk
  Word8 -> Put
putWord8 Word8
6
  Word8 -> Put
putWord8 (Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
keyIdentifierLen)
  ByteString -> Put
putLazyByteString ByteString
recipientKeyIdentifier
  Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (PubKeyAlgorithm -> Word8) -> PubKeyAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (PubKeyAlgorithm -> Word8) -> PubKeyAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ PubKeyAlgorithm
pka
  ByteString -> Put
putLazyByteString ByteString
esk
putPkt (SignaturePkt SignaturePayload
sp) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
2)
  let bs :: ByteString
bs = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ SignaturePayload -> Put
forall t. Binary t => t -> Put
put SignaturePayload
sp
  ByteString -> Put
putLengthThenPayload ByteString
bs
putPkt (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 SymmetricAlgorithm
symalgo S2K
s2k Maybe ByteString
mesk))) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
3)
  let bs2k :: ByteString
bs2k = S2K -> ByteString
fromS2K S2K
s2k
  let bsk :: ByteString
bsk = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
BL.empty Maybe ByteString
mesk
  Integer -> Put
putPacketLength (Integer -> Put) -> (Int64 -> Integer) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
bs2k Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
bsk
  Word8 -> Put
putWord8 Word8
4
  Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (SymmetricAlgorithm -> Word8) -> SymmetricAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (SymmetricAlgorithm -> Word8) -> SymmetricAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ SymmetricAlgorithm
symalgo
  ByteString -> Put
putLazyByteString ByteString
bs2k
  ByteString -> Put
putLazyByteString ByteString
bsk
putPkt (SKESKPkt (SKESKPayloadV6Packet (SKESKPayloadV6 SymmetricAlgorithm
symalgo AEADAlgorithm
aead S2K
s2k ByteString
iv ByteString
esk ByteString
tag))) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
3)
  let bs2k :: ByteString
bs2k = S2K -> ByteString
fromS2K S2K
s2k
  let params :: ByteString
params =
        [Word8] -> ByteString
BL.pack
          [ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal SymmetricAlgorithm
symalgo)
          , Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (AEADAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal AEADAlgorithm
aead)
          , Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
bs2k)
          ] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
        ByteString
bs2k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
iv
  Integer -> Put
putPacketLength (Integer -> Put) -> (Int64 -> Integer) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
params Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
esk Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
tag
  Word8 -> Put
putWord8 Word8
6
  Word8 -> Put
putWord8 (Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
params))
  ByteString -> Put
putLazyByteString ByteString
params
  ByteString -> Put
putLazyByteString ByteString
esk
  ByteString -> Put
putLazyByteString ByteString
tag
putPkt (OnePassSignaturePkt (OPSPayloadV3Packet (OPSPayloadV3 Word8
pv SigType
sigtype HashAlgorithm
ha PubKeyAlgorithm
pka EightOctetKeyId
skeyid Bool
nested))) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
4)
  let bs :: ByteString
bs =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
          Word8 -> Put
putWord8 Word8
pv -- should be 3
          Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8) -> (SigType -> Word8) -> SigType -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigType -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (SigType -> Word8) -> SigType -> Word8
forall a b. (a -> b) -> a -> b
$ SigType
sigtype
          Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (HashAlgorithm -> Word8) -> HashAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (HashAlgorithm -> Word8) -> HashAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ HashAlgorithm
ha
          Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (PubKeyAlgorithm -> Word8) -> PubKeyAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (PubKeyAlgorithm -> Word8) -> PubKeyAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ PubKeyAlgorithm
pka
          ByteString -> Put
putLazyByteString (EightOctetKeyId -> ByteString
unEOKI EightOctetKeyId
skeyid)
          Word8 -> Put
putWord8 (Word8 -> Put) -> (Bool -> Word8) -> Bool -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Bool -> Int) -> Bool -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool -> Put) -> Bool -> Put
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
nested
  ByteString -> Put
putLengthThenPayload ByteString
bs
putPkt (OnePassSignaturePkt (OPSPayloadV6Packet (OPSPayloadV6 SigType
sigtype HashAlgorithm
ha PubKeyAlgorithm
pka SignatureSalt
salt ByteString
signerFingerprint Bool
nested))) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
4)
  let saltBytes :: ByteString
saltBytes = SignatureSalt -> ByteString
unSignatureSalt SignatureSalt
salt
      saltSize :: Int64
saltSize = ByteString -> Int64
BL.length ByteString
saltBytes
      expectedSaltSize :: Word8
expectedSaltSize =
        Word8 -> (Word8 -> Word8) -> Maybe Word8 -> Word8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (String -> Word8
forall a. HasCallStack => String -> a
error (String
"signature hash algorithm does not define a V6 salt size: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha))
          Word8 -> Word8
forall a. a -> a
id
          (HashAlgorithm -> Maybe Word8
v6SaltSizeForHashAlgorithm HashAlgorithm
ha)
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
saltSize Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
expectedSaltSize) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
    String -> Put
forall a. HasCallStack => String -> a
error
      (String
"OPS v6 salt size mismatch for " String -> String -> String
forall a. [a] -> [a] -> [a]
++
       HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
expectedSaltSize String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
saltSize)
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int64
BL.length ByteString
signerFingerprint Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
32) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
    String -> Put
forall a. HasCallStack => String -> a
error String
"OPS v6 signer fingerprint must be exactly 32 octets"
  let bs :: ByteString
bs =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
          Word8 -> Put
putWord8 Word8
6
          Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8) -> (SigType -> Word8) -> SigType -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigType -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (SigType -> Word8) -> SigType -> Word8
forall a b. (a -> b) -> a -> b
$ SigType
sigtype
          Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (HashAlgorithm -> Word8) -> HashAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (HashAlgorithm -> Word8) -> HashAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ HashAlgorithm
ha
          Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (PubKeyAlgorithm -> Word8) -> PubKeyAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (PubKeyAlgorithm -> Word8) -> PubKeyAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ PubKeyAlgorithm
pka
          Word8 -> Put
putWord8 (Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
saltSize)
          ByteString -> Put
putLazyByteString ByteString
saltBytes
          ByteString -> Put
putLazyByteString ByteString
signerFingerprint
          Word8 -> Put
putWord8 (Word8 -> Put) -> (Bool -> Word8) -> Bool -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Bool -> Int) -> Bool -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool -> Put) -> Bool -> Put
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
nested
  ByteString -> Put
putLengthThenPayload ByteString
bs
putPkt (SecretKeyPkt SomePKPayload
pkp SKAddendum
ska) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
5)
  let bs :: ByteString
bs = Put -> ByteString
runPut (SomePKPayload -> Put
putPKPayload SomePKPayload
pkp Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomePKPayload -> SKAddendum -> Put
putSKAddendumForPKPayload SomePKPayload
pkp SKAddendum
ska)
  ByteString -> Put
putLengthThenPayload ByteString
bs
putPkt (PublicKeyPkt SomePKPayload
pkp) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
6)
  let bs :: ByteString
bs = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ SomePKPayload -> Put
putPKPayload SomePKPayload
pkp
  ByteString -> Put
putLengthThenPayload ByteString
bs
putPkt (SecretSubkeyPkt SomePKPayload
pkp SKAddendum
ska) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
7)
  let bs :: ByteString
bs = Put -> ByteString
runPut (SomePKPayload -> Put
putPKPayload SomePKPayload
pkp Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomePKPayload -> SKAddendum -> Put
putSKAddendumForPKPayload SomePKPayload
pkp SKAddendum
ska)
  ByteString -> Put
putLengthThenPayload ByteString
bs
putPkt (CompressedDataPkt CompressionAlgorithm
ca ByteString
cdata) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
8)
  let bs :: ByteString
bs =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
          Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8)
-> (CompressionAlgorithm -> Word8) -> CompressionAlgorithm -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompressionAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (CompressionAlgorithm -> Word8) -> CompressionAlgorithm -> Word8
forall a b. (a -> b) -> a -> b
$ CompressionAlgorithm
ca
          ByteString -> Put
putLazyByteString ByteString
cdata
  ByteString -> Put
putLengthThenPayload ByteString
bs
putPkt (SymEncDataPkt ByteString
b) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
9)
  ByteString -> Put
putLengthThenPayload ByteString
b
putPkt (MarkerPkt ByteString
b) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
10)
  ByteString -> Put
putLengthThenPayload ByteString
b
putPkt (LiteralDataPkt DataType
dt ByteString
fn ThirtyTwoBitTimeStamp
ts ByteString
b) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
11)
  let bs :: ByteString
bs =
        Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
          Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8) -> (DataType -> Word8) -> DataType -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataType -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (DataType -> Word8) -> DataType -> Word8
forall a b. (a -> b) -> a -> b
$ DataType
dt
          Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8) -> (ByteString -> Int64) -> ByteString -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Word8) -> ByteString -> Word8
forall a b. (a -> b) -> a -> b
$ ByteString
fn
          ByteString -> Put
putLazyByteString ByteString
fn
          Word32 -> Put
putWord32be (Word32 -> Put)
-> (ThirtyTwoBitTimeStamp -> Word32)
-> ThirtyTwoBitTimeStamp
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp (ThirtyTwoBitTimeStamp -> Put) -> ThirtyTwoBitTimeStamp -> Put
forall a b. (a -> b) -> a -> b
$ ThirtyTwoBitTimeStamp
ts
          ByteString -> Put
putLazyByteString ByteString
b
  ByteString -> Put
putLengthThenPayload ByteString
bs
putPkt (TrustPkt ByteString
b) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
12)
  ByteString -> Put
putLengthThenPayload ByteString
b
putPkt (UserIdPkt Text
u) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
13)
  let bs :: ByteString
bs = Text -> ByteString
encodeUtf8 Text
u
  Integer -> Put
putPacketLength (Integer -> Put) -> (Int -> Integer) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs
  ByteString -> Put
putByteString ByteString
bs
putPkt (PublicSubkeyPkt SomePKPayload
pkp) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
14)
  let bs :: ByteString
bs = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ SomePKPayload -> Put
putPKPayload SomePKPayload
pkp
  ByteString -> Put
putLengthThenPayload ByteString
bs
putPkt (UserAttributePkt [UserAttrSubPacket]
us) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
17)
  let bs :: ByteString
bs = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (UserAttrSubPacket -> Put) -> [UserAttrSubPacket] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ UserAttrSubPacket -> Put
forall t. Binary t => t -> Put
put [UserAttrSubPacket]
us
  ByteString -> Put
putLengthThenPayload ByteString
bs
putPkt (SymEncIntegrityProtectedDataPkt (SEIPD1 Word8
pv ByteString
b)) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
18)
  Integer -> Put
putPacketLength (Integer -> Put) -> (Int64 -> Integer) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
  Word8 -> Put
putWord8 Word8
pv -- should be 1
  ByteString -> Put
putLazyByteString ByteString
b
putPkt (SymEncIntegrityProtectedDataPkt (SEIPD2 SymmetricAlgorithm
symalgo AEADAlgorithm
aeadalgo Word8
chunkSize Salt
salt ByteString
b)) = do
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length (Salt -> ByteString
unSalt Salt
salt) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
    String -> Put
forall a. HasCallStack => String -> a
error String
"SEIPD v2 salt must be exactly 32 octets"
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
chunkSize Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
16) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
    String -> Put
forall a. HasCallStack => String -> a
error String
"SEIPD v2 chunk size octet must be between 0 and 16"
  case SymmetricAlgorithm
symalgo of
    OtherSA Word8
_ -> String -> Put
forall a. HasCallStack => String -> a
error String
"SEIPD v2 requires a known symmetric algorithm"
    SymmetricAlgorithm
Plaintext -> String -> Put
forall a. HasCallStack => String -> a
error String
"SEIPD v2 cannot use plaintext cipher"
    SymmetricAlgorithm
_ -> () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case AEADAlgorithm
aeadalgo of
    OtherAEADAlgo Word8
_ -> String -> Put
forall a. HasCallStack => String -> a
error String
"SEIPD v2 requires a known AEAD algorithm"
    AEADAlgorithm
_ -> () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
18)
  Integer -> Put
putPacketLength (Integer -> Put) -> (Int64 -> Integer) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Put) -> Int64 -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
36
  Word8 -> Put
putWord8 Word8
2
  Word8 -> Put
putWord8 (SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal SymmetricAlgorithm
symalgo)
  Word8 -> Put
putWord8 (AEADAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal AEADAlgorithm
aeadalgo)
  Word8 -> Put
putWord8 Word8
chunkSize
  ByteString -> Put
putByteString (Salt -> ByteString
unSalt Salt
salt)
  ByteString -> Put
putLazyByteString ByteString
b
putPkt (ModificationDetectionCodePkt ByteString
hash) = do
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
19)
  ByteString -> Put
putLengthThenPayload ByteString
hash
putPkt (OtherPacketPkt Word8
t ByteString
payload) = do
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
t Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
63) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
    String -> Put
forall a. HasCallStack => String -> a
error (String
"cannot serialize OtherPacket packet tag > 63: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
t)
  Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
t)
  ByteString -> Put
putLengthThenPayload ByteString
payload
putPkt (BrokenPacketPkt String
_ Word8
t ByteString
payload) = Pkt -> Put
putPkt (Word8 -> ByteString -> Pkt
OtherPacketPkt Word8
t ByteString
payload)

-- | Validate a packet before serialization to catch constraint violations early.
-- Returns Left with descriptive error if validation fails.
validatePkt :: Pkt -> Either String ()
validatePkt :: Pkt -> Either String ()
validatePkt (PKESKPkt (PKESKPayloadV6Packet (PKESKPayloadV6 ByteString
recipientKeyIdentifier PubKeyAlgorithm
_ ByteString
_))) = do
  let keyIdentifierLen :: Int64
keyIdentifierLen = ByteString -> Int64
BL.length ByteString
recipientKeyIdentifier
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
keyIdentifierLen Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
255) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left String
"PKESK v6 recipient key identifier must fit in one octet (max 255 bytes)"
  () -> Either String ()
forall a b. b -> Either a b
Right ()
validatePkt (OnePassSignaturePkt (OPSPayloadV6Packet (OPSPayloadV6 SigType
_ HashAlgorithm
ha PubKeyAlgorithm
_ SignatureSalt
salt ByteString
signerFingerprint Bool
_))) = do
  let saltBytes :: ByteString
saltBytes = SignatureSalt -> ByteString
unSignatureSalt SignatureSalt
salt
      saltSize :: Int64
saltSize = ByteString -> Int64
BL.length ByteString
saltBytes
  expectedSaltSize <-
    case HashAlgorithm -> Maybe Word8
v6SaltSizeForHashAlgorithm HashAlgorithm
ha of
      Maybe Word8
Nothing -> String -> Either String Word8
forall a b. a -> Either a b
Left (String -> Either String Word8) -> String -> Either String Word8
forall a b. (a -> b) -> a -> b
$ String
"signature hash algorithm does not define a V6 salt size: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha
      Just Word8
sz -> Word8 -> Either String Word8
forall a b. b -> Either a b
Right Word8
sz
  when (fromIntegral saltSize /= expectedSaltSize) $
    Left
      ("OPS v6 salt size mismatch for " ++
       show ha ++ ": expected " ++ show expectedSaltSize ++ ", got " ++ show saltSize)
  when (BL.length signerFingerprint /= 32) $
    Left "OPS v6 signer fingerprint must be exactly 32 octets"
  Right ()
validatePkt (SymEncIntegrityProtectedDataPkt (SEIPD2 SymmetricAlgorithm
symalgo AEADAlgorithm
aeadalgo Word8
chunkSize Salt
salt ByteString
_)) = do
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length (Salt -> ByteString
unSalt Salt
salt) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left String
"SEIPD v2 salt must be exactly 32 octets"
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
chunkSize Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
16) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left String
"SEIPD v2 chunk size octet must be between 0 and 16"
  case SymmetricAlgorithm
symalgo of
    OtherSA Word8
_ -> String -> Either String ()
forall a b. a -> Either a b
Left String
"SEIPD v2 requires a known symmetric algorithm"
    SymmetricAlgorithm
Plaintext -> String -> Either String ()
forall a b. a -> Either a b
Left String
"SEIPD v2 cannot use plaintext cipher"
    SymmetricAlgorithm
_ -> () -> Either String ()
forall a b. b -> Either a b
Right ()
  case AEADAlgorithm
aeadalgo of
    OtherAEADAlgo Word8
_ -> String -> Either String ()
forall a b. a -> Either a b
Left String
"SEIPD v2 requires a known AEAD algorithm"
    AEADAlgorithm
_ -> () -> Either String ()
forall a b. b -> Either a b
Right ()
validatePkt (OtherPacketPkt Word8
t ByteString
_) = do
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
t Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
63) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left (String
"cannot serialize OtherPacket packet tag > 63: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
t)
  () -> Either String ()
forall a b. b -> Either a b
Right ()
validatePkt Pkt
_ = () -> Either String ()
forall a b. b -> Either a b
Right ()

-- | Serialize a packet with explicit validation and error handling.
-- Validates constraints before calling putPkt to ensure errors are caught early.
putPktEither :: Pkt -> Either String Put
putPktEither :: Pkt -> Either String Put
putPktEither Pkt
pkt = case Pkt -> Either String ()
validatePkt Pkt
pkt of
  Left String
err -> String -> Either String Put
forall a b. a -> Either a b
Left String
err
  Right () -> Put -> Either String Put
forall a b. b -> Either a b
Right (Pkt -> Put
putPkt Pkt
pkt)

putLengthThenPayload :: ByteString -> Put
putLengthThenPayload :: ByteString -> Put
putLengthThenPayload ByteString
bs = do
  let len :: Int64
len = ByteString -> Int64
BL.length ByteString
bs
  if Int64
len Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
0x100000000 :: Integer)
    then do
      Integer -> Put
putPacketLength (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len)
      ByteString -> Put
putLazyByteString ByteString
bs
    else ByteString -> Put
putPartialLengthPayload ByteString
bs
  where
    maxPartialChunkSize :: Int64
    maxPartialChunkSize :: Int64
maxPartialChunkSize = Int64
1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` (Int
30 :: Int)
    putPartialLengthPayload :: ByteString -> Put
    putPartialLengthPayload :: ByteString -> Put
putPartialLengthPayload ByteString
payload
      | ByteString -> Int64
BL.length ByteString
payload Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
maxPartialChunkSize = do
        let (ByteString
chunk, ByteString
rest) = Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt Int64
maxPartialChunkSize ByteString
payload
        Word8 -> Put
putPartialLength Word8
30
        ByteString -> Put
putLazyByteString ByteString
chunk
        ByteString -> Put
putPartialLengthPayload ByteString
rest
      | Bool
otherwise = do
        Integer -> Put
putPacketLength (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
payload))
        ByteString -> Put
putLazyByteString ByteString
payload

validateSEIPDv2Header ::
     SymmetricAlgorithm -> AEADAlgorithm -> Word8 -> ByteString -> Get ()
validateSEIPDv2Header :: SymmetricAlgorithm
-> AEADAlgorithm -> Word8 -> ByteString -> Get ()
validateSEIPDv2Header SymmetricAlgorithm
symalgo AEADAlgorithm
aeadalgo Word8
chunkSize ByteString
encrypted = do
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
chunkSize Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
16) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
    String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SEIPD v2 chunk size octet must be between 0 and 16"
  Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
BL.null ByteString
encrypted) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
    String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SEIPD v2 payload is missing encrypted data and final authentication tag"
  case SymmetricAlgorithm
symalgo of
    OtherSA Word8
_ -> String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SEIPD v2 requires a known symmetric algorithm"
    SymmetricAlgorithm
Plaintext -> String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SEIPD v2 cannot use plaintext cipher"
    SymmetricAlgorithm
_ -> () -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case AEADAlgorithm
aeadalgo of
    OtherAEADAlgo Word8
_ -> String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SEIPD v2 requires a known AEAD algorithm"
    AEADAlgorithm
_ -> () -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

getPubkey :: PubKeyAlgorithm -> Get PKey
getPubkey :: PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
RSA = do
  MPI n <- Get MPI
forall t. Binary t => Get t
get
  MPI e <- get
  return $
    RSAPubKey
      (RSA_PublicKey (R.PublicKey (fromIntegral . B.length . i2osp $ n) n e))
getPubkey PubKeyAlgorithm
DeprecatedRSAEncryptOnly = PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
RSA
getPubkey PubKeyAlgorithm
DeprecatedRSASignOnly = PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
RSA
getPubkey PubKeyAlgorithm
DSA = do
  MPI p <- Get MPI
forall t. Binary t => Get t
get
  MPI q <- get
  MPI g <- get
  MPI y <- get
  return $ DSAPubKey (DSA_PublicKey (D.PublicKey (D.Params p g q) y))
getPubkey PubKeyAlgorithm
ElgamalEncryptOnly = PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
ForbiddenElgamal
getPubkey PubKeyAlgorithm
ForbiddenElgamal = do
  MPI p <- Get MPI
forall t. Binary t => Get t
get
  MPI g <- get
  MPI y <- get
  return $ ElGamalPubKey p g y
getPubkey PubKeyAlgorithm
ECDSA = do
  curvelength <- Get Word8
getWord8
  when (curvelength == 0 || curvelength == 0xff) $
    fail "invalid ECC curve OID length octet (reserved value)"
  curveoid <- getByteString (fromIntegral curvelength)
  MPI mpi <- getMPI
  case curveoidBSToCurve curveoid of
    Left String
e -> String -> Get PKey
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Right ECCCurve
Curve25519 ->
      EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey EdSigningCurve
P.Ed25519 (EdPoint -> PKey) -> Get EdPoint -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EPoint -> EdPoint
PrefixedNativeEPoint (EPoint -> EdPoint) -> Get EPoint -> Get EdPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String -> Integer -> Get EPoint
validatePrefixedNativePoint Int
32 String
"Curve25519Legacy" Integer
mpi)
    Right ECCCurve
curve ->
      case ByteString -> Either String PublicPoint
bs2Point (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
mpi) of
        Left String
e -> String -> Get PKey
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
        Right PublicPoint
point ->
          PKey -> Get PKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (PKey -> Get PKey)
-> (PublicPoint -> PKey) -> PublicPoint -> Get PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ECDSA_PublicKey -> PKey
ECDSAPubKey (ECDSA_PublicKey -> PKey)
-> (PublicPoint -> ECDSA_PublicKey) -> PublicPoint -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ECDSA_PublicKey
ECDSA_PublicKey (PublicKey -> ECDSA_PublicKey)
-> (PublicPoint -> PublicKey) -> PublicPoint -> ECDSA_PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          Curve -> PublicPoint -> PublicKey
ECDSA.PublicKey (ECCCurve -> Curve
curve2Curve ECCCurve
curve) (PublicPoint -> Get PKey) -> PublicPoint -> Get PKey
forall a b. (a -> b) -> a -> b
$
          PublicPoint
point
getPubkey PubKeyAlgorithm
ECDH = do
  ed <- PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
ECDSA -- could be an ECDSA or an EdDSA
  kdflen <- getWord8
  when (kdflen == 0 || kdflen == 0xff) $
    fail "invalid ECDH KDF field length octet (reserved value)"
  when (kdflen /= 3) $
    fail ("invalid ECDH KDF field length: " ++ show kdflen)
  one <- getWord8
  when (one /= 1) $
    fail ("invalid ECDH KDF reserved octet: " ++ show one)
  kdfHA <- get
  kdfSA <- get
  return $ ECDHPubKey ed kdfHA kdfSA
getPubkey PubKeyAlgorithm
EdDSA = do
  curvelength <- Get Word8
getWord8
  when (curvelength == 0 || curvelength == 0xff) $
    fail "invalid EdDSA curve OID length octet (reserved value)"
  curveoid <- getByteString (fromIntegral curvelength)
  MPI mpi <- getMPI
  case curveoidBSToEdSigningCurve curveoid of
    Left String
e -> String -> Get PKey
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Right EdSigningCurve
P.Ed25519 ->
      EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey EdSigningCurve
P.Ed25519 (EdPoint -> PKey) -> Get EdPoint -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EPoint -> EdPoint
PrefixedNativeEPoint (EPoint -> EdPoint) -> Get EPoint -> Get EdPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String -> Integer -> Get EPoint
validatePrefixedNativePoint Int
32 String
"Ed25519Legacy" Integer
mpi)
    Right EdSigningCurve
P.Ed448 ->
      EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey EdSigningCurve
P.Ed448 (EdPoint -> PKey) -> Get EdPoint -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EPoint -> EdPoint
PrefixedNativeEPoint (EPoint -> EdPoint) -> Get EPoint -> Get EdPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String -> Integer -> Get EPoint
validatePrefixedNativePoint Int
57 String
"Ed448Legacy" Integer
mpi)
getPubkey PubKeyAlgorithm
pka | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.Ed25519 =
  Int64 -> (ByteString -> PKey) -> Get PKey -> Get PKey
parseFixedLengthOrLegacyPubkey
    Int64
32
    (EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey EdSigningCurve
P.Ed25519 (EdPoint -> PKey) -> (ByteString -> EdPoint) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPoint -> EdPoint
NativeEPoint (EPoint -> EdPoint)
-> (ByteString -> EPoint) -> ByteString -> EdPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EPoint
EPoint (Integer -> EPoint)
-> (ByteString -> Integer) -> ByteString -> EPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (ByteString -> Integer)
-> (ByteString -> ByteString) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict)
    (PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
EdDSA)
getPubkey PubKeyAlgorithm
pka | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.Ed448 =
  Int64 -> (ByteString -> PKey) -> Get PKey -> Get PKey
parseFixedLengthOrLegacyPubkey
    Int64
57
    (EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey EdSigningCurve
P.Ed448 (EdPoint -> PKey) -> (ByteString -> EdPoint) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPoint -> EdPoint
NativeEPoint (EPoint -> EdPoint)
-> (ByteString -> EPoint) -> ByteString -> EdPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EPoint
EPoint (Integer -> EPoint)
-> (ByteString -> Integer) -> ByteString -> EPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (ByteString -> Integer)
-> (ByteString -> ByteString) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict)
    (PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
EdDSA)
getPubkey PubKeyAlgorithm
X25519 =
  Int64 -> (ByteString -> PKey) -> Get PKey -> Get PKey
parseFixedLengthOrLegacyPubkey
    Int64
32
    (EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey EdSigningCurve
P.Ed25519 (EdPoint -> PKey) -> (ByteString -> EdPoint) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPoint -> EdPoint
NativeEPoint (EPoint -> EdPoint)
-> (ByteString -> EPoint) -> ByteString -> EdPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EPoint
EPoint (Integer -> EPoint)
-> (ByteString -> Integer) -> ByteString -> EPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (ByteString -> Integer)
-> (ByteString -> ByteString) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict)
    (PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
ECDH)
getPubkey PubKeyAlgorithm
X448 =
  Int64 -> (ByteString -> PKey) -> Get PKey -> Get PKey
parseFixedLengthOrLegacyPubkey
    Int64
56
    (EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey EdSigningCurve
P.Ed448 (EdPoint -> PKey) -> (ByteString -> EdPoint) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPoint -> EdPoint
NativeEPoint (EPoint -> EdPoint)
-> (ByteString -> EPoint) -> ByteString -> EdPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> EPoint
EPoint (Integer -> EPoint)
-> (ByteString -> Integer) -> ByteString -> EPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (ByteString -> Integer)
-> (ByteString -> ByteString) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict)
    (PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
ECDH)
getPubkey PubKeyAlgorithm
_ = ByteString -> PKey
UnknownPKey (ByteString -> PKey) -> Get ByteString -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString

parseFixedLengthOrLegacyPubkey :: Int64 -> (BL.ByteString -> PKey) -> Get PKey -> Get PKey
parseFixedLengthOrLegacyPubkey :: Int64 -> (ByteString -> PKey) -> Get PKey -> Get PKey
parseFixedLengthOrLegacyPubkey Int64
expectedLen ByteString -> PKey
decodeFixed Get PKey
legacyParser = do
  remaining <- Get ByteString -> Get ByteString
forall a. Get a -> Get a
lookAhead Get ByteString
getRemainingLazyByteString
  if BL.length remaining == expectedLen
    then decodeFixed <$> getLazyByteString expectedLen
    else legacyParser

getPubkeyV6 :: PubKeyAlgorithm -> Get PKey
getPubkeyV6 :: PubKeyAlgorithm -> Get PKey
getPubkeyV6 PubKeyAlgorithm
pka
  | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.Ed25519 = do
      len <- Get Word32
getWord32be
      bs <- getByteString (fromIntegral len)
      when (B.length bs /= 32) $
        fail "invalid v6 Ed25519 public key length"
      return $ EdDSAPubKey P.Ed25519 (NativeEPoint (EPoint (os2ip bs)))
  | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.Ed448 = do
      len <- Get Word32
getWord32be
      bs <- getByteString (fromIntegral len)
      when (B.length bs /= 57) $
        fail "invalid v6 Ed448 public key length"
      return $ EdDSAPubKey P.Ed448 (NativeEPoint (EPoint (os2ip bs)))
  | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.X25519 = do
      len <- Get Word32
getWord32be
      bs <- getByteString (fromIntegral len)
      when (B.length bs /= 32) $
        fail "invalid v6 X25519 public key length"
      return $ EdDSAPubKey P.Ed25519 (NativeEPoint (EPoint (os2ip bs)))
  | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.X448 = do
      len <- Get Word32
getWord32be
      bs <- getByteString (fromIntegral len)
      when (B.length bs /= 56) $
        fail "invalid v6 X448 public key length"
      return $ EdDSAPubKey P.Ed448 (NativeEPoint (EPoint (os2ip bs)))
  | Bool
otherwise = PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
pka

bs2Point :: B.ByteString -> Either String ECDSA.PublicPoint
bs2Point :: ByteString -> Either String PublicPoint
bs2Point ByteString
bs =
  if ByteString -> Bool
B.null ByteString
bs
    then String -> Either String PublicPoint
forall a b. a -> Either a b
Left String
"empty EC point encoding"
    else
      let xy :: ByteString
xy = Int -> ByteString -> ByteString
B.drop Int
1 ByteString
bs
          l :: Int
l = ByteString -> Int
B.length ByteString
xy
       in if HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
bs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x04
            then String -> Either String PublicPoint
forall a b. a -> Either a b
Left (String -> Either String PublicPoint)
-> String -> Either String PublicPoint
forall a b. (a -> b) -> a -> b
$ String
"unknown type of point: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
B.unpack ByteString
bs)
            else if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
l
                   then String -> Either String PublicPoint
forall a b. a -> Either a b
Left String
"malformed EC point encoding: odd coordinate payload length"
                   else
                     PublicPoint -> Either String PublicPoint
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return
                       ((Integer -> Integer -> PublicPoint)
-> (Integer, Integer) -> PublicPoint
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry
                          Integer -> Integer -> PublicPoint
ECCT.Point
                          ((ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (ByteString -> Integer)
-> (ByteString -> Integer)
-> (ByteString, ByteString)
-> (Integer, Integer)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip) (Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
l Int
2) ByteString
xy)))

putPubkey :: PKey -> Put
putPubkey :: PKey -> Put
putPubkey (UnknownPKey ByteString
bs) = ByteString -> Put
putLazyByteString ByteString
bs
putPubkey p :: PKey
p@(ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey Curve
curve PublicPoint
_))) =
  let Right ByteString
curveoidbs = ECCCurve -> Either String ByteString
curveToCurveoidBS (Curve -> ECCCurve
curveFromCurve Curve
curve)
   in ByteString -> Put
putCurveOID ByteString
curveoidbs Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      (MPI -> Put) -> [MPI] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MPI -> Put
forall t. Binary t => t -> Put
put (PKey -> [MPI]
pubkeyToMPIs PKey
p)
putPubkey p :: PKey
p@(ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey Curve
curve PublicPoint
_))) HashAlgorithm
kha SymmetricAlgorithm
ksa) =
  let Right ByteString
curveoidbs = ECCCurve -> Either String ByteString
curveToCurveoidBS (Curve -> ECCCurve
curveFromCurve Curve
curve)
   in ByteString -> Put
putCurveOID ByteString
curveoidbs Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      (MPI -> Put) -> [MPI] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MPI -> Put
forall t. Binary t => t -> Put
put (PKey -> [MPI]
pubkeyToMPIs PKey
p) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      HashAlgorithm -> SymmetricAlgorithm -> Put
putECDHKDFParams HashAlgorithm
kha SymmetricAlgorithm
ksa
putPubkey p :: PKey
p@(ECDHPubKey (EdDSAPubKey EdSigningCurve
curve (PrefixedNativeEPoint EPoint
_)) HashAlgorithm
kha SymmetricAlgorithm
ksa) =
  let Right ByteString
curveoidbs = ECCCurve -> Either String ByteString
curveToCurveoidBS (EdSigningCurve -> ECCCurve
ed2ec EdSigningCurve
curve)
   in ByteString -> Put
putCurveOID ByteString
curveoidbs Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      (MPI -> Put) -> [MPI] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MPI -> Put
forall t. Binary t => t -> Put
put (PKey -> [MPI]
pubkeyToMPIs PKey
p) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      HashAlgorithm -> SymmetricAlgorithm -> Put
putECDHKDFParams HashAlgorithm
kha SymmetricAlgorithm
ksa
  where
    ed2ec :: EdSigningCurve -> ECCCurve
ed2ec EdSigningCurve
P.Ed25519 = ECCCurve
Curve25519
    ed2ec EdSigningCurve
P.Ed448 = ECCCurve
Curve448
putPubkey p :: PKey
p@(EdDSAPubKey EdSigningCurve
curve (PrefixedNativeEPoint EPoint
_)) =
  let Right ByteString
curveoidbs = EdSigningCurve -> Either String ByteString
edSigningCurveToCurveoidBS EdSigningCurve
curve
   in ByteString -> Put
putCurveOID ByteString
curveoidbs Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      (MPI -> Put) -> [MPI] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MPI -> Put
forall t. Binary t => t -> Put
put (PKey -> [MPI]
pubkeyToMPIs PKey
p)
putPubkey (ECDHPubKey (EdDSAPubKey EdSigningCurve
curve (NativeEPoint EPoint
_)) HashAlgorithm
_ SymmetricAlgorithm
_) =
  String -> Put
forall a. HasCallStack => String -> a
error (String
"legacy ECDH serialization requires a prefixed-native " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EdSigningCurve -> String
forall a. Show a => a -> String
show EdSigningCurve
curve String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" point")
putPubkey (EdDSAPubKey EdSigningCurve
curve (NativeEPoint EPoint
_)) =
  String -> Put
forall a. HasCallStack => String -> a
error (String
"legacy EdDSA serialization requires a prefixed-native " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EdSigningCurve -> String
forall a. Show a => a -> String
show EdSigningCurve
curve String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" point")
putPubkey PKey
p = (MPI -> Put) -> [MPI] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MPI -> Put
forall t. Binary t => t -> Put
put (PKey -> [MPI]
pubkeyToMPIs PKey
p)

putPubkeyV6 :: PKey -> Put
putPubkeyV6 :: PKey -> Put
putPubkeyV6 (EdDSAPubKey EdSigningCurve
P.Ed25519 (NativeEPoint (EPoint Integer
x))) = do
  let bs :: ByteString
bs = Int -> Integer -> ByteString
fixedLengthOctets Int
32 Integer
x
  Word32 -> Put
putWord32be (Word32 -> Put) -> (ByteString -> Word32) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (ByteString -> Int) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
bs
  ByteString -> Put
putByteString ByteString
bs
putPubkeyV6 (EdDSAPubKey EdSigningCurve
P.Ed448 (NativeEPoint (EPoint Integer
x))) = do
  let bs :: ByteString
bs = Int -> Integer -> ByteString
fixedLengthOctets Int
57 Integer
x
  Word32 -> Put
putWord32be (Word32 -> Put) -> (ByteString -> Word32) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (ByteString -> Int) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
bs
  ByteString -> Put
putByteString ByteString
bs
putPubkeyV6 (ECDHPubKey (EdDSAPubKey EdSigningCurve
P.Ed25519 (NativeEPoint (EPoint Integer
x))) HashAlgorithm
kha SymmetricAlgorithm
ksa) = do
  let bs :: ByteString
bs = Int -> Integer -> ByteString
fixedLengthOctets Int
32 Integer
x
  Word32 -> Put
putWord32be (Word32 -> Put) -> (ByteString -> Word32) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (ByteString -> Int) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
bs
  ByteString -> Put
putByteString ByteString
bs
  HashAlgorithm -> Put
forall t. Binary t => t -> Put
put HashAlgorithm
kha
  SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
ksa
putPubkeyV6 (ECDHPubKey (EdDSAPubKey EdSigningCurve
P.Ed448 (NativeEPoint (EPoint Integer
x))) HashAlgorithm
kha SymmetricAlgorithm
ksa) = do
  let bs :: ByteString
bs = Int -> Integer -> ByteString
fixedLengthOctets Int
56 Integer
x
  Word32 -> Put
putWord32be (Word32 -> Put) -> (ByteString -> Word32) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (ByteString -> Int) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
bs
  ByteString -> Put
putByteString ByteString
bs
  HashAlgorithm -> Put
forall t. Binary t => t -> Put
put HashAlgorithm
kha
  SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
ksa
putPubkeyV6 PKey
p = PKey -> Put
putPubkey PKey
p

fixedLengthOctets :: Int -> Integer -> B.ByteString
fixedLengthOctets :: Int -> Integer -> ByteString
fixedLengthOctets Int
targetLen Integer
x =
  let bs :: ByteString
bs = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
x
   in if ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
targetLen
        then String -> ByteString
forall a. HasCallStack => String -> a
error (String
"public key element does not fit in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
targetLen String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" octets")
        else Int -> Word8 -> ByteString
B.replicate (Int
targetLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bs) Word8
0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs

validatePrefixedNativePoint :: Int -> String -> Integer -> Get EPoint
validatePrefixedNativePoint :: Int -> String -> Integer -> Get EPoint
validatePrefixedNativePoint Int
targetLen String
label Integer
i =
  let bs :: ByteString
bs = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
i
   in if ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
targetLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        then
          String -> Get EPoint
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
            (String
"invalid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" public key length: expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++
             Int -> String
forall a. Show a => a -> String
show (Int
targetLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" octets with 0x40 prefix, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
B.length ByteString
bs))
        else
          if HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
bs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x40
            then String -> Get EPoint
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" public key: missing 0x40 prefix")
            else EPoint -> Get EPoint
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> EPoint
EPoint Integer
i)

putCurveOID :: B.ByteString -> Put
putCurveOID :: ByteString -> Put
putCurveOID ByteString
oid = do
  let oidLength :: Int
oidLength = ByteString -> Int
B.length ByteString
oid
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
oidLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
oidLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xff) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
    String -> Put
forall a. HasCallStack => String -> a
error String
"curve OID length cannot use reserved values 0 or 255"
  Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oidLength)
  ByteString -> Put
putByteString ByteString
oid

putECDHKDFParams :: HashAlgorithm -> SymmetricAlgorithm -> Put
putECDHKDFParams :: HashAlgorithm -> SymmetricAlgorithm -> Put
putECDHKDFParams HashAlgorithm
kdfHA SymmetricAlgorithm
kdfSA = do
  let kdfLengthOctet :: Word8
kdfLengthOctet = Word8
0x03
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
kdfLengthOctet Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
|| Word8
kdfLengthOctet Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
    String -> Put
forall a. HasCallStack => String -> a
error String
"ECDH KDF field length cannot use reserved values 0 or 255"
  Word8 -> Put
putWord8 Word8
kdfLengthOctet
  Word8 -> Put
putWord8 Word8
0x01
  HashAlgorithm -> Put
forall t. Binary t => t -> Put
put HashAlgorithm
kdfHA
  SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
kdfSA

parseOPSNestedFlag :: Word8 -> Get NestedFlag
parseOPSNestedFlag :: Word8 -> Get Bool
parseOPSNestedFlag Word8
0 = Bool -> Get Bool
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
parseOPSNestedFlag Word8
1 = Bool -> Get Bool
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
parseOPSNestedFlag Word8
other =
  String -> Get Bool
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid OPS nested flag octet: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
other)

getSecretKey :: SomePKPayload -> Get SKey
getSecretKey :: SomePKPayload -> Get SKey
getSecretKey SomePKPayload
pkp
  | SomePKPayload -> PubKeyAlgorithm
_pkalgo SomePKPayload
pkp PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
RSA, PubKeyAlgorithm
DeprecatedRSAEncryptOnly, PubKeyAlgorithm
DeprecatedRSASignOnly] = do
    MPI d <- Get MPI
forall t. Binary t => Get t
get
    MPI p <- get
    MPI q <- get
    MPI _ <- get -- u
    case inverse q p of
      Maybe Integer
Nothing -> String -> Get SKey
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid RSA secret key: q has no inverse modulo p"
      Just Integer
qinv -> do
        let dP :: Integer
dP = Integer
d Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
            dQ :: Integer
dQ = Integer
d Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
            pub :: PublicKey
pub = (\(RSAPubKey (RSA_PublicKey PublicKey
x)) -> PublicKey
x) (SomePKPayload -> PKey
_pubkey SomePKPayload
pkp)
        SKey -> Get SKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SKey -> Get SKey) -> SKey -> Get SKey
forall a b. (a -> b) -> a -> b
$ RSA_PrivateKey -> SKey
RSAPrivateKey (PrivateKey -> RSA_PrivateKey
RSA_PrivateKey (PublicKey
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> PrivateKey
R.PrivateKey PublicKey
pub Integer
d Integer
p Integer
q Integer
dP Integer
dQ Integer
qinv))
  | SomePKPayload -> PubKeyAlgorithm
_pkalgo SomePKPayload
pkp PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
DSA = do
    MPI x <- Get MPI
forall t. Binary t => Get t
get
    return $ DSAPrivateKey (DSA_PrivateKey (D.PrivateKey (D.Params 0 0 0) x))
  | SomePKPayload -> PubKeyAlgorithm
_pkalgo SomePKPayload
pkp PubKeyAlgorithm -> [PubKeyAlgorithm] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
ElgamalEncryptOnly, PubKeyAlgorithm
ForbiddenElgamal] = do
   MPI x <- Get MPI
forall t. Binary t => Get t
get
   return $ ElGamalPrivateKey x
  | SomePKPayload -> PubKeyAlgorithm
_pkalgo SomePKPayload
pkp PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
ECDSA = do
   let pubcurve :: Curve
pubcurve =
         (\(ECDSAPubKey (ECDSA_PublicKey PublicKey
p)) -> PublicKey -> Curve
ECDSA.public_curve PublicKey
p)
           (SomePKPayload -> PKey
_pubkey SomePKPayload
pkp)
   Curve -> Get SKey
getECDSAScalarPrivateKey Curve
pubcurve
  | SomePKPayload -> PubKeyAlgorithm
_pkalgo SomePKPayload
pkp PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
ECDH
   = do
   pubcurve <- SomePKPayload -> Get Curve
ecdhPrivateCurveFromPKPayload SomePKPayload
pkp
   getECDHScalarPrivateKey pubcurve
  | SomePKPayload -> PubKeyAlgorithm
_pkalgo SomePKPayload
pkp PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
X25519 = do
   if SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V6
    then do
       sk <- Int -> Get ByteString
getByteString Int
32
       return $ X25519PrivateKey sk
     else do
       pubcurve <- SomePKPayload -> Get Curve
ecdhPrivateCurveFromPKPayload SomePKPayload
pkp
       getECDHScalarPrivateKey pubcurve
  | SomePKPayload -> PubKeyAlgorithm
_pkalgo SomePKPayload
pkp PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
X448 = do
    if SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V6
      then do
        sk <- Int -> Get ByteString
getByteString Int
56
        return $ X448PrivateKey sk
      else ByteString -> SKey
UnknownSKey (ByteString -> SKey) -> Get ByteString -> Get SKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
  | SomePKPayload -> PubKeyAlgorithm
_pkalgo SomePKPayload
pkp PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
EdDSA = do
    if SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V6
      then do
        case SomePKPayload -> PKey
_pubkey SomePKPayload
pkp of
          EdDSAPubKey EdSigningCurve
P.Ed25519 EdPoint
_ -> EdSigningCurve -> ByteString -> SKey
EdDSAPrivateKey EdSigningCurve
P.Ed25519 (ByteString -> SKey) -> Get ByteString -> Get SKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
32
          EdDSAPubKey EdSigningCurve
P.Ed448 EdPoint
_ -> EdSigningCurve -> ByteString -> SKey
EdDSAPrivateKey EdSigningCurve
P.Ed448 (ByteString -> SKey) -> Get ByteString -> Get SKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
57
          PKey
_ -> ByteString -> SKey
UnknownSKey (ByteString -> SKey) -> Get ByteString -> Get SKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
      else do
        MPI x <- Get MPI
forall t. Binary t => Get t
get
        case _pubkey pkp of
          EdDSAPubKey EdSigningCurve
P.Ed25519 EdPoint
_ ->
            SKey -> Get SKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SKey -> Get SKey) -> SKey -> Get SKey
forall a b. (a -> b) -> a -> b
$ EdSigningCurve -> ByteString -> SKey
EdDSAPrivateKey EdSigningCurve
P.Ed25519 (Int -> ByteString -> ByteString
leftPadTo Int
32 (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
x))
          EdDSAPubKey EdSigningCurve
P.Ed448 EdPoint
_ ->
            SKey -> Get SKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SKey -> Get SKey) -> SKey -> Get SKey
forall a b. (a -> b) -> a -> b
$ EdSigningCurve -> ByteString -> SKey
EdDSAPrivateKey EdSigningCurve
P.Ed448 (Int -> ByteString -> ByteString
leftPadTo Int
57 (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
x))
          PKey
_ -> SKey -> Get SKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SKey -> Get SKey) -> SKey -> Get SKey
forall a b. (a -> b) -> a -> b
$ ByteString -> SKey
UnknownSKey (ByteString -> ByteString
BL.fromStrict (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
x))
  | Bool
otherwise = ByteString -> SKey
UnknownSKey (ByteString -> SKey) -> Get ByteString -> Get SKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString

getECDSAScalarPrivateKey :: ECCT.Curve -> Get SKey
getECDSAScalarPrivateKey :: Curve -> Get SKey
getECDSAScalarPrivateKey Curve
curve = do
  MPI pn <- Get MPI
forall t. Binary t => Get t
get
  pure $ ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey curve pn))

getECDHScalarPrivateKey :: ECCT.Curve -> Get SKey
getECDHScalarPrivateKey :: Curve -> Get SKey
getECDHScalarPrivateKey Curve
curve = do
  MPI pn <- Get MPI
forall t. Binary t => Get t
get
  pure $ ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey curve pn))

ecdhPrivateCurveFromPKPayload :: SomePKPayload -> Get ECCT.Curve
ecdhPrivateCurveFromPKPayload :: SomePKPayload -> Get Curve
ecdhPrivateCurveFromPKPayload SomePKPayload
pkp =
  case SomePKPayload -> PKey
_pubkey SomePKPayload
pkp of
    ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey PublicKey
p)) HashAlgorithm
_ SymmetricAlgorithm
_ ->
      Curve -> Get Curve
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> Curve
ECDSA.public_curve PublicKey
p)
    ECDHPubKey (EdDSAPubKey EdSigningCurve
P.Ed25519 EdPoint
_) HashAlgorithm
_ SymmetricAlgorithm
_ ->
      Curve -> Get Curve
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ECCCurve -> Curve
curve2Curve ECCCurve
Curve25519)
    ECDHPubKey (EdDSAPubKey EdSigningCurve
P.Ed448 EdPoint
_) HashAlgorithm
_ SymmetricAlgorithm
_ ->
      Curve -> Get Curve
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ECCCurve -> Curve
curve2Curve ECCCurve
Curve448)
    PKey
other ->
      String -> Get Curve
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
        (String
"ECDH/X25519 secret key requires an ECDH public key packet, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         PKey -> String
forall a. Show a => a -> String
show PKey
other)

putSKey :: SKey -> Either String Put
putSKey :: SKey -> Either String Put
putSKey (RSAPrivateKey (RSA_PrivateKey (R.PrivateKey PublicKey
_ Integer
d Integer
p Integer
q Integer
_ Integer
_ Integer
_))) =
  case Integer -> Integer -> Maybe Integer
inverse Integer
q Integer
p of
    Just Integer
u ->
      Put -> Either String Put
forall a b. b -> Either a b
Right (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
d) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
p) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
q) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
u))
    Maybe Integer
Nothing ->
      String -> Either String Put
forall a b. a -> Either a b
Left
        String
"putSKey: invalid RSA key — q has no multiplicative inverse mod p (key is mathematically broken)"
putSKey (DSAPrivateKey (DSA_PrivateKey (D.PrivateKey Params
_ Integer
x))) =
  Put -> Either String Put
forall a b. b -> Either a b
Right (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
x))
putSKey (ElGamalPrivateKey Integer
x) =
  Put -> Either String Put
forall a b. b -> Either a b
Right (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
x))
putSKey (ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey Curve
_ Integer
d))) =
  Put -> Either String Put
forall a b. b -> Either a b
Right (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
d))
putSKey (ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey Curve
_ Integer
d))) =
  Put -> Either String Put
forall a b. b -> Either a b
Right (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI Integer
d))
putSKey (EdDSAPrivateKey EdSigningCurve
P.Ed25519 ByteString
sk) = Put -> Either String Put
forall a b. b -> Either a b
Right (ByteString -> Put
putByteString ByteString
sk)
putSKey (EdDSAPrivateKey EdSigningCurve
P.Ed448 ByteString
sk) = Put -> Either String Put
forall a b. b -> Either a b
Right (ByteString -> Put
putByteString ByteString
sk)
putSKey (X25519PrivateKey ByteString
sk) = Put -> Either String Put
forall a b. b -> Either a b
Right (ByteString -> Put
putByteString ByteString
sk)
putSKey (X448PrivateKey ByteString
sk) = Put -> Either String Put
forall a b. b -> Either a b
Right (ByteString -> Put
putByteString ByteString
sk)
putSKey (UnknownSKey ByteString
bs) = Put -> Either String Put
forall a b. b -> Either a b
Right (ByteString -> Put
putLazyByteString ByteString
bs)

putSKeyForPKPayload :: SomePKPayload -> SKey -> Either String Put
putSKeyForPKPayload :: SomePKPayload -> SKey -> Either String Put
putSKeyForPKPayload SomePKPayload
pkp sk :: SKey
sk@(EdDSAPrivateKey EdSigningCurve
_ ByteString
bs)
  | SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V6 = SKey -> Either String Put
putSKey SKey
sk
  | Bool
otherwise = Put -> Either String Put
forall a b. b -> Either a b
Right (MPI -> Put
forall t. Binary t => t -> Put
put (Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bs)))
putSKeyForPKPayload SomePKPayload
_ SKey
sk = SKey -> Either String Put
putSKey SKey
sk

putMPI :: MPI -> Put
putMPI :: MPI -> Put
putMPI (MPI Integer
i) = do
  let bs :: ByteString
bs = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
i
  Word16 -> Put
putWord16be (Word16 -> Put) -> (Integer -> Word16) -> Integer -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> (Integer -> Int) -> Integer -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
numBits (Integer -> Put) -> Integer -> Put
forall a b. (a -> b) -> a -> b
$ Integer
i
  ByteString -> Put
putByteString ByteString
bs

data PKPayloadReadCase where
  PKPayloadReadCaseV3 :: V3Expiration -> PubKeyAlgorithm -> PKPayloadReadCase
  PKPayloadReadCaseV4 :: PubKeyAlgorithm -> PKPayloadReadCase
  PKPayloadReadCaseV6 :: PubKeyAlgorithm -> PKPayloadReadCase

pkPayloadReadCase :: Word8 -> Get PKPayloadReadCase
pkPayloadReadCase :: Word8 -> Get PKPayloadReadCase
pkPayloadReadCase Word8
version =
  case Word8
version of
    Word8
2 -> do
      v3e <- Get Word16
getWord16be
      pka <- get
      pure (PKPayloadReadCaseV3 v3e pka)
    Word8
3 -> do
      v3e <- Get Word16
getWord16be
      pka <- get
      pure (PKPayloadReadCaseV3 v3e pka)
    Word8
4 -> PubKeyAlgorithm -> PKPayloadReadCase
PKPayloadReadCaseV4 (PubKeyAlgorithm -> PKPayloadReadCase)
-> Get PubKeyAlgorithm -> Get PKPayloadReadCase
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PubKeyAlgorithm
forall t. Binary t => Get t
get
    Word8
6 -> PubKeyAlgorithm -> PKPayloadReadCase
PKPayloadReadCaseV6 (PubKeyAlgorithm -> PKPayloadReadCase)
-> Get PubKeyAlgorithm -> Get PKPayloadReadCase
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PubKeyAlgorithm
forall t. Binary t => Get t
get
    Word8
_ -> String -> Get PKPayloadReadCase
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unsupported key packet version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
version)

getPKPayload :: Get SomePKPayload
getPKPayload :: Get SomePKPayload
getPKPayload = do
  version <- Get Word8
getWord8
  ctime <- fmap ThirtyTwoBitTimeStamp getWord32be
  readCase <- pkPayloadReadCase version
  case readCase of
    PKPayloadReadCaseV3 Word16
v3e PubKeyAlgorithm
pka -> do
      pk <- PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
pka
      pure $! PKPayload DeprecatedV3 ctime v3e pka pk
    PKPayloadReadCaseV4 PubKeyAlgorithm
pka -> do
      pk <- PubKeyAlgorithm -> Get PKey
getPubkey PubKeyAlgorithm
pka
      pure $! PKPayload V4 ctime 0 pka pk
    PKPayloadReadCaseV6 PubKeyAlgorithm
pka -> do
      pk <- PubKeyAlgorithm -> Get PKey
getPubkeyV6 PubKeyAlgorithm
pka
      pure $! PKPayload V6 ctime 0 pka pk

data PKPayloadWriteCase where
  PKPayloadWriteCaseV3 :: PKPayload 'DeprecatedV3 -> PKPayloadWriteCase
  PKPayloadWriteCaseV4 :: PKPayload 'V4 -> PKPayloadWriteCase
  PKPayloadWriteCaseV6 :: PKPayload 'V6 -> PKPayloadWriteCase

pkPayloadWriteCase :: SomePKPayload -> PKPayloadWriteCase
pkPayloadWriteCase :: SomePKPayload -> PKPayloadWriteCase
pkPayloadWriteCase (SomePKPayload PKPayload v
pkp) =
  case PKPayload v
pkp of
    PKPayloadV3 {} -> PKPayload 'DeprecatedV3 -> PKPayloadWriteCase
PKPayloadWriteCaseV3 PKPayload v
PKPayload 'DeprecatedV3
pkp
    PKPayloadV4 {} -> PKPayload 'V4 -> PKPayloadWriteCase
PKPayloadWriteCaseV4 PKPayload v
PKPayload 'V4
pkp
    PKPayloadV6 {} -> PKPayload 'V6 -> PKPayloadWriteCase
PKPayloadWriteCaseV6 PKPayload v
PKPayload 'V6
pkp

putPKPayload :: SomePKPayload -> Put
putPKPayload :: SomePKPayload -> Put
putPKPayload SomePKPayload
pkpSome =
  case SomePKPayload -> PKPayloadWriteCase
pkPayloadWriteCase SomePKPayload
pkpSome of
    PKPayloadWriteCaseV3 (PKPayloadV3 ThirtyTwoBitTimeStamp
ctime Word16
v3e PubKeyAlgorithm
pka PKey
pk) -> do
      Word8 -> Put
putWord8 Word8
3
      Word32 -> Put
putWord32be (Word32 -> Put)
-> (ThirtyTwoBitTimeStamp -> Word32)
-> ThirtyTwoBitTimeStamp
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp (ThirtyTwoBitTimeStamp -> Put) -> ThirtyTwoBitTimeStamp -> Put
forall a b. (a -> b) -> a -> b
$ ThirtyTwoBitTimeStamp
ctime
      Word16 -> Put
putWord16be Word16
v3e
      PubKeyAlgorithm -> Put
forall t. Binary t => t -> Put
put PubKeyAlgorithm
pka
      PKey -> Put
putPubkey PKey
pk
    PKPayloadWriteCaseV4 (PKPayloadV4 ThirtyTwoBitTimeStamp
ctime PubKeyAlgorithm
pka PKey
pk) -> do
      Word8 -> Put
putWord8 Word8
4
      Word32 -> Put
putWord32be (Word32 -> Put)
-> (ThirtyTwoBitTimeStamp -> Word32)
-> ThirtyTwoBitTimeStamp
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp (ThirtyTwoBitTimeStamp -> Put) -> ThirtyTwoBitTimeStamp -> Put
forall a b. (a -> b) -> a -> b
$ ThirtyTwoBitTimeStamp
ctime
      PubKeyAlgorithm -> Put
forall t. Binary t => t -> Put
put PubKeyAlgorithm
pka
      PubKeyAlgorithm -> PKey -> Put
putPubkeyV4ForAlgorithm PubKeyAlgorithm
pka PKey
pk
    PKPayloadWriteCaseV6 (PKPayloadV6 ThirtyTwoBitTimeStamp
ctime PubKeyAlgorithm
pka PKey
pk) -> do
      Word8 -> Put
putWord8 Word8
6
      Word32 -> Put
putWord32be (Word32 -> Put)
-> (ThirtyTwoBitTimeStamp -> Word32)
-> ThirtyTwoBitTimeStamp
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp (ThirtyTwoBitTimeStamp -> Put) -> ThirtyTwoBitTimeStamp -> Put
forall a b. (a -> b) -> a -> b
$ ThirtyTwoBitTimeStamp
ctime
      PubKeyAlgorithm -> Put
forall t. Binary t => t -> Put
put PubKeyAlgorithm
pka
      PKey -> Put
putPubkeyV6 PKey
pk

putPubkeyV4ForAlgorithm :: PubKeyAlgorithm -> PKey -> Put
putPubkeyV4ForAlgorithm :: PubKeyAlgorithm -> PKey -> Put
putPubkeyV4ForAlgorithm PubKeyAlgorithm
pka PKey
pk
  | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.Ed25519 = Int -> EdSigningCurve -> PKey -> Put
putPubkeyV4Fixed Int
32 EdSigningCurve
P.Ed25519 PKey
pk
  | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.Ed448 = Int -> EdSigningCurve -> PKey -> Put
putPubkeyV4Fixed Int
57 EdSigningCurve
P.Ed448 PKey
pk
  | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.X25519 = Int -> EdSigningCurve -> PKey -> Put
putPubkeyV4Fixed Int
32 EdSigningCurve
P.Ed25519 PKey
pk
  | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.X448 = Int -> EdSigningCurve -> PKey -> Put
putPubkeyV4Fixed Int
56 EdSigningCurve
P.Ed448 PKey
pk
  | Bool
otherwise = PKey -> Put
putPubkey PKey
pk

putPubkeyV4Fixed :: Int -> P.EdSigningCurve -> PKey -> Put
putPubkeyV4Fixed :: Int -> EdSigningCurve -> PKey -> Put
putPubkeyV4Fixed Int
targetLen EdSigningCurve
expectedCurve (EdDSAPubKey EdSigningCurve
curve (NativeEPoint (EPoint Integer
x)))
  | EdSigningCurve
curve EdSigningCurve -> EdSigningCurve -> Bool
forall a. Eq a => a -> a -> Bool
== EdSigningCurve
expectedCurve = ByteString -> Put
putByteString (Int -> Integer -> ByteString
fixedLengthOctets Int
targetLen Integer
x)
putPubkeyV4Fixed Int
_ EdSigningCurve
_ PKey
pk = PKey -> Put
putPubkey PKey
pk

getSKAddendum :: SomePKPayload -> Get SKAddendum
getSKAddendum :: SomePKPayload -> Get SKAddendum
getSKAddendum (SomePKPayload PKPayload v
pkp) =
  SKAddendumV v -> SKAddendum
forall (v :: KeyVersion). SKAddendumV v -> SKAddendum
toSKAddendum (SKAddendumV v -> SKAddendum)
-> Get (SKAddendumV v) -> Get SKAddendum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PKPayload v -> Get (SKAddendumV v)
forall (v :: KeyVersion). PKPayload v -> Get (SKAddendumV v)
getSKAddendumTyped PKPayload v
pkp

getSKAddendumTyped :: PKPayload v -> Get (SKAddendumV v)
getSKAddendumTyped :: forall (v :: KeyVersion). PKPayload v -> Get (SKAddendumV v)
getSKAddendumTyped PKPayload v
pkp = do
  s2kusage <- Get Word8
getWord8
  let pkpSome = PKPayload v -> SomePKPayload
forall (v :: KeyVersion). PKPayload v -> SomePKPayload
SomePKPayload PKPayload v
pkp
      getLegacyS2KProtected SymmetricAlgorithm -> S2K -> IV -> ByteString -> b
constructor = do
        symencWord <- Get Word8
getWord8
        s2k <- getS2K
        let symenc = Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
symencWord
        case s2k of
          OtherS2K Word8
_ ByteString
_ -> b -> Get b
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Get b) -> b -> Get b
forall a b. (a -> b) -> a -> b
$ SymmetricAlgorithm -> S2K -> IV -> ByteString -> b
constructor SymmetricAlgorithm
symenc S2K
s2k IV
forall a. Monoid a => a
mempty ByteString
BL.empty
          S2K
_ -> do
            blockSize <- (String -> Get Int)
-> (Int -> Get Int) -> Either String Int -> Get Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get Int
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Int -> Get Int
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SymmetricAlgorithm -> Either String Int
symEncBlockSize SymmetricAlgorithm
symenc)
            iv <- IV <$> getByteString blockSize
            encryptedblock <- getRemainingLazyByteString
            return $ constructor symenc s2k iv encryptedblock
  case s2kusage of
    Word8
0 ->
      case PKPayload v
pkp of
        PKPayloadV6 {} -> do
          sk <- SomePKPayload -> Get SKey
getSecretKey SomePKPayload
pkpSome
          return (SKAUnencryptedV6 sk)
        PKPayloadV3 {} -> do
          rest <- Get ByteString -> Get ByteString
forall a. Get a -> Get a
lookAhead Get ByteString
getRemainingLazyByteString
          secretLen <-
            case runGetOrFail
                   (do
                      start <- bytesRead
                      _ <- getSecretKey pkpSome
                      end <- bytesRead
                      pure (end - start))
                   rest of
              Left (ByteString
_, Int64
_, String
err) -> String -> Get Int64
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
              Right (ByteString
_, Int64
_, Int64
len) -> Int64 -> Get Int64
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
len
          sk <- getSecretKey pkpSome
          checksum <- getWord16be
          let expectedChecksum =
                ByteString -> Word16
checksum16Bytes (ByteString -> ByteString
BL.toStrict (Int64 -> ByteString -> ByteString
BL.take Int64
secretLen ByteString
rest))
          when (checksum /= expectedChecksum) $
            fail
              ("legacy unencrypted secret-key checksum mismatch: expected " ++
               show expectedChecksum ++ ", got " ++ show checksum)
          return (SKAUnencryptedLegacy sk checksum)
        PKPayloadV4 {} -> do
          rest <- Get ByteString -> Get ByteString
forall a. Get a -> Get a
lookAhead Get ByteString
getRemainingLazyByteString
          secretLen <-
            case runGetOrFail
                   (do
                      start <- bytesRead
                      _ <- getSecretKey pkpSome
                      end <- bytesRead
                      pure (end - start))
                   rest of
              Left (ByteString
_, Int64
_, String
err) -> String -> Get Int64
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
              Right (ByteString
_, Int64
_, Int64
len) -> Int64 -> Get Int64
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
len
          sk <- getSecretKey pkpSome
          checksum <- getWord16be
          let expectedChecksum =
                ByteString -> Word16
checksum16Bytes (ByteString -> ByteString
BL.toStrict (Int64 -> ByteString -> ByteString
BL.take Int64
secretLen ByteString
rest))
          when (checksum /= expectedChecksum) $
            fail
              ("legacy unencrypted secret-key checksum mismatch: expected " ++
               show expectedChecksum ++ ", got " ++ show checksum)
          return (SKAUnencryptedLegacy sk checksum)
    Word8
255 ->
      case PKPayload v
pkp of
        PKPayloadV6 {} ->
          String -> Get (SKAddendumV v)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"v6 secret key packets MUST NOT use s2k usage 255"
        PKPayloadV3 {} ->
          (SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v)
-> Get (SKAddendumV v)
forall {b}.
(SymmetricAlgorithm -> S2K -> IV -> ByteString -> b) -> Get b
getLegacyS2KProtected SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
SKA16bit
        PKPayloadV4 {} ->
          (SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v)
-> Get (SKAddendumV v)
forall {b}.
(SymmetricAlgorithm -> S2K -> IV -> ByteString -> b) -> Get b
getLegacyS2KProtected SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
SKA16bit
    Word8
254 ->
      case PKPayload v
pkp of
        PKPayloadV6 {} -> do
          paramsLen <- Get Word8
getWord8
          params <- getLazyByteString (fromIntegral paramsLen)
          (symenc, s2k, iv) <-
            case runGetOrFail getV6CFBParams params of
              Left (ByteString
_, Int64
_, String
err) -> String -> Get (SymmetricAlgorithm, S2K, ByteString)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
              Right (ByteString
rest, Int64
_, (SymmetricAlgorithm, S2K, ByteString)
parsed)
                | Bool -> Bool
not (ByteString -> Bool
BL.null ByteString
rest) -> String -> Get (SymmetricAlgorithm, S2K, ByteString)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected trailing v6 CFB parameters"
                | Bool
otherwise -> (SymmetricAlgorithm, S2K, ByteString)
-> Get (SymmetricAlgorithm, S2K, ByteString)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SymmetricAlgorithm, S2K, ByteString)
parsed
          encryptedblock <- getRemainingLazyByteString
          return (SKASHA1V6 symenc s2k (IV iv) encryptedblock)
        PKPayloadV3 {} ->
          (SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v)
-> Get (SKAddendumV v)
forall {b}.
(SymmetricAlgorithm -> S2K -> IV -> ByteString -> b) -> Get b
getLegacyS2KProtected SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
SKASHA1Legacy
        PKPayloadV4 {} ->
          (SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v)
-> Get (SKAddendumV v)
forall {b}.
(SymmetricAlgorithm -> S2K -> IV -> ByteString -> b) -> Get b
getLegacyS2KProtected SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
forall (v :: KeyVersion).
LegacyKeyVersion v =>
SymmetricAlgorithm -> S2K -> IV -> ByteString -> SKAddendumV v
SKASHA1Legacy
      where
        getV6CFBParams :: Get (SymmetricAlgorithm, S2K, ByteString)
getV6CFBParams = do
          symencWord <- Get Word8
getWord8
          s2kLen <- getWord8
          s2kBytes <- getLazyByteString (fromIntegral s2kLen)
          s2k <-
            case runGetOrFail getS2K s2kBytes of
              Left (ByteString
_, Int64
_, String
err) -> String -> Get S2K
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
              Right (ByteString
rest, Int64
_, S2K
parsed)
                | Bool -> Bool
not (ByteString -> Bool
BL.null ByteString
rest) -> String -> Get S2K
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected trailing bytes in v6 S2K specifier"
                | Bool
otherwise -> S2K -> Get S2K
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure S2K
parsed
          iv <- getRemainingLazyByteString
          let symenc = Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
symencWord
          blockSize <- either fail pure (symEncBlockSize symenc)
          when (BL.length iv /= fromIntegral blockSize) $
            fail "invalid v6 CFB IV length"
          pure (symenc, s2k, BL.toStrict iv)
    Word8
253 ->
      case PKPayload v
pkp of
        PKPayloadV6 {} -> do
          paramsLen <- Get Word8
getWord8
          params <- getLazyByteString (fromIntegral paramsLen)
          (symenc, aead, s2k, iv) <-
            case runGetOrFail getV6AEADParams params of
              Left (ByteString
_, Int64
_, String
err) -> String -> Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
              Right (ByteString
rest, Int64
_, (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
parsed)
                | Bool -> Bool
not (ByteString -> Bool
BL.null ByteString
rest) -> String -> Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected trailing v6 AEAD parameters"
                | Bool
otherwise -> (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
-> Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
parsed
          encryptedblock <- getRemainingLazyByteString
          return (SKAAEADV6 symenc aead s2k (IV iv) encryptedblock)
        PKPayloadV3 {} -> do
          (symenc, aead, s2k, iv) <- Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
getLegacyAEADParams
          encryptedblock <- getRemainingLazyByteString
          return (SKAAEADLegacy symenc aead s2k (IV iv) encryptedblock)
        PKPayloadV4 {} -> do
          (symenc, aead, s2k, iv) <- Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
getLegacyAEADParams
          encryptedblock <- getRemainingLazyByteString
          return (SKAAEADLegacy symenc aead s2k (IV iv) encryptedblock)
      where
        getV6AEADParams :: Get (SymmetricAlgorithm, AEADAlgorithm, S2K, B.ByteString)
        getV6AEADParams :: Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
getV6AEADParams = do
          symencWord <- Get Word8
getWord8
          aeadWord <- getWord8
          s2kLen <- getWord8
          s2kBytes <- getLazyByteString (fromIntegral s2kLen)
          s2k <-
            case runGetOrFail getS2K s2kBytes of
              Left (ByteString
_, Int64
_, String
err) -> String -> Get S2K
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
              Right (ByteString
rest, Int64
_, S2K
parsed)
                | Bool -> Bool
not (ByteString -> Bool
BL.null ByteString
rest) -> String -> Get S2K
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected trailing bytes in v6 S2K specifier"
                | Bool
otherwise -> S2K -> Get S2K
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure S2K
parsed
          iv <- getRemainingLazyByteString
          let symenc = Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
symencWord
              aead = Word8 -> AEADAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
aeadWord
          when (BL.length iv /= fromIntegral (aeadNonceSize aead)) $
            fail "invalid v6 AEAD IV length"
          pure (symenc, aead, s2k, BL.toStrict iv)
        -- v3/v4: no cumulative-params-length octet, no S2K-size octet
        getLegacyAEADParams :: Get (SymmetricAlgorithm, AEADAlgorithm, S2K, B.ByteString)
        getLegacyAEADParams :: Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
getLegacyAEADParams = do
          symencWord <- Get Word8
getWord8
          aeadWord <- getWord8
          s2k <- getS2K
          let aead = Word8 -> AEADAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
aeadWord
          iv <- BL.toStrict <$> getLazyByteString (fromIntegral (aeadNonceSize aead))
          pure (toFVal symencWord, aead, s2k, iv)
    Word8
symenc ->
      case PKPayload v
pkp of
        PKPayloadV6 {} -> do
          paramsLen <- Get Word8
getWord8
          iv <- getByteString (fromIntegral paramsLen)
          let symencAlg = Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
symenc
          blockSize <- either fail pure (symEncBlockSize symencAlg)
          when (B.length iv /= blockSize) $
            fail "invalid v6 CFB IV length"
          encryptedblock <- getRemainingLazyByteString
          return (SKASymV6 symencAlg (IV iv) encryptedblock)
        PKPayloadV3 {} -> do
          blockSize <- (String -> Get Int)
-> (Int -> Get Int) -> Either String Int -> Get Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get Int
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Int -> Get Int
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SymmetricAlgorithm -> Either String Int
symEncBlockSize (Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
symenc))
          iv <- getByteString blockSize
          encryptedblock <- getRemainingLazyByteString
          return (SKASymLegacy (toFVal symenc) (IV iv) encryptedblock)
        PKPayloadV4 {} -> do
          blockSize <- (String -> Get Int)
-> (Int -> Get Int) -> Either String Int -> Get Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get Int
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Int -> Get Int
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SymmetricAlgorithm -> Either String Int
symEncBlockSize (Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
symenc))
          iv <- getByteString blockSize
          encryptedblock <- getRemainingLazyByteString
          return (SKASymLegacy (toFVal symenc) (IV iv) encryptedblock)

putSKAddendum :: SKAddendum -> Either String Put
putSKAddendum :: SKAddendum -> Either String Put
putSKAddendum (SUS16bit SymmetricAlgorithm
symenc S2K
s2k IV
iv ByteString
encryptedblock) = 
  Put -> Either String Put
forall a b. b -> Either a b
Right (Put -> Either String Put) -> Put -> Either String Put
forall a b. (a -> b) -> a -> b
$ do
    Word8 -> Put
putWord8 Word8
255
    SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
symenc
    S2K -> Put
forall t. Binary t => t -> Put
put S2K
s2k
    ByteString -> Put
putByteString (IV -> ByteString
unIV IV
iv)
    ByteString -> Put
putLazyByteString ByteString
encryptedblock
putSKAddendum (SUSSHA1 SymmetricAlgorithm
symenc S2K
s2k IV
iv ByteString
encryptedblock) = 
  Put -> Either String Put
forall a b. b -> Either a b
Right (Put -> Either String Put) -> Put -> Either String Put
forall a b. (a -> b) -> a -> b
$ do
    Word8 -> Put
putWord8 Word8
254
    SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
symenc
    S2K -> Put
forall t. Binary t => t -> Put
put S2K
s2k
    ByteString -> Put
putByteString (IV -> ByteString
unIV IV
iv)
    ByteString -> Put
putLazyByteString ByteString
encryptedblock
putSKAddendum (SUSAEAD SymmetricAlgorithm
symenc AEADAlgorithm
aead S2K
s2k IV
iv ByteString
encryptedblock) = 
  Put -> Either String Put
forall a b. b -> Either a b
Right (Put -> Either String Put) -> Put -> Either String Put
forall a b. (a -> b) -> a -> b
$ do
    Word8 -> Put
putWord8 Word8
253
    SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
symenc
    Word8 -> Put
putWord8 (AEADAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal AEADAlgorithm
aead)
    S2K -> Put
forall t. Binary t => t -> Put
put S2K
s2k
    ByteString -> Put
putByteString (IV -> ByteString
unIV IV
iv)
    ByteString -> Put
putLazyByteString ByteString
encryptedblock
putSKAddendum (SUSym SymmetricAlgorithm
symenc IV
iv ByteString
encryptedblock) = 
  Put -> Either String Put
forall a b. b -> Either a b
Right (Put -> Either String Put) -> Put -> Either String Put
forall a b. (a -> b) -> a -> b
$ do
    SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
symenc
    ByteString -> Put
putByteString (IV -> ByteString
unIV IV
iv)
    ByteString -> Put
putLazyByteString ByteString
encryptedblock
putSKAddendum (SUUnencrypted SKey
sk Word16
checksum) = 
  do
    putSecret <- SKey -> Either String Put
putSKey SKey
sk
    Right $ do
      putWord8 0
      let skb = Put -> ByteString
runPut Put
putSecret
      putLazyByteString skb
      putWord16be
        (if checksum == 0
           then checksum16Bytes (BL.toStrict skb)
           else checksum)

checksum16Bytes :: B.ByteString -> Word16
checksum16Bytes :: ByteString -> Word16
checksum16Bytes =
  (Word16 -> Word8 -> Word16) -> Word16 -> ByteString -> Word16
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl'
    (\Word16
a Word8
b -> Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
65536 :: Integer)))
    Word16
0

putSKAddendumForPKPayload :: SomePKPayload -> SKAddendum -> Put
putSKAddendumForPKPayload :: SomePKPayload -> SKAddendum -> Put
putSKAddendumForPKPayload SomePKPayload
pkp SKAddendum
ska =
  case SomePKPayload -> SKAddendum -> Either String SomeSKAddendumV
fromSKAddendumForPKPayload SomePKPayload
pkp SKAddendum
ska of
    Left String
e -> String -> Put
forall a. HasCallStack => String -> a
error String
e
    Right (SomeSKAddendumV SKAddendumV v
skaV) ->
      SomePKPayload -> SKAddendumV v -> Put
forall (v :: KeyVersion). SomePKPayload -> SKAddendumV v -> Put
putSKAddendumForPKPayloadTyped SomePKPayload
pkp SKAddendumV v
skaV

putSKAddendumForPKPayloadTyped ::
     SomePKPayload
  -> SKAddendumV v
  -> Put
putSKAddendumForPKPayloadTyped :: forall (v :: KeyVersion). SomePKPayload -> SKAddendumV v -> Put
putSKAddendumForPKPayloadTyped SomePKPayload
pkp (SKAUnencryptedLegacy SKey
sk Word16
checksum) = do
  Word8 -> Put
putWord8 Word8
0
  let putSecret :: Put
putSecret =
        case SomePKPayload -> SKey -> Either String Put
putSKeyForPKPayload SomePKPayload
pkp SKey
sk of
          Left String
err -> String -> Put
forall a. HasCallStack => String -> a
error String
err
          Right Put
p -> Put
p
      skb :: ByteString
skb = Put -> ByteString
runPut Put
putSecret
  ByteString -> Put
putLazyByteString ByteString
skb
  Word16 -> Put
putWord16be
    (if Word16
checksum Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
       then (Word16 -> Word8 -> Word16) -> Word16 -> ByteString -> Word16
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BL.foldl (\Word16
a Word8
b -> Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
mod (Word16
a Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word16
0xffff) (Word16
0 :: Word16) ByteString
skb
       else Word16
checksum)
putSKAddendumForPKPayloadTyped SomePKPayload
pkp (SKAUnencryptedV6 SKey
sk) = do
  Word8 -> Put
putWord8 Word8
0
  let putSecret :: Put
putSecret =
        case SomePKPayload -> SKey -> Either String Put
putSKeyForPKPayload SomePKPayload
pkp SKey
sk of
          Left String
err -> String -> Put
forall a. HasCallStack => String -> a
error String
err
          Right Put
p -> Put
p
      skb :: ByteString
skb = Put -> ByteString
runPut Put
putSecret
  ByteString -> Put
putLazyByteString ByteString
skb
putSKAddendumForPKPayloadTyped SomePKPayload
_ (SKASHA1V6 SymmetricAlgorithm
symenc S2K
s2k IV
iv ByteString
encryptedblock) = do
  let s2kbs :: ByteString
s2kbs = Put -> ByteString
runPut (S2K -> Put
forall t. Binary t => t -> Put
put S2K
s2k)
      paramsLen :: Int64
paramsLen = Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
s2kbs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length (IV -> ByteString
unIV IV
iv))
  Word8 -> Put
putWord8 Word8
254
  Word8 -> Put
putWord8 (Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
paramsLen)
  SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
symenc
  Word8 -> Put
putWord8 (Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
s2kbs))
  ByteString -> Put
putLazyByteString ByteString
s2kbs
  ByteString -> Put
putByteString (IV -> ByteString
unIV IV
iv)
  ByteString -> Put
putLazyByteString ByteString
encryptedblock
putSKAddendumForPKPayloadTyped SomePKPayload
_ (SKAAEADV6 SymmetricAlgorithm
symenc AEADAlgorithm
aead S2K
s2k IV
iv ByteString
encryptedblock) = do
  let s2kbs :: ByteString
s2kbs = Put -> ByteString
runPut (S2K -> Put
forall t. Binary t => t -> Put
put S2K
s2k)
      paramsLen :: Int64
paramsLen = Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
BL.length ByteString
s2kbs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length (IV -> ByteString
unIV IV
iv))
  Word8 -> Put
putWord8 Word8
253
  Word8 -> Put
putWord8 (Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
paramsLen)
  SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
symenc
  Word8 -> Put
putWord8 (AEADAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal AEADAlgorithm
aead)
  Word8 -> Put
putWord8 (Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
s2kbs))
  ByteString -> Put
putLazyByteString ByteString
s2kbs
  ByteString -> Put
putByteString (IV -> ByteString
unIV IV
iv)
  ByteString -> Put
putLazyByteString ByteString
encryptedblock
putSKAddendumForPKPayloadTyped SomePKPayload
_ (SKAAEADLegacy SymmetricAlgorithm
symenc AEADAlgorithm
aead S2K
s2k IV
iv ByteString
encryptedblock) = do
  Word8 -> Put
putWord8 Word8
253
  SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
symenc
  Word8 -> Put
putWord8 (AEADAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal AEADAlgorithm
aead)
  S2K -> Put
forall t. Binary t => t -> Put
put S2K
s2k
  ByteString -> Put
putByteString (IV -> ByteString
unIV IV
iv)
  ByteString -> Put
putLazyByteString ByteString
encryptedblock
putSKAddendumForPKPayloadTyped SomePKPayload
_ (SKASymV6 SymmetricAlgorithm
symenc IV
iv ByteString
encryptedblock) = do
  Word8 -> Put
putWord8 (SymmetricAlgorithm -> Word8
forall a. FutureVal a => a -> Word8
fromFVal SymmetricAlgorithm
symenc)
  Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length (IV -> ByteString
unIV IV
iv)))
  ByteString -> Put
putByteString (IV -> ByteString
unIV IV
iv)
  ByteString -> Put
putLazyByteString ByteString
encryptedblock
putSKAddendumForPKPayloadTyped SomePKPayload
_ SKAddendumV v
skaV =
  case SKAddendum -> Either String Put
putSKAddendum (SKAddendumV v -> SKAddendum
forall (v :: KeyVersion). SKAddendumV v -> SKAddendum
toSKAddendum SKAddendumV v
skaV) of
    Left String
e -> String -> Put
forall a. HasCallStack => String -> a
error String
e
    Right Put
p -> Put
p

aeadNonceSize :: AEADAlgorithm -> Int
aeadNonceSize :: AEADAlgorithm -> Int
aeadNonceSize AEADAlgorithm
EAX = Int
16
aeadNonceSize AEADAlgorithm
OCB = Int
15
aeadNonceSize AEADAlgorithm
GCM = Int
12
aeadNonceSize (OtherAEADAlgo Word8
_) = Int
0

symEncBlockSize :: SymmetricAlgorithm -> Either String Int
symEncBlockSize :: SymmetricAlgorithm -> Either String Int
symEncBlockSize SymmetricAlgorithm
Plaintext = Int -> Either String Int
forall a b. b -> Either a b
Right Int
0
symEncBlockSize SymmetricAlgorithm
IDEA = Int -> Either String Int
forall a b. b -> Either a b
Right Int
8
symEncBlockSize SymmetricAlgorithm
TripleDES = Int -> Either String Int
forall a b. b -> Either a b
Right Int
8
symEncBlockSize SymmetricAlgorithm
CAST5 = Int -> Either String Int
forall a b. b -> Either a b
Right Int
8
symEncBlockSize SymmetricAlgorithm
Blowfish = Int -> Either String Int
forall a b. b -> Either a b
Right Int
8
symEncBlockSize SymmetricAlgorithm
AES128 = Int -> Either String Int
forall a b. b -> Either a b
Right Int
16
symEncBlockSize SymmetricAlgorithm
AES192 = Int -> Either String Int
forall a b. b -> Either a b
Right Int
16
symEncBlockSize SymmetricAlgorithm
AES256 = Int -> Either String Int
forall a b. b -> Either a b
Right Int
16
symEncBlockSize SymmetricAlgorithm
Twofish = Int -> Either String Int
forall a b. b -> Either a b
Right Int
16
symEncBlockSize SymmetricAlgorithm
Camellia128 = Int -> Either String Int
forall a b. b -> Either a b
Right Int
16
symEncBlockSize SymmetricAlgorithm
Camellia192 = Int -> Either String Int
forall a b. b -> Either a b
Right Int
16
symEncBlockSize SymmetricAlgorithm
Camellia256 = Int -> Either String Int
forall a b. b -> Either a b
Right Int
16
symEncBlockSize SymmetricAlgorithm
sa =
  String -> Either String Int
forall a b. a -> Either a b
Left (String
"unsupported symmetric algorithm for secret-key IV sizing: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SymmetricAlgorithm -> String
forall a. Show a => a -> String
show SymmetricAlgorithm
sa)

decodeIterationCount :: Word8 -> IterationCount
decodeIterationCount :: Word8 -> IterationCount
decodeIterationCount Word8
c =
  Int -> IterationCount
IterationCount
    ((Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15)) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` ((Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6))

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

getSignaturePayload :: Get SignaturePayload
getSignaturePayload :: Get SignaturePayload
getSignaturePayload = do
  pv <- Get Word8
getWord8
  case pv of
    Word8
3 -> do
      hashlen <- Get Word8
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 (ByteString
_, Int64
_, String
e) -> String -> Get SignaturePayload
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"v3 sig MPIs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e)
        Right (ByteString
_, Int64
_, [MPI]
mpis) ->
          SignaturePayload -> Get SignaturePayload
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SignaturePayload -> Get SignaturePayload)
-> SignaturePayload -> Get SignaturePayload
forall a b. (a -> b) -> a -> b
$
          SigType
-> ThirtyTwoBitTimeStamp
-> EightOctetKeyId
-> PubKeyAlgorithm
-> HashAlgorithm
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV3
            (Word8 -> SigType
forall a. FutureVal a => Word8 -> a
toFVal Word8
st)
            ThirtyTwoBitTimeStamp
ctime
            (ByteString -> EightOctetKeyId
EightOctetKeyId ByteString
eok)
            (Word8 -> PubKeyAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
pka)
            (Word8 -> HashAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
ha)
            Word16
left16
            ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [MPI]
mpis)
    Word8
4 -> do
      st <- Get Word8
getWord8
      pkaOctet <- get
      ha <- get
      let pka = Word8 -> PubKeyAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
pkaOctet :: PubKeyAlgorithm
      hlen <- getWord16be
      hb <- getLazyByteString (fromIntegral hlen)
      let hashed =
            case Get [SigSubPacket]
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, [SigSubPacket])
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Get SigSubPacket -> Get [SigSubPacket]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get SigSubPacket
getSigSubPacket) ByteString
hb of
              Left (ByteString
_, Int64
_, String
err) -> String -> [SigSubPacket]
forall a. String -> [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"v4 sig hasheds " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
              Right (ByteString
_, Int64
_, [SigSubPacket]
h) -> [SigSubPacket]
h
      ulen <- getWord16be
      ub <- getLazyByteString (fromIntegral ulen)
      let unhashed =
            case Get [SigSubPacket]
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, [SigSubPacket])
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Get SigSubPacket -> Get [SigSubPacket]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get SigSubPacket
getSigSubPacket) ByteString
ub of
              Left (ByteString
_, Int64
_, String
err) -> String -> [SigSubPacket]
forall a. String -> [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"v4 sig unhasheds " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
              Right (ByteString
_, Int64
_, [SigSubPacket]
u) -> [SigSubPacket]
u
      left16 <- getWord16be
      mpib <- getRemainingLazyByteString
      let parseV4MPIs String
parseErrPrefix =
            case Get [MPI]
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, [MPI])
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Get MPI -> Get [MPI]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Get MPI
getMPI) ByteString
mpib of
              Left (ByteString
_, Int64
_, String
e) -> String -> Get SignaturePayload
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
parseErrPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e)
              Right (ByteString
_, Int64
_, [MPI]
mpis) ->
                SignaturePayload -> Get SignaturePayload
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SignaturePayload -> Get SignaturePayload)
-> SignaturePayload -> Get SignaturePayload
forall a b. (a -> b) -> a -> b
$
                SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
                  (Word8 -> SigType
forall a. FutureVal a => Word8 -> a
toFVal Word8
st)
                  PubKeyAlgorithm
pka
                  (Word8 -> HashAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
ha)
                  [SigSubPacket]
hashed
                  [SigSubPacket]
unhashed
                  Word16
left16
                  ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [MPI]
mpis)
      if pka == BTypes.Ed25519
        then
          if BL.length mpib == 64
            then do
              let sig = ByteString -> ByteString
BL.toStrict ByteString
mpib
                  (rbs, sbs) = B.splitAt 32 sig
              return $
                SigV4
                  (toFVal st)
                  pka
                  (toFVal ha)
                  hashed
                  unhashed
                  left16
                  (NE.fromList [MPI (os2ip rbs), MPI (os2ip sbs)])
            else parseV4MPIs "v4 Ed25519 legacy MPIs "
        else
          if pka == BTypes.Ed448
            then
              if BL.length mpib == 114
                then do
                  let sig = ByteString -> ByteString
BL.toStrict ByteString
mpib
                      (rbs, sbs) = B.splitAt 57 sig
                  return $
                    SigV4
                      (toFVal st)
                      pka
                      (toFVal ha)
                      hashed
                      unhashed
                      left16
                      (NE.fromList [MPI (os2ip rbs), MPI (os2ip sbs)])
                else parseV4MPIs "v4 Ed448 legacy MPIs "
            else parseV4MPIs "v4 sig MPIs "
    Word8
6 -> do
      st <- Get Word8
getWord8
      pka <- get
      ha <- get
      hlen <- getWord32be
      hb <- getLazyByteString (fromIntegral hlen)
      let hashed =
            case Get [SigSubPacket]
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, [SigSubPacket])
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Get SigSubPacket -> Get [SigSubPacket]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get SigSubPacket
getSigSubPacket) ByteString
hb of
              Left (ByteString
_, Int64
_, String
err) -> String -> [SigSubPacket]
forall a. String -> [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"v6 sig hasheds " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
              Right (ByteString
_, Int64
_, [SigSubPacket]
h) -> [SigSubPacket]
h
      ulen <- getWord32be
      ub <- getLazyByteString (fromIntegral ulen)
      let unhashed =
            case Get [SigSubPacket]
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, [SigSubPacket])
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Get SigSubPacket -> Get [SigSubPacket]
forall a. Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get SigSubPacket
getSigSubPacket) ByteString
ub of
              Left (ByteString
_, Int64
_, String
err) -> String -> [SigSubPacket]
forall a. String -> [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"v6 sig unhasheds " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
              Right (ByteString
_, Int64
_, [SigSubPacket]
u) -> [SigSubPacket]
u
      left16 <- getWord16be
      saltSize <- getWord8
      let haVal = (Word8 -> HashAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
ha :: HashAlgorithm)
      expectedSaltSize <-
        maybe
          (fail ("signature hash algorithm does not define a V6 salt size: " ++ show haVal))
          pure
          (v6SaltSizeForHashAlgorithm haVal)
      when (saltSize /= expectedSaltSize) $
        fail
          ("v6 signature salt size mismatch for " ++
           show haVal ++ ": expected " ++ show expectedSaltSize ++ ", got " ++ show saltSize)
      saltbs <- getByteString (fromIntegral saltSize)
      let salt = ByteString -> SignatureSalt
SignatureSalt (ByteString -> ByteString
BL.fromStrict ByteString
saltbs)
      if pka == BTypes.Ed25519
        then do
          sig <- getByteString 64
          let (rbs, sbs) = B.splitAt 32 sig
              mpis = [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
rbs), Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
sbs)]
          return $
            SigV6
              (toFVal st)
              pka
              (toFVal ha)
              salt
              hashed
              unhashed
              left16
              (NE.fromList mpis)
        else
          if pka == BTypes.Ed448
            then do
              sig <- getByteString 114
              let (rbs, sbs) = B.splitAt 57 sig
                  mpis = [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
rbs), Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
sbs)]
              return $
                SigV6
                  (toFVal st)
                  pka
                  (toFVal ha)
                  salt
                  hashed
                  unhashed
                  left16
                  (NE.fromList mpis)
            else do
              mpib <- getRemainingLazyByteString
              case runGetOrFail (some getMPI) mpib of
                Left (ByteString
_, Int64
_, String
e) -> String -> Get SignaturePayload
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"v6 sig MPIs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e)
                Right (ByteString
_, Int64
_, [MPI]
mpis) ->
                  SignaturePayload -> Get SignaturePayload
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SignaturePayload -> Get SignaturePayload)
-> SignaturePayload -> Get SignaturePayload
forall a b. (a -> b) -> a -> b
$
                  SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> SignatureSalt
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV6
                    (Word8 -> SigType
forall a. FutureVal a => Word8 -> a
toFVal Word8
st)
                    PubKeyAlgorithm
pka
                    (Word8 -> HashAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal Word8
ha)
                    SignatureSalt
salt
                    [SigSubPacket]
hashed
                    [SigSubPacket]
unhashed
                    Word16
left16
                    ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [MPI]
mpis)
    Word8
_ -> do
      bs <- Get ByteString
getRemainingLazyByteString
      return $ SigVOther pv bs

putSignaturePayload :: SignaturePayload -> Put
putSignaturePayload :: SignaturePayload -> Put
putSignaturePayload (SigV3 SigType
st ThirtyTwoBitTimeStamp
ctime EightOctetKeyId
eok PubKeyAlgorithm
pka HashAlgorithm
ha Word16
left16 NonEmpty MPI
mpis) = do
  Word8 -> Put
putWord8 Word8
3
  Word8 -> Put
putWord8 Word8
5 -- hashlen
  SigType -> Put
forall t. Binary t => t -> Put
put SigType
st
  Word32 -> Put
putWord32be (Word32 -> Put)
-> (ThirtyTwoBitTimeStamp -> Word32)
-> ThirtyTwoBitTimeStamp
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> Word32
unThirtyTwoBitTimeStamp (ThirtyTwoBitTimeStamp -> Put) -> ThirtyTwoBitTimeStamp -> Put
forall a b. (a -> b) -> a -> b
$ ThirtyTwoBitTimeStamp
ctime
  ByteString -> Put
putLazyByteString (EightOctetKeyId -> ByteString
unEOKI EightOctetKeyId
eok)
  PubKeyAlgorithm -> Put
forall t. Binary t => t -> Put
put PubKeyAlgorithm
pka
  HashAlgorithm -> Put
forall t. Binary t => t -> Put
put HashAlgorithm
ha
  Word16 -> Put
putWord16be Word16
left16
  (MPI -> Put) -> NonEmpty MPI -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ MPI -> Put
forall t. Binary t => t -> Put
put NonEmpty MPI
mpis
putSignaturePayload (SigV4 SigType
st PubKeyAlgorithm
pka HashAlgorithm
ha [SigSubPacket]
hashed [SigSubPacket]
unhashed Word16
left16 NonEmpty MPI
mpis) = do
  Word8 -> Put
putWord8 Word8
4
  SigType -> Put
forall t. Binary t => t -> Put
put SigType
st
  PubKeyAlgorithm -> Put
forall t. Binary t => t -> Put
put PubKeyAlgorithm
pka
  HashAlgorithm -> Put
forall t. Binary t => t -> Put
put HashAlgorithm
ha
  let hb :: ByteString
hb = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (SigSubPacket -> Put) -> [SigSubPacket] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SigSubPacket -> Put
forall t. Binary t => t -> Put
put [SigSubPacket]
hashed
  Word16 -> Put
putWord16be (Word16 -> Put) -> (ByteString -> Word16) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> (ByteString -> Int64) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
hb
  ByteString -> Put
putLazyByteString ByteString
hb
  let ub :: ByteString
ub = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (SigSubPacket -> Put) -> [SigSubPacket] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SigSubPacket -> Put
forall t. Binary t => t -> Put
put [SigSubPacket]
unhashed
  Word16 -> Put
putWord16be (Word16 -> Put) -> (ByteString -> Word16) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> (ByteString -> Int64) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
ub
  ByteString -> Put
putLazyByteString ByteString
ub
  Word16 -> Put
putWord16be Word16
left16
  if PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.Ed25519
    then
      case NonEmpty MPI -> [MPI]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty MPI
mpis of
        [MPI Integer
r, MPI Integer
s] -> do
          ByteString -> Put
putByteString (Int -> Integer -> ByteString
padN Int
32 Integer
r)
          ByteString -> Put
putByteString (Int -> Integer -> ByteString
padN Int
32 Integer
s)
        [MPI]
_ -> String -> Put
forall a. HasCallStack => String -> a
error String
"Ed25519 v4 signatures must have two MPIs"
    else
      if PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.Ed448
        then
          case NonEmpty MPI -> [MPI]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty MPI
mpis of
            [MPI Integer
r, MPI Integer
s] -> do
              ByteString -> Put
putByteString (Int -> Integer -> ByteString
padN Int
57 Integer
r)
              ByteString -> Put
putByteString (Int -> Integer -> ByteString
padN Int
57 Integer
s)
            [MPI]
_ -> String -> Put
forall a. HasCallStack => String -> a
error String
"Ed448 v4 signatures must have two MPIs"
        else (MPI -> Put) -> NonEmpty MPI -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ MPI -> Put
forall t. Binary t => t -> Put
put NonEmpty MPI
mpis
  where
    padN :: Int -> Integer -> ByteString
padN Int
n Integer
i =
      let bs :: ByteString
bs = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
i
       in Int -> Word8 -> ByteString
B.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bs)) Word8
0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
putSignaturePayload (SigV6 SigType
st PubKeyAlgorithm
pka HashAlgorithm
ha SignatureSalt
salt [SigSubPacket]
hashed [SigSubPacket]
unhashed Word16
left16 NonEmpty MPI
mpis) = do
  let expectedSaltSize :: Word8
expectedSaltSize =
        Word8 -> (Word8 -> Word8) -> Maybe Word8 -> Word8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (String -> Word8
forall a. HasCallStack => String -> a
error (String
"signature hash algorithm does not define a V6 salt size: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha))
          Word8 -> Word8
forall a. a -> a
id
          (HashAlgorithm -> Maybe Word8
v6SaltSizeForHashAlgorithm HashAlgorithm
ha)
      actualSaltSize :: Word8
actualSaltSize = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length (SignatureSalt -> ByteString
unSignatureSalt SignatureSalt
salt))
  Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
actualSaltSize Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
expectedSaltSize) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
    String -> Put
forall a. HasCallStack => String -> a
error
      (String
"v6 signature salt size mismatch for " String -> String -> String
forall a. [a] -> [a] -> [a]
++
       HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
expectedSaltSize String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
actualSaltSize)
  Word8 -> Put
putWord8 Word8
6
  SigType -> Put
forall t. Binary t => t -> Put
put SigType
st
  PubKeyAlgorithm -> Put
forall t. Binary t => t -> Put
put PubKeyAlgorithm
pka
  HashAlgorithm -> Put
forall t. Binary t => t -> Put
put HashAlgorithm
ha
  let hb :: ByteString
hb = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (SigSubPacket -> Put) -> [SigSubPacket] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SigSubPacket -> Put
forall t. Binary t => t -> Put
put [SigSubPacket]
hashed
  Word32 -> Put
putWord32be (Word32 -> Put) -> (ByteString -> Word32) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> (ByteString -> Int64) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
hb
  ByteString -> Put
putLazyByteString ByteString
hb
  let ub :: ByteString
ub = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (SigSubPacket -> Put) -> [SigSubPacket] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SigSubPacket -> Put
forall t. Binary t => t -> Put
put [SigSubPacket]
unhashed
  Word32 -> Put
putWord32be (Word32 -> Put) -> (ByteString -> Word32) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> (ByteString -> Int64) -> ByteString -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ByteString
ub
  ByteString -> Put
putLazyByteString ByteString
ub
  Word16 -> Put
putWord16be Word16
left16
  Word8 -> Put
putWord8 (Word8 -> Put) -> (SignatureSalt -> Word8) -> SignatureSalt -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word8)
-> (SignatureSalt -> Int64) -> SignatureSalt -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Int64)
-> (SignatureSalt -> ByteString) -> SignatureSalt -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignatureSalt -> ByteString
unSignatureSalt (SignatureSalt -> Put) -> SignatureSalt -> Put
forall a b. (a -> b) -> a -> b
$ SignatureSalt
salt
  ByteString -> Put
putByteString (ByteString -> ByteString
BL.toStrict (SignatureSalt -> ByteString
unSignatureSalt SignatureSalt
salt))
  if PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.Ed25519
    then
      case NonEmpty MPI -> [MPI]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty MPI
mpis of
        [MPI Integer
r, MPI Integer
s] -> do
          ByteString -> Put
putByteString (Int -> Integer -> ByteString
padN Int
32 Integer
r)
          ByteString -> Put
putByteString (Int -> Integer -> ByteString
padN Int
32 Integer
s)
        [MPI]
_ -> String -> Put
forall a. HasCallStack => String -> a
error String
"Ed25519 v6 signatures must have two MPIs"
    else
      if PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
BTypes.Ed448
        then
          case NonEmpty MPI -> [MPI]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty MPI
mpis of
            [MPI Integer
r, MPI Integer
s] -> do
              ByteString -> Put
putByteString (Int -> Integer -> ByteString
padN Int
57 Integer
r)
              ByteString -> Put
putByteString (Int -> Integer -> ByteString
padN Int
57 Integer
s)
            [MPI]
_ -> String -> Put
forall a. HasCallStack => String -> a
error String
"Ed448 v6 signatures must have two MPIs"
        else (MPI -> Put) -> NonEmpty MPI -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ MPI -> Put
forall t. Binary t => t -> Put
put NonEmpty MPI
mpis
  where
    padN :: Int -> Integer -> ByteString
padN Int
n Integer
i =
      let bs :: ByteString
bs = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
i
       in Int -> Word8 -> ByteString
B.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bs)) Word8
0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
putSignaturePayload (SigVOther Word8
pv ByteString
bs) = do
  Word8 -> Put
putWord8 Word8
pv
  ByteString -> Put
putLazyByteString ByteString
bs

putTK :: TKUnknown -> Put
putTK :: TKUnknown -> Put
putTK TKUnknown
tk = do
  let pkp :: SomePKPayload
pkp = TKUnknown
tk TKUnknown
-> Getting SomePKPayload TKUnknown SomePKPayload -> SomePKPayload
forall s a. s -> Getting a s a -> a
^. ((SomePKPayload, Maybe SKAddendum)
 -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> TKUnknown -> Const SomePKPayload TKUnknown
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey (((SomePKPayload, Maybe SKAddendum)
  -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
 -> TKUnknown -> Const SomePKPayload TKUnknown)
-> ((SomePKPayload -> Const SomePKPayload SomePKPayload)
    -> (SomePKPayload, Maybe SKAddendum)
    -> Const SomePKPayload (SomePKPayload, Maybe SKAddendum))
-> Getting SomePKPayload TKUnknown SomePKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePKPayload -> Const SomePKPayload SomePKPayload)
-> (SomePKPayload, Maybe SKAddendum)
-> Const SomePKPayload (SomePKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (SomePKPayload, Maybe SKAddendum)
  (SomePKPayload, Maybe SKAddendum)
  SomePKPayload
  SomePKPayload
_1
  Put -> (SKAddendum -> Put) -> Maybe SKAddendum -> Put
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (PublicKey -> Put
forall t. Binary t => t -> Put
put (SomePKPayload -> PublicKey
PublicKey SomePKPayload
pkp))
    (\SKAddendum
ska -> SecretKey -> Put
forall t. Binary t => t -> Put
put (SomePKPayload -> SKAddendum -> SecretKey
SecretKey SomePKPayload
pkp SKAddendum
ska))
    ((SomePKPayload, Maybe SKAddendum) -> Maybe SKAddendum
forall a b. (a, b) -> b
snd (TKUnknown
tk TKUnknown
-> Getting
     (SomePKPayload, Maybe SKAddendum)
     TKUnknown
     (SomePKPayload, Maybe SKAddendum)
-> (SomePKPayload, Maybe SKAddendum)
forall s a. s -> Getting a s a -> a
^. Getting
  (SomePKPayload, Maybe SKAddendum)
  TKUnknown
  (SomePKPayload, Maybe SKAddendum)
Lens' TKUnknown (SomePKPayload, Maybe SKAddendum)
tkuKey))
  (SignaturePayload -> Put) -> [SignaturePayload] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Signature -> Put
forall t. Binary t => t -> Put
put (Signature -> Put)
-> (SignaturePayload -> Signature) -> SignaturePayload -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Signature
Signature) (TKUnknown -> [SignaturePayload]
_tkuRevs TKUnknown
tk)
  ((Text, [SignaturePayload]) -> Put)
-> [(Text, [SignaturePayload])] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, [SignaturePayload]) -> Put
forall {t :: * -> *}.
Foldable t =>
(Text, t SignaturePayload) -> Put
putUid' (TKUnknown -> [(Text, [SignaturePayload])]
_tkuUIDs TKUnknown
tk)
  (([UserAttrSubPacket], [SignaturePayload]) -> Put)
-> [([UserAttrSubPacket], [SignaturePayload])] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([UserAttrSubPacket], [SignaturePayload]) -> Put
forall {t :: * -> *}.
Foldable t =>
([UserAttrSubPacket], t SignaturePayload) -> Put
putUat' (TKUnknown -> [([UserAttrSubPacket], [SignaturePayload])]
_tkuUAts TKUnknown
tk)
  ((Pkt, [SignaturePayload]) -> Put)
-> [(Pkt, [SignaturePayload])] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Pkt, [SignaturePayload]) -> Put
forall {t} {t :: * -> *}.
(Binary t, Foldable t) =>
(t, t SignaturePayload) -> Put
putSub' (TKUnknown -> [(Pkt, [SignaturePayload])]
_tkuSubs TKUnknown
tk)
  where
    putUid' :: (Text, t SignaturePayload) -> Put
putUid' (Text
u, t SignaturePayload
sps) = UserId -> Put
forall t. Binary t => t -> Put
put (Text -> UserId
UserId Text
u) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (SignaturePayload -> Put) -> t SignaturePayload -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Signature -> Put
forall t. Binary t => t -> Put
put (Signature -> Put)
-> (SignaturePayload -> Signature) -> SignaturePayload -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Signature
Signature) t SignaturePayload
sps
    putUat' :: ([UserAttrSubPacket], t SignaturePayload) -> Put
putUat' ([UserAttrSubPacket]
us, t SignaturePayload
sps) = UserAttribute -> Put
forall t. Binary t => t -> Put
put ([UserAttrSubPacket] -> UserAttribute
UserAttribute [UserAttrSubPacket]
us) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (SignaturePayload -> Put) -> t SignaturePayload -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Signature -> Put
forall t. Binary t => t -> Put
put (Signature -> Put)
-> (SignaturePayload -> Signature) -> SignaturePayload -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Signature
Signature) t SignaturePayload
sps
    putSub' :: (t, t SignaturePayload) -> Put
putSub' (t
p, t SignaturePayload
sps) = t -> Put
forall t. Binary t => t -> Put
put t
p Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (SignaturePayload -> Put) -> t SignaturePayload -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Signature -> Put
forall t. Binary t => t -> Put
put (Signature -> Put)
-> (SignaturePayload -> Signature) -> SignaturePayload -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Signature
Signature) t SignaturePayload
sps

-- | Parse the packets from a ByteString, with no error reporting
parsePkts :: ByteString -> [Pkt]
parsePkts :: ByteString -> [Pkt]
parsePkts = [Pkt] -> [Pkt]
forall a. [a] -> [a]
reverse ([Pkt] -> [Pkt]) -> (ByteString -> [Pkt]) -> ByteString -> [Pkt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Pkt], Maybe PktParseError) -> [Pkt]
forall a b. (a, b) -> a
fst (([Pkt], Maybe PktParseError) -> [Pkt])
-> (ByteString -> ([Pkt], Maybe PktParseError))
-> ByteString
-> [Pkt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> [Pkt] -> ByteString -> ([Pkt], Maybe PktParseError)
parsePktsAccum Int64
0 []

-- | Parse packets from a ByteString and report the first parse failure.
parsePktsEither :: ByteString -> Either PktParseError [Pkt]
parsePktsEither :: ByteString -> Either PktParseError [Pkt]
parsePktsEither ByteString
lbs =
  case Int64 -> [Pkt] -> ByteString -> ([Pkt], Maybe PktParseError)
parsePktsAccum Int64
0 [] ByteString
lbs of
    ([Pkt]
pkts, Maybe PktParseError
Nothing) -> [Pkt] -> Either PktParseError [Pkt]
forall a b. b -> Either a b
Right ([Pkt] -> [Pkt]
forall a. [a] -> [a]
reverse [Pkt]
pkts)
    ([Pkt]
_, Just PktParseError
err) -> PktParseError -> Either PktParseError [Pkt]
forall a b. a -> Either a b
Left PktParseError
err

data PktParseError =
  PktParseError
    { PktParseError -> Int64
pktParseErrorOffset :: Int64
    , PktParseError -> String
pktParseErrorMessage :: String
    }
  deriving (PktParseError -> PktParseError -> Bool
(PktParseError -> PktParseError -> Bool)
-> (PktParseError -> PktParseError -> Bool) -> Eq PktParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PktParseError -> PktParseError -> Bool
== :: PktParseError -> PktParseError -> Bool
$c/= :: PktParseError -> PktParseError -> Bool
/= :: PktParseError -> PktParseError -> Bool
Eq, Int -> PktParseError -> String -> String
[PktParseError] -> String -> String
PktParseError -> String
(Int -> PktParseError -> String -> String)
-> (PktParseError -> String)
-> ([PktParseError] -> String -> String)
-> Show PktParseError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PktParseError -> String -> String
showsPrec :: Int -> PktParseError -> String -> String
$cshow :: PktParseError -> String
show :: PktParseError -> String
$cshowList :: [PktParseError] -> String -> String
showList :: [PktParseError] -> String -> String
Show)

parsePktsAccum ::
     Int64 -> [Pkt] -> ByteString -> ([Pkt], Maybe PktParseError)
parsePktsAccum :: Int64 -> [Pkt] -> ByteString -> ([Pkt], Maybe PktParseError)
parsePktsAccum Int64
offset [Pkt]
acc ByteString
lbs
  | ByteString -> Bool
BL.null ByteString
lbs = ([Pkt]
acc, Maybe PktParseError
forall a. Maybe a
Nothing)
  | Bool
otherwise =
      case Get Pkt
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get Pkt
getPkt ByteString
lbs of
        Left (ByteString
_, Int64
parseOffset, String
msg) -> ([Pkt]
acc, Int64 -> String -> Maybe PktParseError
err Int64
parseOffset String
msg)
        Right (ByteString
rest, Int64
consumed, Pkt
pkt) ->
          Int64 -> [Pkt] -> ByteString -> ([Pkt], Maybe PktParseError)
parsePktsAccum (Int64
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
consumed) (Pkt
pkt Pkt -> [Pkt] -> [Pkt]
forall a. a -> [a] -> [a]
: [Pkt]
acc) ByteString
rest
  where
    err :: Int64 -> String -> Maybe PktParseError
err Int64
parseOffset String
msg =
      PktParseError -> Maybe PktParseError
forall a. a -> Maybe a
Just
        PktParseError
          { pktParseErrorOffset :: Int64
pktParseErrorOffset = Int64
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
parseOffset
          , pktParseErrorMessage :: String
pktParseErrorMessage = String
msg
          }

armorPayloads :: [Armor] -> [ByteString]
armorPayloads :: [Armor] -> [ByteString]
armorPayloads =
  (Armor -> [ByteString] -> [ByteString])
-> [ByteString] -> [Armor] -> [ByteString]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Armor -> [ByteString] -> [ByteString]
collect []
  where
    collect :: Armor -> [ByteString] -> [ByteString]
collect (Armor ArmorType
_ [(String, String)]
_ ByteString
payload) = (ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString
BLC8.toStrict ByteString
payload) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)
    collect (ClearSigned [(String, String)]
_ ByteString
_ Armor
inner) = ([Armor] -> [ByteString]
armorPayloads [Armor
inner] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++)

looksLikeAsciiArmor :: ByteString -> Bool
looksLikeAsciiArmor :: ByteString -> Bool
looksLikeAsciiArmor =
  (ByteString
armorHeaderLazy ByteString -> ByteString -> Bool
`BL.isPrefixOf`) (ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
BL.dropWhile Word8 -> Bool
isLeadingArmorWhitespace

looksLikeAsciiArmorLenient :: ByteString -> Bool
looksLikeAsciiArmorLenient :: ByteString -> Bool
looksLikeAsciiArmorLenient = ByteString -> Bool
looksLikeAsciiArmor (ByteString -> Bool)
-> (ByteString -> ByteString) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
stripUtf8Bom

armorPayloadsOfType :: ArmorType -> [Armor] -> [ByteString]
armorPayloadsOfType :: ArmorType -> [Armor] -> [ByteString]
armorPayloadsOfType ArmorType
atype =
  (Armor -> [ByteString] -> [ByteString])
-> [ByteString] -> [Armor] -> [ByteString]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Armor -> [ByteString] -> [ByteString]
collect []
  where
    collect :: Armor -> [ByteString] -> [ByteString]
collect (Armor ArmorType
innerType [(String, String)]
_ ByteString
payload)
      | ArmorType
innerType ArmorType -> ArmorType -> Bool
forall a. Eq a => a -> a -> Bool
== ArmorType
atype = (ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString
BLC8.toStrict ByteString
payload) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)
      | Bool
otherwise = [ByteString] -> [ByteString]
forall a. a -> a
id
    collect (ClearSigned [(String, String)]
_ ByteString
_ Armor
inner) = (ArmorType -> [Armor] -> [ByteString]
armorPayloadsOfType ArmorType
atype [Armor
inner] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++)

singleArmorPayloadOfType :: ArmorType -> [Armor] -> Either String ByteString
singleArmorPayloadOfType :: ArmorType -> [Armor] -> Either String ByteString
singleArmorPayloadOfType ArmorType
atype [Armor]
armors =
  case ArmorType -> [Armor] -> [ByteString]
armorPayloadsOfType ArmorType
atype [Armor]
armors of
    [ByteString
payload] -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
payload
    [] -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String
"ASCII armor decode returned no " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ArmorType -> String
forall a. Show a => a -> String
show ArmorType
atype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" blocks")
    [ByteString]
payloads ->
      String -> Either String ByteString
forall a b. a -> Either a b
Left
        (String
"ASCII armor decode returned " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         Int -> String
forall a. Show a => a -> String
show ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
payloads) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ArmorType -> String
forall a. Show a => a -> String
show ArmorType
atype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" blocks (expected exactly one)")

singleClearSignedBlock ::
     [Armor] -> Either String ([(String, String)], ByteString, ByteString)
singleClearSignedBlock :: [Armor]
-> Either String ([(String, String)], ByteString, ByteString)
singleClearSignedBlock [Armor]
armors =
  case [Armor -> Either String ([(String, String)], ByteString, ByteString)
clearSignedBlockFromArmor Armor
armor | armor :: Armor
armor@ClearSigned {} <- [Armor]
armors] of
    [Right ([(String, String)], ByteString, ByteString)
clearSigned] -> ([(String, String)], ByteString, ByteString)
-> Either String ([(String, String)], ByteString, ByteString)
forall a b. b -> Either a b
Right ([(String, String)], ByteString, ByteString)
clearSigned
    [Left String
err] -> String
-> Either String ([(String, String)], ByteString, ByteString)
forall a b. a -> Either a b
Left String
err
    [] -> String
-> Either String ([(String, String)], ByteString, ByteString)
forall a b. a -> Either a b
Left String
"ASCII armor decode returned no clear-signed blocks"
    [Either String ([(String, String)], ByteString, ByteString)]
clearSigneds ->
      String
-> Either String ([(String, String)], ByteString, ByteString)
forall a b. a -> Either a b
Left
        (String
"ASCII armor decode returned " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         Int -> String
forall a. Show a => a -> String
show ([Either String ([(String, String)], ByteString, ByteString)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Either String ([(String, String)], ByteString, ByteString)]
clearSigneds) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" clear-signed blocks (expected exactly one)")
  where
    clearSignedBlockFromArmor :: Armor -> Either String ([(String, String)], ByteString, ByteString)
clearSignedBlockFromArmor (ClearSigned [(String, String)]
hs ByteString
cleartext Armor
inner) =
      case Armor
inner of
        Armor ArmorType
ArmorSignature [(String, String)]
_ ByteString
sig ->
          ([(String, String)], ByteString, ByteString)
-> Either String ([(String, String)], ByteString, ByteString)
forall a b. b -> Either a b
Right
            ( [(String, String)]
hs
            , ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString
BLC8.toStrict ByteString
cleartext)
            , ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString
BLC8.toStrict ByteString
sig)
            )
        Armor ArmorType
atype [(String, String)]
_ ByteString
_ ->
          String
-> Either String ([(String, String)], ByteString, ByteString)
forall a b. a -> Either a b
Left
            (String
"clear-signed block contained inner armor type " String -> String -> String
forall a. [a] -> [a] -> [a]
++
             ArmorType -> String
forall a. Show a => a -> String
show ArmorType
atype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (expected ArmorSignature)")
        ClearSigned {} ->
          String
-> Either String ([(String, String)], ByteString, ByteString)
forall a b. a -> Either a b
Left String
"clear-signed block contained nested clear-signed payload"
    clearSignedBlockFromArmor Armor
_ =
      String
-> Either String ([(String, String)], ByteString, ByteString)
forall a b. a -> Either a b
Left String
"internal error: expected ClearSigned armor block"

recommendedArmorType :: [Pkt] -> Maybe ArmorType
recommendedArmorType :: [Pkt] -> Maybe ArmorType
recommendedArmorType [] = Maybe ArmorType
forall a. Maybe a
Nothing
recommendedArmorType (Pkt
pkt:[Pkt]
_)
  | Pkt -> Bool
isPrivateKeyPacket Pkt
pkt = ArmorType -> Maybe ArmorType
forall a. a -> Maybe a
Just ArmorType
ArmorPrivateKeyBlock
  | Pkt -> Bool
isPublicKeyPacket Pkt
pkt = ArmorType -> Maybe ArmorType
forall a. a -> Maybe a
Just ArmorType
ArmorPublicKeyBlock
  | Pkt -> Bool
isSignaturePacket Pkt
pkt = ArmorType -> Maybe ArmorType
forall a. a -> Maybe a
Just ArmorType
ArmorSignature
  | Bool
otherwise = ArmorType -> Maybe ArmorType
forall a. a -> Maybe a
Just ArmorType
ArmorMessage
  where
    isPrivateKeyPacket :: Pkt -> Bool
isPrivateKeyPacket SecretKeyPkt {} = Bool
True
    isPrivateKeyPacket SecretSubkeyPkt {} = Bool
True
    isPrivateKeyPacket Pkt
_ = Bool
False

    isPublicKeyPacket :: Pkt -> Bool
isPublicKeyPacket PublicKeyPkt {} = Bool
True
    isPublicKeyPacket PublicSubkeyPkt {} = Bool
True
    isPublicKeyPacket Pkt
_ = Bool
False

    isSignaturePacket :: Pkt -> Bool
isSignaturePacket SignaturePkt {} = Bool
True
    isSignaturePacket Pkt
_ = Bool
False

dearmorIfAsciiArmored :: ByteString -> Either String (Bool, ByteString)
dearmorIfAsciiArmored :: ByteString -> Either String (Bool, ByteString)
dearmorIfAsciiArmored ByteString
bs
  | ByteString -> Bool
looksLikeAsciiArmor ByteString
bs =
      (\ByteString
payload -> (Bool
True, ByteString
payload)) (ByteString -> (Bool, ByteString))
-> Either String ByteString -> Either String (Bool, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String ByteString
decodeSingleArmorPayload ByteString
bs
  | Bool
otherwise = (Bool, ByteString) -> Either String (Bool, ByteString)
forall a b. b -> Either a b
Right (Bool
False, ByteString
bs)

dearmorIfAsciiArmoredLenient :: ByteString -> Either String (Bool, ByteString)
dearmorIfAsciiArmoredLenient :: ByteString -> Either String (Bool, ByteString)
dearmorIfAsciiArmoredLenient ByteString
bs
  | ByteString -> Bool
looksLikeAsciiArmorLenient ByteString
bs =
      (\ByteString
payload -> (Bool
True, ByteString
payload)) (ByteString -> (Bool, ByteString))
-> Either String ByteString -> Either String (Bool, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String ByteString
decodeSingleArmorPayloadLenient (ByteString -> ByteString
stripUtf8Bom ByteString
bs)
  | Bool
otherwise = (Bool, ByteString) -> Either String (Bool, ByteString)
forall a b. b -> Either a b
Right (Bool
False, ByteString
bs)

decodeSingleArmorPayload :: ByteString -> Either String ByteString
decodeSingleArmorPayload :: ByteString -> Either String ByteString
decodeSingleArmorPayload ByteString
bs =
  case ByteString -> Either String [Armor]
forall e. IsString e => ByteString -> Either e [Armor]
AA.decodeLazy ByteString
bs of
    Left String
err -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
err
    Right [Armor]
armors -> [Armor] -> Either String ByteString
singleArmorPayload [Armor]
armors

decodeSingleArmorPayloadLenient :: ByteString -> Either String ByteString
decodeSingleArmorPayloadLenient :: ByteString -> Either String ByteString
decodeSingleArmorPayloadLenient ByteString
bs =
  case ByteString -> Either String ByteString
decodeSingleArmorPayload ByteString
bs of
    Right ByteString
payload -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
payload
    Left String
strictErr ->
      let normalized :: ByteString
normalized = ByteString -> ByteString
normalizeAsciiArmorForLenientDecode ByteString
bs
       in if ByteString
normalized ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs
            then String -> Either String ByteString
forall a b. a -> Either a b
Left String
strictErr
            else case ByteString -> Either String ByteString
decodeSingleArmorPayload ByteString
normalized of
                   Left String
lenientErr ->
                     String -> Either String ByteString
forall a b. a -> Either a b
Left
                       (String
strictErr String -> String -> String
forall a. [a] -> [a] -> [a]
++
                        String
" (lenient normalization retry failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lenientErr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
                   Right ByteString
payload -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
payload

singleArmorPayload :: [Armor] -> Either String ByteString
singleArmorPayload :: [Armor] -> Either String ByteString
singleArmorPayload [Armor]
armors =
  case [Armor] -> [ByteString]
armorPayloads [Armor]
armors of
    [ByteString
payload] -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
payload
    [] -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"ASCII armor decode succeeded but returned no blocks"
    [ByteString]
payloads ->
      String -> Either String ByteString
forall a b. a -> Either a b
Left
        (String
"ASCII armor decode returned " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         Int -> String
forall a. Show a => a -> String
show ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
payloads) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" blocks (expected exactly one)")

data WireRepInput =
  WireRepInput
    { WireRepInput -> WireRepRef
wireRepInputRef :: WireRepRef
    , WireRepInput -> ByteString
wireRepInputPayload :: ByteString
    }

wireRepRefFromInput :: Maybe T.Text -> ByteString -> Either String WireRepInput
wireRepRefFromInput :: Maybe Text -> ByteString -> Either String WireRepInput
wireRepRefFromInput Maybe Text
mname ByteString
bs =
  (\(Bool
wasArmored, ByteString
payload) ->
      WireRepInput
        { wireRepInputRef :: WireRepRef
wireRepInputRef = Maybe Text -> Bool -> ByteString -> WireRepRef
BTypes.mkWireRepRef Maybe Text
mname Bool
wasArmored ByteString
payload
        , wireRepInputPayload :: ByteString
wireRepInputPayload = ByteString
payload
        }) ((Bool, ByteString) -> WireRepInput)
-> Either String (Bool, ByteString) -> Either String WireRepInput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ByteString -> Either String (Bool, ByteString)
dearmorIfAsciiArmored ByteString
bs

data ParseState =
  ParseState
    { ParseState -> Int64
psOffset :: Int64
    , ParseState -> Int
psIndex :: Int
    , ParseState -> WireRepRef
psSource :: WireRepRef
    , ParseState -> ByteString
psRemaining :: BL.ByteString
    }

-- | Parse packets from a source bytestream, preserving packet provenance.
parsePktsWithWireRep :: WireRepRef -> ByteString -> [PktWithWireRep]
parsePktsWithWireRep :: WireRepRef -> ByteString -> [PktWithWireRep]
parsePktsWithWireRep WireRepRef
src ByteString
input = ParseState -> [PktWithWireRep]
go ParseState
initialState
  where
    initialState :: ParseState
initialState =
      ParseState
        { psOffset :: Int64
psOffset = Int64
0
        , psIndex :: Int
psIndex = Int
0
        , psSource :: WireRepRef
psSource = WireRepRef
src
        , psRemaining :: ByteString
psRemaining = ByteString
input
        }
    go :: ParseState -> [PktWithWireRep]
go ParseState
state
      | ByteString -> Bool
BL.null (ParseState -> ByteString
psRemaining ParseState
state) = []
      | Bool
otherwise =
          case Get Pkt
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get Pkt
getPkt (ParseState -> ByteString
psRemaining ParseState
state) of
            Left (ByteString
_, Int64
_, String
_) -> []
            Right (ByteString
rest, Int64
consumed, Pkt
pkt) ->
              let raw :: ByteString
raw = Int64 -> ByteString -> ByteString
BL.take Int64
consumed (ParseState -> ByteString
psRemaining ParseState
state)
                  newState :: ParseState
newState =
                    ParseState
state
                      { psOffset = psOffset state + consumed
                      , psIndex = psIndex state + 1
                      , psRemaining = rest
                      }
                  pktWithSource :: PktWithWireRep
pktWithSource =
                    WireRepRef
-> ByteRange -> ByteString -> Int -> Pkt -> PktWithWireRep
PktWithWireRep
                      (ParseState -> WireRepRef
psSource ParseState
state)
                      (Int64 -> Int64 -> ByteRange
ByteRange (ParseState -> Int64
psOffset ParseState
state) Int64
consumed)
                      ByteString
raw
                      (ParseState -> Int
psIndex ParseState
state)
                      Pkt
pkt
               in PktWithWireRep
pktWithSource PktWithWireRep -> [PktWithWireRep] -> [PktWithWireRep]
forall a. a -> [a] -> [a]
: ParseState -> [PktWithWireRep]
go ParseState
newState

conduitParsePktsWithWireRep ::
     Monad m => Maybe T.Text -> ConduitT B.ByteString PktWithWireRep m ()
conduitParsePktsWithWireRep :: forall (m :: * -> *).
Monad m =>
Maybe Text -> ConduitT ByteString PktWithWireRep m ()
conduitParsePktsWithWireRep Maybe Text
mname = ConduitParseState -> ConduitT ByteString PktWithWireRep m ()
go ([ByteString] -> ConduitParseState
UndecidedInput [])
  where
    go :: ConduitParseState -> ConduitT ByteString PktWithWireRep m ()
go !ConduitParseState
state = do
      mchunk <- ConduitT ByteString PktWithWireRep m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
      case mchunk of
        Maybe ByteString
Nothing -> (PktWithWireRep -> ConduitT ByteString PktWithWireRep m ())
-> [PktWithWireRep] -> ConduitT ByteString PktWithWireRep m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PktWithWireRep -> ConduitT ByteString PktWithWireRep m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Maybe Text -> ConduitParseState -> [PktWithWireRep]
finishConduitState Maybe Text
mname ConduitParseState
state)
        Just ByteString
chunk ->
          let !nextState :: ConduitParseState
nextState = ByteString -> ConduitParseState -> ConduitParseState
consumeConduitChunk ByteString
chunk ConduitParseState
state
           in ConduitParseState -> ConduitT ByteString PktWithWireRep m ()
go ConduitParseState
nextState

data ConduitParseState
  = UndecidedInput ![B.ByteString]
  | ArmoredInput ![B.ByteString]
  | BinaryInput !BinaryParseState

data BinaryParseState =
  BinaryParseState
    { BinaryParseState -> Int64
bpsLength :: !Int64
    , BinaryParseState -> Int64
bpsOffset :: !Int64
    , BinaryParseState -> Int
bpsIndex :: !Int
    , BinaryParseState -> ByteString
bpsBuffer :: !B.ByteString
    , BinaryParseState -> [ParsedPacketChunk]
bpsParsedRev :: [ParsedPacketChunk]
    }

data ArmorPrefixDecision
  = PrefixNeedsMore
  | PrefixIsArmored
  | PrefixIsBinary

consumeConduitChunk :: B.ByteString -> ConduitParseState -> ConduitParseState
consumeConduitChunk :: ByteString -> ConduitParseState -> ConduitParseState
consumeConduitChunk ByteString
chunk (UndecidedInput [ByteString]
chunksRev) =
  let prefixChunksRev :: [ByteString]
prefixChunksRev = ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunksRev
      prefix :: ByteString
prefix = [ByteString] -> ByteString
B.concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
prefixChunksRev)
   in case ByteString -> ArmorPrefixDecision
classifyArmorPrefix ByteString
prefix of
        ArmorPrefixDecision
PrefixNeedsMore -> [ByteString] -> ConduitParseState
UndecidedInput [ByteString]
prefixChunksRev
        ArmorPrefixDecision
PrefixIsArmored -> [ByteString] -> ConduitParseState
ArmoredInput [ByteString]
prefixChunksRev
        ArmorPrefixDecision
PrefixIsBinary -> ByteString -> BinaryParseState -> ConduitParseState
feedBinaryChunk ByteString
prefix BinaryParseState
initialBinaryParseState
consumeConduitChunk ByteString
chunk (ArmoredInput [ByteString]
chunksRev) = [ByteString] -> ConduitParseState
ArmoredInput (ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunksRev)
consumeConduitChunk ByteString
chunk (BinaryInput BinaryParseState
state) = BinaryParseState -> ConduitParseState
BinaryInput (ByteString -> BinaryParseState -> BinaryParseState
advanceBinaryParseState ByteString
chunk BinaryParseState
state)

finishConduitState :: Maybe T.Text -> ConduitParseState -> [PktWithWireRep]
finishConduitState :: Maybe Text -> ConduitParseState -> [PktWithWireRep]
finishConduitState Maybe Text
mname (UndecidedInput [ByteString]
chunksRev) =
  Maybe Text -> BinaryParseState -> [PktWithWireRep]
finalizeBinaryParseState
    Maybe Text
mname
    (ByteString -> BinaryParseState -> BinaryParseState
advanceBinaryParseState ([ByteString] -> ByteString
B.concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
chunksRev)) BinaryParseState
initialBinaryParseState)
finishConduitState Maybe Text
mname (ArmoredInput [ByteString]
chunksRev) =
  let input :: ByteString
input = [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
chunksRev)
   in case Maybe Text -> ByteString -> Either String WireRepInput
wireRepRefFromInput Maybe Text
mname ByteString
input of
        Left String
_ -> []
        Right WireRepInput
          { wireRepInputRef :: WireRepInput -> WireRepRef
wireRepInputRef = WireRepRef
src
          , wireRepInputPayload :: WireRepInput -> ByteString
wireRepInputPayload = ByteString
payload
          } ->
          WireRepRef -> ByteString -> [PktWithWireRep]
parsePktsWithWireRep WireRepRef
src ByteString
payload
finishConduitState Maybe Text
mname (BinaryInput BinaryParseState
state) = Maybe Text -> BinaryParseState -> [PktWithWireRep]
finalizeBinaryParseState Maybe Text
mname BinaryParseState
state

initialBinaryParseState :: BinaryParseState
initialBinaryParseState :: BinaryParseState
initialBinaryParseState =
  BinaryParseState
    { bpsLength :: Int64
bpsLength = Int64
0
    , bpsOffset :: Int64
bpsOffset = Int64
0
    , bpsIndex :: Int
bpsIndex = Int
0
    , bpsBuffer :: ByteString
bpsBuffer = ByteString
B.empty
    , bpsParsedRev :: [ParsedPacketChunk]
bpsParsedRev = []
    }

feedBinaryChunk :: B.ByteString -> BinaryParseState -> ConduitParseState
feedBinaryChunk :: ByteString -> BinaryParseState -> ConduitParseState
feedBinaryChunk ByteString
chunk = BinaryParseState -> ConduitParseState
BinaryInput (BinaryParseState -> ConduitParseState)
-> (BinaryParseState -> BinaryParseState)
-> BinaryParseState
-> ConduitParseState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryParseState -> BinaryParseState
advanceBinaryParseState ByteString
chunk

advanceBinaryParseState :: B.ByteString -> BinaryParseState -> BinaryParseState
advanceBinaryParseState :: ByteString -> BinaryParseState -> BinaryParseState
advanceBinaryParseState ByteString
chunk BinaryParseState
state =
  let !nextLength :: Int64
nextLength = BinaryParseState -> Int64
bpsLength BinaryParseState
state Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
chunk)
      !(Int64
nextOffset, Int
nextIndex, ByteString
nextBuffer, [ParsedPacketChunk]
nextParsedRev) =
        Int64
-> Int
-> ByteString
-> [ParsedPacketChunk]
-> (Int64, Int, ByteString, [ParsedPacketChunk])
drainParsedPackets
          (BinaryParseState -> Int64
bpsOffset BinaryParseState
state)
          (BinaryParseState -> Int
bpsIndex BinaryParseState
state)
          (BinaryParseState -> ByteString
bpsBuffer BinaryParseState
state ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
chunk)
          (BinaryParseState -> [ParsedPacketChunk]
bpsParsedRev BinaryParseState
state)
   in BinaryParseState
        { bpsLength :: Int64
bpsLength = Int64
nextLength
        , bpsOffset :: Int64
bpsOffset = Int64
nextOffset
        , bpsIndex :: Int
bpsIndex = Int
nextIndex
        , bpsBuffer :: ByteString
bpsBuffer = ByteString
nextBuffer
        , bpsParsedRev :: [ParsedPacketChunk]
bpsParsedRev = [ParsedPacketChunk]
nextParsedRev
        }

finalizeBinaryParseState :: Maybe T.Text -> BinaryParseState -> [PktWithWireRep]
finalizeBinaryParseState :: Maybe Text -> BinaryParseState -> [PktWithWireRep]
finalizeBinaryParseState Maybe Text
mname BinaryParseState
state =
  let src :: WireRepRef
src = Maybe Text -> Bool -> Int64 -> WireRepRef
BTypes.mkWireRepRefWithLength Maybe Text
mname Bool
False (BinaryParseState -> Int64
bpsLength BinaryParseState
state)
   in (ParsedPacketChunk -> PktWithWireRep)
-> [ParsedPacketChunk] -> [PktWithWireRep]
forall a b. (a -> b) -> [a] -> [b]
map (WireRepRef -> ParsedPacketChunk -> PktWithWireRep
toPktWithWireRep WireRepRef
src) ([ParsedPacketChunk] -> [ParsedPacketChunk]
forall a. [a] -> [a]
reverse (BinaryParseState -> [ParsedPacketChunk]
bpsParsedRev BinaryParseState
state))

classifyArmorPrefix :: B.ByteString -> ArmorPrefixDecision
classifyArmorPrefix :: ByteString -> ArmorPrefixDecision
classifyArmorPrefix ByteString
prefix =
  case (Word8 -> Bool) -> ByteString -> ByteString
B.dropWhile Word8 -> Bool
isLeadingArmorWhitespace ByteString
prefix of
    ByteString
rest
      | ByteString -> Bool
B.null ByteString
rest -> ArmorPrefixDecision
PrefixNeedsMore
      | ByteString
armorHeader ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
rest -> ArmorPrefixDecision
PrefixIsArmored
      | ByteString
rest ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
armorHeader -> ArmorPrefixDecision
PrefixNeedsMore
      | Bool
otherwise -> ArmorPrefixDecision
PrefixIsBinary

armorHeader :: B.ByteString
armorHeader :: ByteString
armorHeader = [Word8] -> ByteString
B.pack ((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) String
"-----BEGIN PGP ")

armorHeaderLazy :: ByteString
armorHeaderLazy :: ByteString
armorHeaderLazy = ByteString -> ByteString
BL.fromStrict ByteString
armorHeader

utf8Bom :: ByteString
utf8Bom :: ByteString
utf8Bom = [Word8] -> ByteString
BL.pack [Word8
0xef, Word8
0xbb, Word8
0xbf]

isLeadingArmorWhitespace :: Word8 -> Bool
isLeadingArmorWhitespace :: Word8 -> Bool
isLeadingArmorWhitespace Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0d Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a

stripUtf8Bom :: ByteString -> ByteString
stripUtf8Bom :: ByteString -> ByteString
stripUtf8Bom ByteString
bs
  | ByteString
utf8Bom ByteString -> ByteString -> Bool
`BL.isPrefixOf` ByteString
bs = Int64 -> ByteString -> ByteString
BL.drop (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
utf8Bom)) ByteString
bs
  | Bool
otherwise = ByteString
bs

normalizeAsciiArmorForLenientDecode :: ByteString -> ByteString
normalizeAsciiArmorForLenientDecode :: ByteString -> ByteString
normalizeAsciiArmorForLenientDecode =
  ByteString -> ByteString
ensureTrailingLf (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
normalizeLineEndings
  where
    ensureTrailingLf :: ByteString -> ByteString
ensureTrailingLf ByteString
lbs
      | ByteString -> Bool
BL.null ByteString
lbs = ByteString
lbs
      | HasCallStack => ByteString -> Word8
ByteString -> Word8
BL.last ByteString
lbs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a = ByteString
lbs
      | Bool
otherwise = ByteString
lbs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BL.singleton Word8
0x0a
    normalizeLineEndings :: ByteString -> ByteString
normalizeLineEndings ByteString
lbs =
      case ByteString -> Maybe (Word8, ByteString)
BL.uncons ByteString
lbs of
        Maybe (Word8, ByteString)
Nothing -> ByteString
BL.empty
        Just (Word8
0x0d, ByteString
rest) ->
          case ByteString -> Maybe (Word8, ByteString)
BL.uncons ByteString
rest of
            Just (Word8
0x0a, ByteString
rest') -> Word8 -> ByteString -> ByteString
BL.cons Word8
0x0a (ByteString -> ByteString
normalizeLineEndings ByteString
rest')
            Maybe (Word8, ByteString)
_ -> Word8 -> ByteString -> ByteString
BL.cons Word8
0x0a (ByteString -> ByteString
normalizeLineEndings ByteString
rest)
        Just (Word8
w, ByteString
rest) -> Word8 -> ByteString -> ByteString
BL.cons Word8
w (ByteString -> ByteString
normalizeLineEndings ByteString
rest)

data ParsedPacketChunk =
  ParsedPacketChunk
    { ParsedPacketChunk -> ByteRange
ppcRange :: ByteRange
    , ParsedPacketChunk -> ByteString
ppcRaw :: ByteString
    , ParsedPacketChunk -> Int
ppcIndex :: Int
    , ParsedPacketChunk -> Pkt
ppcValue :: Pkt
    }

toPktWithWireRep :: WireRepRef -> ParsedPacketChunk -> PktWithWireRep
toPktWithWireRep :: WireRepRef -> ParsedPacketChunk -> PktWithWireRep
toPktWithWireRep WireRepRef
src ParsedPacketChunk
ppc =
  WireRepRef
-> ByteRange -> ByteString -> Int -> Pkt -> PktWithWireRep
PktWithWireRep WireRepRef
src (ParsedPacketChunk -> ByteRange
ppcRange ParsedPacketChunk
ppc) (ParsedPacketChunk -> ByteString
ppcRaw ParsedPacketChunk
ppc) (ParsedPacketChunk -> Int
ppcIndex ParsedPacketChunk
ppc) (ParsedPacketChunk -> Pkt
ppcValue ParsedPacketChunk
ppc)

drainParsedPackets ::
     Int64
  -> Int
  -> B.ByteString
  -> [ParsedPacketChunk]
  -> (Int64, Int, B.ByteString, [ParsedPacketChunk])
drainParsedPackets :: Int64
-> Int
-> ByteString
-> [ParsedPacketChunk]
-> (Int64, Int, ByteString, [ParsedPacketChunk])
drainParsedPackets !Int64
offset !Int
idx !ByteString
buffer [ParsedPacketChunk]
acc
  | ByteString -> Bool
B.null ByteString
buffer = (Int64
offset, Int
idx, ByteString
B.empty, [ParsedPacketChunk]
acc)
  | Bool
otherwise =
     case Get Pkt
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Pkt)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get Pkt
getPkt (ByteString -> ByteString
BL.fromStrict ByteString
buffer) of
        Left (ByteString, Int64, String)
_ -> (Int64
offset, Int
idx, ByteString
buffer, [ParsedPacketChunk]
acc)
        Right (ByteString
rest, Int64
consumed, Pkt
pkt) ->
         let !consumedLen :: Int
consumedLen = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
consumed
             !nextOffset :: Int64
nextOffset = Int64
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
consumed
             !nextIdx :: Int
nextIdx = Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
             !nextBuffer :: ByteString
nextBuffer = ByteString -> ByteString
BL.toStrict ByteString
rest
             parsedPacket :: ParsedPacketChunk
parsedPacket =
               ParsedPacketChunk
                 { ppcRange :: ByteRange
ppcRange = Int64 -> Int64 -> ByteRange
ByteRange Int64
offset Int64
consumed
                 , ppcRaw :: ByteString
ppcRaw = ByteString -> ByteString
BL.fromStrict (Int -> ByteString -> ByteString
B.take Int
consumedLen ByteString
buffer)
                 , ppcIndex :: Int
ppcIndex = Int
idx
                 , ppcValue :: Pkt
ppcValue = Pkt
pkt
                 }
          in Int64
-> Int
-> ByteString
-> [ParsedPacketChunk]
-> (Int64, Int, ByteString, [ParsedPacketChunk])
drainParsedPackets
               Int64
nextOffset
               Int
nextIdx
               ByteString
nextBuffer
               (ParsedPacketChunk
parsedPacket ParsedPacketChunk -> [ParsedPacketChunk] -> [ParsedPacketChunk]
forall a. a -> [a] -> [a]
: [ParsedPacketChunk]
acc)