-- 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 FlexibleInstances #-}
{-# LANGUAGE GADTs #-}

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 qualified Codec.Encryption.OpenPGP.ASCIIArmor as AA
import Codec.Encryption.OpenPGP.ASCIIArmor.Types
    ( Armor (..)
    , ArmorType (..)
    )
import Control.Applicative (many, some)
import Control.Arrow ((***))
import Control.Lens ((^.), _1)
import Control.Monad (guard, replicateM, replicateM_, when)
import Control.Monad.Loops (iterateUntilM)
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 Data.Conduit (ConduitT, await, yield)
import qualified Data.Foldable as F
import Data.Int (Int64)
import Data.List (mapAccumL)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
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.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 AEADAlgorithm where
    get :: Get AEADAlgorithm
get = Word8 -> AEADAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal (Word8 -> AEADAlgorithm) -> Get Word8 -> Get AEADAlgorithm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    put :: AEADAlgorithm -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (AEADAlgorithm -> Word8) -> AEADAlgorithm -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AEADAlgorithm -> 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 Padding where
    get :: Get Padding
get = Get Pkt
getPkt Get Pkt -> (Pkt -> Get Padding) -> Get Padding
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 Padding)
-> (Padding -> Get Padding) -> Either String Padding -> Get Padding
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get Padding
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Padding -> Get Padding
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Padding -> Get Padding)
-> (Pkt -> Either String Padding) -> Pkt -> Get Padding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Either String Padding
forall a. Packet a => Pkt -> Either String a
fromPktEither
    put :: Padding -> Put
put = Pkt -> Put
putPkt (Pkt -> Put) -> (Padding -> Pkt) -> Padding -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> 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

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

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

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 -> Int64 -> Get SigSubPacket
getSigSubPacket' Word8
pt Bool
crit Int64
l
        | 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 = Word8 -> Bool -> Int64 -> Get SigSubPacket
getUserDefinedSigSub Word8
pt Bool
crit Int64
l
        | Bool
otherwise =
            case Word8
-> Map Word8 (Word8 -> Bool -> Int64 -> Get SigSubPacket)
-> Maybe (Word8 -> Bool -> Int64 -> Get SigSubPacket)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Word8
pt Map Word8 (Word8 -> Bool -> Int64 -> Get SigSubPacket)
sigSubPacketParsers of
                Just Word8 -> Bool -> Int64 -> Get SigSubPacket
parser -> Word8 -> Bool -> Int64 -> Get SigSubPacket
parser Word8
pt Bool
crit Int64
l
                Maybe (Word8 -> Bool -> Int64 -> Get SigSubPacket)
Nothing -> Word8 -> Bool -> Int64 -> Get SigSubPacket
getOtherSigSub Word8
pt Bool
crit Int64
l

    getOtherSigSub :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getOtherSigSub Word8
pt Bool
crit Int64
l = 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)

type SigSubPacketParser =
    Word8 -> Bool -> ByteOffset -> Get SigSubPacket

sigSubPacketParsers :: M.Map Word8 SigSubPacketParser
sigSubPacketParsers :: Map Word8 (Word8 -> Bool -> Int64 -> Get SigSubPacket)
sigSubPacketParsers =
    [(Word8, Word8 -> Bool -> Int64 -> Get SigSubPacket)]
-> Map Word8 (Word8 -> Bool -> Int64 -> Get SigSubPacket)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
        [ (Word8
2, Word8 -> Bool -> Int64 -> Get SigSubPacket
getSigCreationTime)
        , (Word8
3, Word8 -> Bool -> Int64 -> Get SigSubPacket
getSigExpirationTime)
        , (Word8
4, Word8 -> Bool -> Int64 -> Get SigSubPacket
getExportableCertification)
        , (Word8
5, Word8 -> Bool -> Int64 -> Get SigSubPacket
getTrustSignature)
        , (Word8
6, Word8 -> Bool -> Int64 -> Get SigSubPacket
getRegularExpression)
        , (Word8
7, Word8 -> Bool -> Int64 -> Get SigSubPacket
getRevocable)
        , (Word8
9, Word8 -> Bool -> Int64 -> Get SigSubPacket
getKeyExpirationTime)
        , (Word8
11, Word8 -> Bool -> Int64 -> Get SigSubPacket
getPreferredSymmetricAlgorithms)
        , (Word8
12, Word8 -> Bool -> Int64 -> Get SigSubPacket
getRevocationKey)
        , (Word8
16, Word8 -> Bool -> Int64 -> Get SigSubPacket
getIssuer)
        , (Word8
20, Word8 -> Bool -> Int64 -> Get SigSubPacket
getNotationData)
        , (Word8
21, Word8 -> Bool -> Int64 -> Get SigSubPacket
getPreferredHashAlgorithms)
        , (Word8
22, Word8 -> Bool -> Int64 -> Get SigSubPacket
getPreferredCompressionAlgorithms)
        , (Word8
23, Word8 -> Bool -> Int64 -> Get SigSubPacket
getKeyServerPreferences)
        , (Word8
24, Word8 -> Bool -> Int64 -> Get SigSubPacket
getPreferredKeyServer)
        , (Word8
25, Word8 -> Bool -> Int64 -> Get SigSubPacket
getPrimaryUserId)
        , (Word8
26, Word8 -> Bool -> Int64 -> Get SigSubPacket
getPolicyURL)
        , (Word8
27, Word8 -> Bool -> Int64 -> Get SigSubPacket
getKeyFlags)
        , (Word8
28, Word8 -> Bool -> Int64 -> Get SigSubPacket
getSignersUserId)
        , (Word8
29, Word8 -> Bool -> Int64 -> Get SigSubPacket
getReasonForRevocation)
        , (Word8
30, Word8 -> Bool -> Int64 -> Get SigSubPacket
getFeatures)
        , (Word8
31, Word8 -> Bool -> Int64 -> Get SigSubPacket
getSignatureTarget)
        , (Word8
32, Word8 -> Bool -> Int64 -> Get SigSubPacket
getEmbeddedSignature)
        , (Word8
33, Word8 -> Bool -> Int64 -> Get SigSubPacket
getIssuerFingerprint)
        , (Word8
35, Word8 -> Bool -> Int64 -> Get SigSubPacket
getIntendedRecipient)
        , (Word8
39, Word8 -> Bool -> Int64 -> Get SigSubPacket
getPreferredAEADCiphersuites)
        ]

getSigCreationTime :: SigSubPacketParser
getSigCreationTime :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getSigCreationTime Word8
_pt Bool
crit Int64
_l =
    Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
crit (SigSubPacketPayload -> SigSubPacket)
-> (ThirtyTwoBitTimeStamp -> SigSubPacketPayload)
-> ThirtyTwoBitTimeStamp
-> SigSubPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitTimeStamp -> SigSubPacketPayload
SigCreationTime
        (ThirtyTwoBitTimeStamp -> SigSubPacket)
-> Get ThirtyTwoBitTimeStamp -> Get SigSubPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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

getSigExpirationTime :: SigSubPacketParser
getSigExpirationTime :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getSigExpirationTime Word8
_pt Bool
crit Int64
_l =
    Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
crit (SigSubPacketPayload -> SigSubPacket)
-> (ThirtyTwoBitDuration -> SigSubPacketPayload)
-> ThirtyTwoBitDuration
-> SigSubPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitDuration -> SigSubPacketPayload
SigExpirationTime
        (ThirtyTwoBitDuration -> SigSubPacket)
-> Get ThirtyTwoBitDuration -> Get SigSubPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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

getExportableCertification :: SigSubPacketParser
getExportableCertification :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getExportableCertification Word8
_pt Bool
crit Int64
_l = Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
crit (SigSubPacketPayload -> SigSubPacket)
-> (Bool -> SigSubPacketPayload) -> Bool -> SigSubPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> SigSubPacketPayload
ExportableCertification (Bool -> SigSubPacket) -> Get Bool -> Get SigSubPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get

getTrustSignature :: SigSubPacketParser
getTrustSignature :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getTrustSignature Word8
_pt Bool
crit Int64
_l = do
    tl <- Get Word8
getWord8
    ta <- getWord8
    return $ SigSubPacket crit (TrustSignature tl ta)

getRegularExpression :: SigSubPacketParser
getRegularExpression :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getRegularExpression Word8
_pt Bool
crit Int64
l = 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))

getRevocable :: SigSubPacketParser
getRevocable :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getRevocable Word8
_pt Bool
crit Int64
_l = Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
crit (SigSubPacketPayload -> SigSubPacket)
-> (Bool -> SigSubPacketPayload) -> Bool -> SigSubPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> SigSubPacketPayload
Revocable (Bool -> SigSubPacket) -> Get Bool -> Get SigSubPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get

getKeyExpirationTime :: SigSubPacketParser
getKeyExpirationTime :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getKeyExpirationTime Word8
_pt Bool
crit Int64
_l =
    Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
crit (SigSubPacketPayload -> SigSubPacket)
-> (ThirtyTwoBitDuration -> SigSubPacketPayload)
-> ThirtyTwoBitDuration
-> SigSubPacket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitDuration -> SigSubPacketPayload
KeyExpirationTime
        (ThirtyTwoBitDuration -> SigSubPacket)
-> Get ThirtyTwoBitDuration -> Get SigSubPacket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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

getPreferredSymmetricAlgorithms :: SigSubPacketParser
getPreferredSymmetricAlgorithms :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getPreferredSymmetricAlgorithms Word8
_pt Bool
crit Int64
l = 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)

getRevocationKey :: SigSubPacketParser
getRevocationKey :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getRevocationKey Word8
_pt Bool
crit Int64
l = 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)
            )

getIssuer :: SigSubPacketParser
getIssuer :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getIssuer Word8
_pt Bool
crit Int64
l = 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))

getNotationData :: SigSubPacketParser
getNotationData :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getNotationData Word8
_pt Bool
crit Int64
l = 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)
            )

getPreferredHashAlgorithms :: SigSubPacketParser
getPreferredHashAlgorithms :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getPreferredHashAlgorithms Word8
_pt Bool
crit Int64
l = 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)

getPreferredCompressionAlgorithms :: SigSubPacketParser
getPreferredCompressionAlgorithms :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getPreferredCompressionAlgorithms Word8
_pt Bool
crit Int64
l = 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)

getKeyServerPreferences :: SigSubPacketParser
getKeyServerPreferences :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getKeyServerPreferences Word8
_pt Bool
crit Int64
l = 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))

getPreferredKeyServer :: SigSubPacketParser
getPreferredKeyServer :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getPreferredKeyServer Word8
_pt Bool
crit Int64
l = 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)

getPrimaryUserId :: SigSubPacketParser
getPrimaryUserId :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getPrimaryUserId Word8
_pt Bool
crit Int64
_l = do
    primacy <- Get Bool
forall t. Binary t => Get t
get
    return $ SigSubPacket crit (PrimaryUserId primacy)

getPolicyURL :: SigSubPacketParser
getPolicyURL :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getPolicyURL Word8
_pt Bool
crit Int64
l = 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)

getKeyFlags :: SigSubPacketParser
getKeyFlags :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getKeyFlags Word8
_pt Bool
crit Int64
l = 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))

getSignersUserId :: SigSubPacketParser
getSignersUserId :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getSignersUserId Word8
_pt Bool
crit Int64
l = 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))

getReasonForRevocation :: SigSubPacketParser
getReasonForRevocation :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getReasonForRevocation Word8
_pt Bool
crit Int64
l = do
    rcode <- Get Word8
getWord8
    rreason <-
        fmap
            (decodeUtf8With lenientDecode)
            (getByteString (fromIntegral (l - 2)))
    return $
        SigSubPacket crit (ReasonForRevocation (toFVal rcode) rreason)

getFeatures :: SigSubPacketParser
getFeatures :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getFeatures Word8
_pt Bool
crit Int64
l = 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))

getSignatureTarget :: SigSubPacketParser
getSignatureTarget :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getSignatureTarget Word8
_pt Bool
crit Int64
l = do
    pka <- Get PubKeyAlgorithm
forall t. Binary t => Get t
get
    ha <- get
    hash <- getLazyByteString (l - 3)
    return $ SigSubPacket crit (SignatureTarget pka ha hash)

getEmbeddedSignature :: SigSubPacketParser
getEmbeddedSignature :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getEmbeddedSignature Word8
_pt Bool
crit Int64
l = 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)

getIssuerFingerprint :: SigSubPacketParser
getIssuerFingerprint :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getIssuerFingerprint Word8
_pt Bool
crit Int64
l = 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))

getIntendedRecipient :: SigSubPacketParser
getIntendedRecipient :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getIntendedRecipient Word8
_pt Bool
crit Int64
l = do
    kv <- Get Word8
getWord8
    fp <- getLazyByteString (l - 2)
    when (BL.length fp /= 20 && BL.length fp /= 32) $
        fail
            ( "invalid intended recipient fingerprint length: "
                ++ show (BL.length fp)
            )
    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 intended recipient 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 ->
            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 (IssuerFingerprintVersion -> Fingerprint -> SigSubPacketPayload
IntendedRecipient IssuerFingerprintVersion
ifVersion (ByteString -> Fingerprint
Fingerprint ByteString
fp))

getPreferredAEADCiphersuites :: SigSubPacketParser
getPreferredAEADCiphersuites :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getPreferredAEADCiphersuites Word8
_pt Bool
crit Int64
l = do
    let payloadLen :: Int
payloadLen = 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)
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
payloadLen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (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
"preferred AEAD ciphersuites subpacket length must be even"
    pairs <- Int
-> Get (SymmetricAlgorithm, AEADAlgorithm)
-> Get [(SymmetricAlgorithm, AEADAlgorithm)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
payloadLen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Get (SymmetricAlgorithm, AEADAlgorithm)
 -> Get [(SymmetricAlgorithm, AEADAlgorithm)])
-> Get (SymmetricAlgorithm, AEADAlgorithm)
-> Get [(SymmetricAlgorithm, AEADAlgorithm)]
forall a b. (a -> b) -> a -> b
$ do
        sa <- Get SymmetricAlgorithm
forall t. Binary t => Get t
get
        aead <- get
        return (sa, aead)
    return $ SigSubPacket crit (PreferredAEADCiphersuites pairs)

getUserDefinedSigSub :: SigSubPacketParser
getUserDefinedSigSub :: Word8 -> Bool -> Int64 -> Get SigSubPacket
getUserDefinedSigSub Word8
pt Bool
crit Int64
l = 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)

putSigSubPacket :: SigSubPacket -> Put
putSigSubPacket :: SigSubPacket -> Put
putSigSubPacket (SigSubPacket Bool
crit SigSubPacketPayload
payload) = case SigSubPacketPayload
payload of
    SigCreationTime ThirtyTwoBitTimeStamp
et -> Bool -> ThirtyTwoBitTimeStamp -> Put
putSigCreationTime Bool
crit ThirtyTwoBitTimeStamp
et
    SigExpirationTime ThirtyTwoBitDuration
et -> Bool -> ThirtyTwoBitDuration -> Put
putSigExpirationTime Bool
crit ThirtyTwoBitDuration
et
    ExportableCertification Bool
e -> Bool -> Bool -> Put
putExportableCertification Bool
crit Bool
e
    TrustSignature Word8
tl Word8
ta -> Bool -> Word8 -> Word8 -> Put
putTrustSignature Bool
crit Word8
tl Word8
ta
    RegularExpression ByteString
apdre -> Bool -> ByteString -> Put
putRegularExpression Bool
crit ByteString
apdre
    Revocable Bool
r -> Bool -> Bool -> Put
putRevocable Bool
crit Bool
r
    KeyExpirationTime ThirtyTwoBitDuration
et -> Bool -> ThirtyTwoBitDuration -> Put
putKeyExpirationTime Bool
crit ThirtyTwoBitDuration
et
    PreferredSymmetricAlgorithms [SymmetricAlgorithm]
ess -> Bool -> [SymmetricAlgorithm] -> Put
putPreferredSymmetricAlgorithms Bool
crit [SymmetricAlgorithm]
ess
    RevocationKey Set RevocationClass
rclass PubKeyAlgorithm
algid Fingerprint
fp -> Bool
-> Set RevocationClass -> PubKeyAlgorithm -> Fingerprint -> Put
putRevocationKey Bool
crit Set RevocationClass
rclass PubKeyAlgorithm
algid Fingerprint
fp
    Issuer EightOctetKeyId
keyid -> Bool -> EightOctetKeyId -> Put
putIssuer Bool
crit EightOctetKeyId
keyid
    NotationData Set NotationFlag
nfs NotationName
nn NotationValue
nv -> Bool -> Set NotationFlag -> NotationName -> NotationValue -> Put
putNotationData Bool
crit Set NotationFlag
nfs NotationName
nn NotationValue
nv
    PreferredHashAlgorithms [HashAlgorithm]
ehs -> Bool -> [HashAlgorithm] -> Put
putPreferredHashAlgorithms Bool
crit [HashAlgorithm]
ehs
    PreferredCompressionAlgorithms [CompressionAlgorithm]
ecs -> Bool -> [CompressionAlgorithm] -> Put
putPreferredCompressionAlgorithms Bool
crit [CompressionAlgorithm]
ecs
    KeyServerPreferences Set KSPFlag
ksps -> Bool -> Set KSPFlag -> Put
putKeyServerPreferences Bool
crit Set KSPFlag
ksps
    PreferredKeyServer ByteString
ks -> Bool -> ByteString -> Put
putPreferredKeyServer Bool
crit ByteString
ks
    PrimaryUserId Bool
primacy -> Bool -> Bool -> Put
putPrimaryUserId Bool
crit Bool
primacy
    PolicyURL URL
url -> Bool -> URL -> Put
putPolicyURL Bool
crit URL
url
    KeyFlags Set KeyFlag
kfs -> Bool -> Set KeyFlag -> Put
putKeyFlags Bool
crit Set KeyFlag
kfs
    SignersUserId Text
userid -> Bool -> Text -> Put
putSignersUserId Bool
crit Text
userid
    ReasonForRevocation RevocationCode
rcode Text
rreason -> Bool -> RevocationCode -> Text -> Put
putReasonForRevocation Bool
crit RevocationCode
rcode Text
rreason
    Features Set FeatureFlag
fs -> Bool -> Set FeatureFlag -> Put
putFeatures Bool
crit Set FeatureFlag
fs
    SignatureTarget PubKeyAlgorithm
pka HashAlgorithm
ha ByteString
hash -> Bool -> PubKeyAlgorithm -> HashAlgorithm -> ByteString -> Put
putSignatureTarget Bool
crit PubKeyAlgorithm
pka HashAlgorithm
ha ByteString
hash
    EmbeddedSignature SignaturePayload
sp -> Bool -> SignaturePayload -> Put
putEmbeddedSignature Bool
crit SignaturePayload
sp
    IssuerFingerprint IssuerFingerprintVersion
kv Fingerprint
fp -> Bool -> IssuerFingerprintVersion -> Fingerprint -> Put
putIssuerFingerprint Bool
crit IssuerFingerprintVersion
kv Fingerprint
fp
    IntendedRecipient IssuerFingerprintVersion
kv Fingerprint
irf -> Bool -> IssuerFingerprintVersion -> Fingerprint -> Put
putIntendedRecipient Bool
crit IssuerFingerprintVersion
kv Fingerprint
irf
    PreferredAEADCiphersuites [(SymmetricAlgorithm, AEADAlgorithm)]
ps -> Bool -> [(SymmetricAlgorithm, AEADAlgorithm)] -> Put
putPreferredAEADCiphersuites Bool
crit [(SymmetricAlgorithm, AEADAlgorithm)]
ps
    UserDefinedSigSub Word8
ptype ByteString
payload -> Bool -> Word8 -> ByteString -> Put
putOtherSigSub Bool
crit Word8
ptype ByteString
payload
    OtherSigSub Word8
ptype ByteString
payload -> Bool -> Word8 -> ByteString -> Put
putOtherSigSub Bool
crit Word8
ptype ByteString
payload

putSigCreationTime :: Bool -> ThirtyTwoBitTimeStamp -> Put
putSigCreationTime :: Bool -> ThirtyTwoBitTimeStamp -> Put
putSigCreationTime Bool
crit 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

putSigExpirationTime :: Bool -> ThirtyTwoBitDuration -> Put
putSigExpirationTime :: Bool -> ThirtyTwoBitDuration -> Put
putSigExpirationTime Bool
crit 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

putExportableCertification :: Bool -> Bool -> Put
putExportableCertification :: Bool -> Bool -> Put
putExportableCertification Bool
crit 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

putTrustSignature :: Bool -> Word8 -> Word8 -> Put
putTrustSignature :: Bool -> Word8 -> Word8 -> Put
putTrustSignature Bool
crit 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

putRegularExpression :: Bool -> BL.ByteString -> Put
putRegularExpression :: Bool -> ByteString -> Put
putRegularExpression Bool
crit 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

putRevocable :: Bool -> Bool -> Put
putRevocable :: Bool -> Bool -> Put
putRevocable Bool
crit 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

putKeyExpirationTime :: Bool -> ThirtyTwoBitDuration -> Put
putKeyExpirationTime :: Bool -> ThirtyTwoBitDuration -> Put
putKeyExpirationTime Bool
crit 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

putPreferredSymmetricAlgorithms
    :: Bool -> [SymmetricAlgorithm] -> Put
putPreferredSymmetricAlgorithms :: Bool -> [SymmetricAlgorithm] -> Put
putPreferredSymmetricAlgorithms Bool
crit [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

putRevocationKey
    :: Bool
    -> Set RevocationClass
    -> PubKeyAlgorithm
    -> Fingerprint
    -> Put
putRevocationKey :: Bool
-> Set RevocationClass -> PubKeyAlgorithm -> Fingerprint -> Put
putRevocationKey Bool
crit 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))
    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 b a. (FutureFlag b, Integral a) => 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)

putIssuer :: Bool -> EightOctetKeyId -> Put
putIssuer :: Bool -> EightOctetKeyId -> Put
putIssuer Bool
crit EightOctetKeyId
keyid = do
    Word32 -> Put
putSubPacketLength Word32
9
    Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
16
    ByteString -> Put
putLazyByteString (EightOctetKeyId -> ByteString
unEOKI EightOctetKeyId
keyid)

putNotationData
    :: Bool
    -> Set NotationFlag
    -> NotationName
    -> NotationValue
    -> Put
putNotationData :: Bool -> Set NotationFlag -> NotationName -> NotationValue -> Put
putNotationData Bool
crit 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 b a. (FutureFlag b, Integral a) => 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

putPreferredHashAlgorithms :: Bool -> [HashAlgorithm] -> Put
putPreferredHashAlgorithms :: Bool -> [HashAlgorithm] -> Put
putPreferredHashAlgorithms Bool
crit [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

putPreferredCompressionAlgorithms
    :: Bool -> [CompressionAlgorithm] -> Put
putPreferredCompressionAlgorithms :: Bool -> [CompressionAlgorithm] -> Put
putPreferredCompressionAlgorithms Bool
crit [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

putKeyServerPreferences :: Bool -> Set KSPFlag -> Put
putKeyServerPreferences :: Bool -> Set KSPFlag -> Put
putKeyServerPreferences Bool
crit 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

putPreferredKeyServer :: Bool -> BL.ByteString -> Put
putPreferredKeyServer :: Bool -> ByteString -> Put
putPreferredKeyServer Bool
crit 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

putPrimaryUserId :: Bool -> Bool -> Put
putPrimaryUserId :: Bool -> Bool -> Put
putPrimaryUserId Bool
crit 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

putPolicyURL :: Bool -> URL -> Put
putPolicyURL :: Bool -> URL -> Put
putPolicyURL Bool
crit (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

putKeyFlags :: Bool -> Set KeyFlag -> Put
putKeyFlags :: Bool -> Set KeyFlag -> Put
putKeyFlags Bool
crit 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

putSignersUserId :: Bool -> Text -> Put
putSignersUserId :: Bool -> Text -> Put
putSignersUserId Bool
crit 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

putReasonForRevocation
    :: Bool -> RevocationCode -> RevocationReason -> Put
putReasonForRevocation :: Bool -> RevocationCode -> Text -> Put
putReasonForRevocation Bool
crit 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

putFeatures :: Bool -> Set FeatureFlag -> Put
putFeatures :: Bool -> Set FeatureFlag -> Put
putFeatures Bool
crit 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

putSignatureTarget
    :: Bool -> PubKeyAlgorithm -> HashAlgorithm -> BL.ByteString -> Put
putSignatureTarget :: Bool -> PubKeyAlgorithm -> HashAlgorithm -> ByteString -> Put
putSignatureTarget Bool
crit 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

putEmbeddedSignature :: Bool -> SignaturePayload -> Put
putEmbeddedSignature :: Bool -> SignaturePayload -> Put
putEmbeddedSignature Bool
crit 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

putIssuerFingerprint
    :: Bool -> IssuerFingerprintVersion -> Fingerprint -> Put
putIssuerFingerprint :: Bool -> IssuerFingerprintVersion -> Fingerprint -> Put
putIssuerFingerprint Bool
crit 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

putIntendedRecipient
    :: Bool -> IssuerFingerprintVersion -> Fingerprint -> Put
putIntendedRecipient :: Bool -> IssuerFingerprintVersion -> Fingerprint -> Put
putIntendedRecipient Bool
crit IssuerFingerprintVersion
kv Fingerprint
irf = do
    let kv' :: Word8
kv' = IssuerFingerprintVersion -> Word8
BTypes.issuerFingerprintVersionToPacketVersion IssuerFingerprintVersion
kv
    let fpb :: ByteString
fpb = Fingerprint -> ByteString
unFingerprint Fingerprint
irf
    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 intended-recipient 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
35
    Word8 -> Put
putWord8 Word8
kv'
    ByteString -> Put
putLazyByteString ByteString
fpb

putPreferredAEADCiphersuites
    :: Bool -> [(SymmetricAlgorithm, AEADAlgorithm)] -> Put
putPreferredAEADCiphersuites :: Bool -> [(SymmetricAlgorithm, AEADAlgorithm)] -> Put
putPreferredAEADCiphersuites Bool
crit [(SymmetricAlgorithm, AEADAlgorithm)]
ps = 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
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [(SymmetricAlgorithm, AEADAlgorithm)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(SymmetricAlgorithm, AEADAlgorithm)]
ps)
    Bool -> Word8 -> Put
putSigSubPacketType Bool
crit Word8
39
    ((SymmetricAlgorithm, AEADAlgorithm) -> Put)
-> [(SymmetricAlgorithm, AEADAlgorithm)] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(SymmetricAlgorithm
sa, AEADAlgorithm
aead) -> SymmetricAlgorithm -> Put
forall t. Binary t => t -> Put
put SymmetricAlgorithm
sa Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AEADAlgorithm -> Put
forall t. Binary t => t -> Put
put AEADAlgorithm
aead) [(SymmetricAlgorithm, AEADAlgorithm)]
ps

putOtherSigSub :: Bool -> Word8 -> BL.ByteString -> Put
putOtherSigSub :: Bool -> Word8 -> ByteString -> Put
putOtherSigSub Bool
crit 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
    :: (FutureFlag b, Integral a) => a -> Set b -> ByteString
ffSetToFixedLengthBS :: forall b a. (FutureFlag b, Integral a) => 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 = case Word8
t of
        Word8
1 -> Get Pkt
getPKESK
        Word8
2 -> SignaturePayload -> Pkt
SignaturePkt (SignaturePayload -> Pkt) -> Get SignaturePayload -> Get Pkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SignaturePayload
forall t. Binary t => Get t
get
        Word8
3 -> Get Pkt
getSKESK
        Word8
4 -> Get Pkt
getOPS
        Word8
5 -> Int64 -> Get Pkt
getSecretKey Int64
len
        Word8
6 -> SomePKPayload -> Pkt
PublicKeyPkt (SomePKPayload -> Pkt) -> Get SomePKPayload -> Get Pkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SomePKPayload
getPKPayload
        Word8
7 -> Int64 -> Get Pkt
getSecretSubkey Int64
len
        Word8
8 -> Int64 -> Get Pkt
getCompressedData Int64
len
        Word8
9 -> ByteString -> Pkt
SymEncDataPkt (ByteString -> Pkt) -> Get ByteString -> Get Pkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
getLazyByteString Int64
len
        Word8
10 -> ByteString -> Pkt
MarkerPkt (ByteString -> Pkt) -> Get ByteString -> Get Pkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
getLazyByteString Int64
len
        Word8
11 -> Int64 -> Get Pkt
getLiteralData Int64
len
        Word8
12 -> ByteString -> Pkt
TrustPkt (ByteString -> Pkt) -> Get ByteString -> Get Pkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
getLazyByteString Int64
len
        Word8
13 ->
            Text -> Pkt
UserIdPkt (Text -> Pkt) -> (ByteString -> Text) -> ByteString -> Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode
                (ByteString -> Pkt) -> Get ByteString -> Get Pkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len)
        Word8
14 -> Int64 -> Get Pkt
getPublicSubkey Int64
len
        Word8
17 -> Int64 -> Get Pkt
getPublicAttribute Int64
len
        Word8
18 -> Int64 -> Get Pkt
getSEIPD Int64
len
        Word8
19 -> ByteString -> Pkt
ModificationDetectionCodePkt (ByteString -> Pkt) -> Get ByteString -> Get Pkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
getLazyByteString Int64
20
        Word8
21 -> ByteString -> Pkt
PaddingPkt (ByteString -> Pkt) -> Get ByteString -> Get Pkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
getLazyByteString Int64
len
        Word8
_ -> Word8 -> ByteString -> Pkt
OtherPacketPkt Word8
t (ByteString -> Pkt) -> Get ByteString -> Get Pkt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
getLazyByteString Int64
len

    getPKESK :: Get Pkt
    getPKESK :: Get Pkt
getPKESK = 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
err -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
            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
err -> String -> Get Pkt
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err

    getSKESK :: Get Pkt
    getSKESK :: Get Pkt
getSKESK = do
        pv <- Get Word8
getWord8
        if pv == 6
            then getSKESKV6
            else
                if pv == 4
                    then getSKESKV4
                    else fail ("unsupported SKESK packet version " ++ show pv)
      where
        getSKESKV6 :: Get Pkt
getSKESKV6 = do
            let getV6SKESKParams :: Get (SymmetricAlgorithm, AEADAlgorithm, S2K, ByteString)
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)
            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
                        )
                    )
        getSKESKV4 :: Get Pkt
getSKESKV4 = 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
                        )
                    )

    getOPS :: Get Pkt
    getOPS :: Get Pkt
getOPS = do
        pv <- Get Word8
getWord8
        sigtype <- toFVal <$> getWord8
        ha <- toFVal <$> getWord8
        pka <- toFVal <$> getWord8
        case pv of
            Word8
3 -> Word8 -> SigType -> HashAlgorithm -> PubKeyAlgorithm -> Get Pkt
getOPSV3 Word8
pv SigType
sigtype HashAlgorithm
ha PubKeyAlgorithm
pka
            Word8
6 -> Word8 -> SigType -> HashAlgorithm -> PubKeyAlgorithm -> Get Pkt
getOPSV6 Word8
pv SigType
sigtype HashAlgorithm
ha PubKeyAlgorithm
pka
            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)
      where
        getOPSV3
            :: PacketVersion
            -> SigType
            -> HashAlgorithm
            -> PubKeyAlgorithm
            -> Get Pkt
        getOPSV3 :: Word8 -> SigType -> HashAlgorithm -> PubKeyAlgorithm -> Get Pkt
getOPSV3 Word8
pv SigType
sigtype HashAlgorithm
ha PubKeyAlgorithm
pka = do
            skeyid <- Int64 -> Get ByteString
getLazyByteString Int64
8
            nested <- getWord8 >>= parseOPSNestedFlag
            return $
                OnePassSignaturePkt
                    ( OPSPayloadV3Packet
                        ( OPSPayloadV3
                            pv
                            sigtype
                            ha
                            pka
                            (EightOctetKeyId skeyid)
                            nested
                        )
                    )
        getOPSV6
            :: PacketVersion
            -> SigType
            -> HashAlgorithm
            -> PubKeyAlgorithm
            -> Get Pkt
        getOPSV6 :: Word8 -> SigType -> HashAlgorithm -> PubKeyAlgorithm -> Get Pkt
getOPSV6 Word8
pv SigType
sigtype HashAlgorithm
ha PubKeyAlgorithm
pka = 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
                        )
                    )

    getSecretKey :: ByteOffset -> Get Pkt
    getSecretKey :: Int64 -> Get Pkt
getSecretKey Int64
len = do
        bs <- Int64 -> Get ByteString
getLazyByteString Int64
len
        case runGetOrFail getSecretKeyParser 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
"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
      where
        getSecretKeyParser :: Get Pkt
getSecretKeyParser = do
            pkp <- Get SomePKPayload
getPKPayload
            ska <- getSKAddendum pkp
            return $ SecretKeyPkt pkp ska

    getSecretSubkey :: ByteOffset -> Get Pkt
    getSecretSubkey :: Int64 -> Get Pkt
getSecretSubkey Int64
len = do
        bs <- Int64 -> Get ByteString
getLazyByteString Int64
len
        case runGetOrFail getSecretSubkeyParser 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
"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
      where
        getSecretSubkeyParser :: Get Pkt
getSecretSubkeyParser = do
            pkp <- Get SomePKPayload
getPKPayload
            ska <- getSKAddendum pkp
            return $ SecretSubkeyPkt pkp ska

    getCompressedData :: ByteOffset -> Get Pkt
    getCompressedData :: Int64 -> Get Pkt
getCompressedData Int64
len = do
        ca <- Get Word8
getWord8
        cdata <- getLazyByteString (len - 1)
        return $ CompressedDataPkt (toFVal ca) cdata

    getLiteralData :: ByteOffset -> Get Pkt
    getLiteralData :: Int64 -> Get Pkt
getLiteralData Int64
len = 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

    getPublicSubkey :: ByteOffset -> Get Pkt
    getPublicSubkey :: Int64 -> Get Pkt
getPublicSubkey Int64
len = do
        bs <- Int64 -> Get ByteString
getLazyByteString Int64
len
        case runGetOrFail getPublicSubkeyParser 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
"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
      where
        getPublicSubkeyParser :: Get Pkt
getPublicSubkeyParser = do
            pkp <- Get SomePKPayload
getPKPayload
            return $ PublicSubkeyPkt pkp

    getPublicAttribute :: ByteOffset -> Get Pkt
    getPublicAttribute :: Int64 -> Get Pkt
getPublicAttribute Int64
len = 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

    getSEIPD :: ByteOffset -> Get Pkt
    getSEIPD :: Int64 -> Get Pkt
getSEIPD Int64
len = 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)

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 Pkt
pkt = case Pkt
pkt of
    PKESKPkt (PKESKPayloadV3Packet PKESKPayloadV3
payload) -> PKESKPayloadV3 -> Put
putPKESKV3 PKESKPayloadV3
payload
    PKESKPkt (PKESKPayloadV6Packet PKESKPayloadV6
payload) -> PKESKPayloadV6 -> Put
putPKESKV6 PKESKPayloadV6
payload
    SignaturePkt SignaturePayload
sp -> SignaturePayload -> Put
putSignature SignaturePayload
sp
    SKESKPkt (SKESKPayloadV4Packet SKESKPayloadV4
payload) -> SKESKPayloadV4 -> Put
putSKESKV4 SKESKPayloadV4
payload
    SKESKPkt (SKESKPayloadV6Packet SKESKPayloadV6
payload) -> SKESKPayloadV6 -> Put
putSKESKV6 SKESKPayloadV6
payload
    OnePassSignaturePkt (OPSPayloadV3Packet OPSPayloadV3
payload) -> OPSPayloadV3 -> Put
putOPSV3 OPSPayloadV3
payload
    OnePassSignaturePkt (OPSPayloadV6Packet OPSPayloadV6
payload) -> OPSPayloadV6 -> Put
putOPSV6 OPSPayloadV6
payload
    SecretKeyPkt SomePKPayload
pkp SKAddendum
ska -> SomePKPayload -> SKAddendum -> Put
putSecretKey SomePKPayload
pkp SKAddendum
ska
    PublicKeyPkt SomePKPayload
pkp -> SomePKPayload -> Put
putPublicKey SomePKPayload
pkp
    SecretSubkeyPkt SomePKPayload
pkp SKAddendum
ska -> SomePKPayload -> SKAddendum -> Put
putSecretSubkey SomePKPayload
pkp SKAddendum
ska
    CompressedDataPkt CompressionAlgorithm
ca ByteString
cdata -> CompressionAlgorithm -> ByteString -> Put
putCompressedData CompressionAlgorithm
ca ByteString
cdata
    SymEncDataPkt ByteString
b -> ByteString -> Put
putSymEncData ByteString
b
    MarkerPkt ByteString
b -> ByteString -> Put
putMarker ByteString
b
    LiteralDataPkt LiteralDataType
dt ByteString
fn ThirtyTwoBitTimeStamp
ts ByteString
b -> LiteralDataType
-> ByteString -> ThirtyTwoBitTimeStamp -> ByteString -> Put
putLiteralData LiteralDataType
dt ByteString
fn ThirtyTwoBitTimeStamp
ts ByteString
b
    TrustPkt ByteString
b -> ByteString -> Put
putTrust ByteString
b
    UserIdPkt Text
u -> Text -> Put
putUserId Text
u
    PublicSubkeyPkt SomePKPayload
pkp -> SomePKPayload -> Put
putPublicSubkey SomePKPayload
pkp
    UserAttributePkt [UserAttrSubPacket]
us -> [UserAttrSubPacket] -> Put
putUserAttribute [UserAttrSubPacket]
us
    SymEncIntegrityProtectedDataPkt (SEIPD1 Word8
pv ByteString
b) -> Word8 -> ByteString -> Put
putSEIPDV1 Word8
pv ByteString
b
    SymEncIntegrityProtectedDataPkt
        (SEIPD2 SymmetricAlgorithm
symalgo AEADAlgorithm
aeadalgo Word8
chunkSize Salt
salt ByteString
b) -> SymmetricAlgorithm
-> AEADAlgorithm -> Word8 -> Salt -> ByteString -> Put
putSEIPDV2 SymmetricAlgorithm
symalgo AEADAlgorithm
aeadalgo Word8
chunkSize Salt
salt ByteString
b
    ModificationDetectionCodePkt ByteString
hash -> ByteString -> Put
putModificationDetectionCode ByteString
hash
    PaddingPkt ByteString
padding -> ByteString -> Put
putPadding ByteString
padding
    OtherPacketPkt Word8
t ByteString
payload -> Word8 -> ByteString -> Put
putOtherPacket Word8
t ByteString
payload
    BrokenPacketPkt String
_ Word8
t ByteString
payload -> Word8 -> ByteString -> Put
putOtherPacket Word8
t ByteString
payload

putPKESKV3 :: PKESKPayloadV3 -> Put
putPKESKV3 :: PKESKPayloadV3 -> Put
putPKESKV3 (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
3
    ByteString -> Put
putLazyByteString (EightOctetKeyId -> ByteString
unEOKI EightOctetKeyId
eokeyid)
    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

putPKESKV6 :: PKESKPayloadV6 -> Put
putPKESKV6 :: PKESKPayloadV6 -> Put
putPKESKV6 (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

putSignature :: SignaturePayload -> Put
putSignature :: SignaturePayload -> Put
putSignature 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

putSKESKV4 :: SKESKPayloadV4 -> Put
putSKESKV4 :: SKESKPayloadV4 -> Put
putSKESKV4 (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

putSKESKV6 :: SKESKPayloadV6 -> Put
putSKESKV6 :: SKESKPayloadV6 -> Put
putSKESKV6 (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

putOPSV3 :: OPSPayloadV3 -> Put
putOPSV3 :: OPSPayloadV3 -> Put
putOPSV3 (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
                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

putOPSV6 :: OPSPayloadV6 -> Put
putOPSV6 :: OPSPayloadV6 -> Put
putOPSV6 (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

putSecretKey :: SomePKPayload -> SKAddendum -> Put
putSecretKey :: SomePKPayload -> SKAddendum -> Put
putSecretKey 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

putPublicKey :: SomePKPayload -> Put
putPublicKey :: SomePKPayload -> Put
putPublicKey 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

putSecretSubkey :: SomePKPayload -> SKAddendum -> Put
putSecretSubkey :: SomePKPayload -> SKAddendum -> Put
putSecretSubkey 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

putCompressedData :: CompressionAlgorithm -> BL.ByteString -> Put
putCompressedData :: CompressionAlgorithm -> ByteString -> Put
putCompressedData 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

putSymEncData :: BL.ByteString -> Put
putSymEncData :: ByteString -> Put
putSymEncData 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

putMarker :: BL.ByteString -> Put
putMarker :: ByteString -> Put
putMarker 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

putLiteralData
    :: LiteralDataType
    -> FileName
    -> ThirtyTwoBitTimeStamp
    -> BL.ByteString
    -> Put
putLiteralData :: LiteralDataType
-> ByteString -> ThirtyTwoBitTimeStamp -> ByteString -> Put
putLiteralData LiteralDataType
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)
-> (LiteralDataType -> Word8) -> LiteralDataType -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiteralDataType -> Word8
forall a. FutureVal a => a -> Word8
fromFVal (LiteralDataType -> Word8) -> LiteralDataType -> Word8
forall a b. (a -> b) -> a -> b
$ LiteralDataType
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

putTrust :: BL.ByteString -> Put
putTrust :: ByteString -> Put
putTrust 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

putUserId :: Text -> Put
putUserId :: Text -> Put
putUserId 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

putPublicSubkey :: SomePKPayload -> Put
putPublicSubkey :: SomePKPayload -> Put
putPublicSubkey 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

putUserAttribute :: [UserAttrSubPacket] -> Put
putUserAttribute :: [UserAttrSubPacket] -> Put
putUserAttribute [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

putSEIPDV1 :: Word8 -> BL.ByteString -> Put
putSEIPDV1 :: Word8 -> ByteString -> Put
putSEIPDV1 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
    ByteString -> Put
putLazyByteString ByteString
b

putSEIPDV2
    :: SymmetricAlgorithm
    -> AEADAlgorithm
    -> Word8
    -> Salt
    -> BL.ByteString
    -> Put
putSEIPDV2 :: SymmetricAlgorithm
-> AEADAlgorithm -> Word8 -> Salt -> ByteString -> Put
putSEIPDV2 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

putModificationDetectionCode :: BL.ByteString -> Put
putModificationDetectionCode :: ByteString -> Put
putModificationDetectionCode 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

putPadding :: BL.ByteString -> Put
putPadding :: ByteString -> Put
putPadding ByteString
padding = do
    Word8 -> Put
putWord8 (Word8
0xc0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
21)
    ByteString -> Put
putLengthThenPayload ByteString
padding

putOtherPacket :: Word8 -> BL.ByteString -> Put
putOtherPacket :: Word8 -> ByteString -> Put
putOtherPacket 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

{- | 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
    putPartialLengthPayload :: ByteString -> Put
    putPartialLengthPayload :: ByteString -> Put
putPartialLengthPayload ByteString
payload = do
        leftover <- (ByteString -> Bool)
-> (ByteString -> PutM ByteString) -> ByteString -> PutM ByteString
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> m a) -> a -> m a
iterateUntilM ByteString -> Bool
done ByteString -> PutM ByteString
emitChunk ByteString
payload
        putPacketLength (fromIntegral (BL.length leftover))
        putLazyByteString leftover
      where
        maxPartialChunkSize :: Int64
        maxPartialChunkSize :: Int64
maxPartialChunkSize = Int64
1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` (Int
30 :: Int)
        done :: ByteString -> Bool
        done :: ByteString -> Bool
done ByteString
p = ByteString -> Int64
BL.length ByteString
p Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
maxPartialChunkSize
        emitChunk :: ByteString -> PutM ByteString
emitChunk ByteString
p = do
            let (ByteString
chunk, ByteString
rest) = Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt Int64
maxPartialChunkSize ByteString
p
            Word8 -> Put
putPartialLength Word8
30
            ByteString -> Put
putLazyByteString ByteString
chunk
            ByteString -> PutM ByteString
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
rest

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.EdSigningCurve25519
                (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.EdSigningCurve25519 ->
            EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey EdSigningCurve
P.EdSigningCurve25519
                (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.EdSigningCurve448 ->
            EdSigningCurve -> EdPoint -> PKey
EdDSAPubKey EdSigningCurve
P.EdSigningCurve448
                (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.EdSigningCurve25519
                (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.EdSigningCurve448
                (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.EdSigningCurve25519
            (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.EdSigningCurve448
            (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
MLKEM768X25519 = ByteString -> PKey
MLKEMPubKey (ByteString -> PKey)
-> (ByteString -> ByteString) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> PKey) -> Get ByteString -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
getPubkey PubKeyAlgorithm
MLKEM1024X448 = ByteString -> PKey
MLKEMPubKey (ByteString -> PKey)
-> (ByteString -> ByteString) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> PKey) -> Get ByteString -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
getPubkey PubKeyAlgorithm
MLDSA65Ed25519 = ByteString -> PKey
MLDSAPubKey (ByteString -> PKey)
-> (ByteString -> ByteString) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> PKey) -> Get ByteString -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
getPubkey PubKeyAlgorithm
MLDSA87Ed448 = ByteString -> PKey
MLDSAPubKey (ByteString -> PKey)
-> (ByteString -> ByteString) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> PKey) -> Get ByteString -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
getPubkey PubKeyAlgorithm
SLHDSASHAKE128s = ByteString -> PKey
SLHDSAPubKey (ByteString -> PKey)
-> (ByteString -> ByteString) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> PKey) -> Get ByteString -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
getPubkey PubKeyAlgorithm
SLHDSASHAKE128f = ByteString -> PKey
SLHDSAPubKey (ByteString -> PKey)
-> (ByteString -> ByteString) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> PKey) -> Get ByteString -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
getPubkey PubKeyAlgorithm
SLHDSASHAKE256s = ByteString -> PKey
SLHDSAPubKey (ByteString -> PKey)
-> (ByteString -> ByteString) -> ByteString -> PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> PKey) -> Get ByteString -> Get PKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
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.EdSigningCurve25519
                (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.EdSigningCurve448
                (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.EdSigningCurve25519
                (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.EdSigningCurve448
                (NativeEPoint (EPoint (os2ip bs)))
    | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
MLKEM768X25519 = do
        len <- Get Word32
getWord32be
        bs <- getByteString (fromIntegral len)
        return $ MLKEMPubKey bs
    | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
MLKEM1024X448 = do
        len <- Get Word32
getWord32be
        bs <- getByteString (fromIntegral len)
        return $ MLKEMPubKey bs
    | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
MLDSA65Ed25519 = do
        len <- Get Word32
getWord32be
        bs <- getByteString (fromIntegral len)
        return $ MLDSAPubKey bs
    | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
MLDSA87Ed448 = do
        len <- Get Word32
getWord32be
        bs <- getByteString (fromIntegral len)
        return $ MLDSAPubKey bs
    | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
SLHDSASHAKE128s = do
        len <- Get Word32
getWord32be
        bs <- getByteString (fromIntegral len)
        return $ SLHDSAPubKey bs
    | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
SLHDSASHAKE128f = do
        len <- Get Word32
getWord32be
        bs <- getByteString (fromIntegral len)
        return $ SLHDSAPubKey bs
    | PubKeyAlgorithm
pka PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
SLHDSASHAKE256s = do
        len <- Get Word32
getWord32be
        bs <- getByteString (fromIntegral len)
        return $ SLHDSAPubKey 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 (MLKEMPubKey ByteString
bs) = ByteString -> Put
putLazyByteString (ByteString -> ByteString
BL.fromStrict ByteString
bs)
putPubkey (MLDSAPubKey ByteString
bs) = ByteString -> Put
putLazyByteString (ByteString -> ByteString
BL.fromStrict ByteString
bs)
putPubkey (SLHDSAPubKey ByteString
bs) = ByteString -> Put
putLazyByteString (ByteString -> ByteString
BL.fromStrict 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.EdSigningCurve25519 = ECCCurve
Curve25519
    ed2ec EdSigningCurve
P.EdSigningCurve448 = 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.EdSigningCurve25519 (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.EdSigningCurve448 (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.EdSigningCurve25519 (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.EdSigningCurve448 (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 (MLKEMPubKey ByteString
bs) = do
    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 (MLDSAPubKey ByteString
bs) = do
    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 (SLHDSAPubKey ByteString
bs) = do
    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 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.EdSigningCurve25519 EdPoint
_ -> EdSigningCurve -> ByteString -> SKey
EdDSAPrivateKey EdSigningCurve
P.EdSigningCurve25519 (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.EdSigningCurve448 EdPoint
_ -> EdSigningCurve -> ByteString -> SKey
EdDSAPrivateKey EdSigningCurve
P.EdSigningCurve448 (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.EdSigningCurve25519 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.EdSigningCurve25519 (Int -> ByteString -> ByteString
leftPadTo Int
32 (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
x))
                    EdDSAPubKey EdSigningCurve
P.EdSigningCurve448 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.EdSigningCurve448 (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))
    | 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
MLKEM768X25519, PubKeyAlgorithm
MLKEM1024X448] = do
        if SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V6
            then do
                len <- Get Word32
getWord32be
                bs <- getByteString (fromIntegral len)
                return $ MLKEMPrivateKey bs
            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
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
MLDSA65Ed25519, PubKeyAlgorithm
MLDSA87Ed448] = do
        if SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V6
            then do
                len <- Get Word32
getWord32be
                bs <- getByteString (fromIntegral len)
                return $ MLDSAPrivateKey bs
            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
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyAlgorithm
SLHDSASHAKE128s, PubKeyAlgorithm
SLHDSASHAKE128f, PubKeyAlgorithm
SLHDSASHAKE256s] = do
        if SomePKPayload -> KeyVersion
_keyVersion SomePKPayload
pkp KeyVersion -> KeyVersion -> Bool
forall a. Eq a => a -> a -> Bool
== KeyVersion
V6
            then do
                len <- Get Word32
getWord32be
                bs <- getByteString (fromIntegral len)
                return $ SLHDSAPrivateKey bs
            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
    | 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.EdSigningCurve25519 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.EdSigningCurve448 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.EdSigningCurve25519 ByteString
sk) = Put -> Either String Put
forall a b. b -> Either a b
Right (ByteString -> Put
putByteString ByteString
sk)
putSKey (EdDSAPrivateKey EdSigningCurve
P.EdSigningCurve448 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 (MLKEMPrivateKey ByteString
sk) = Put -> Either String Put
forall a b. b -> Either a b
Right (ByteString -> Put
putLazyByteString (ByteString -> ByteString
BL.fromStrict ByteString
sk))
putSKey (MLDSAPrivateKey ByteString
sk) = Put -> Either String Put
forall a b. b -> Either a b
Right (ByteString -> Put
putLazyByteString (ByteString -> ByteString
BL.fromStrict ByteString
sk))
putSKey (SLHDSAPrivateKey ByteString
sk) = Put -> Either String Put
forall a b. b -> Either a b
Right (ByteString -> Put
putLazyByteString (ByteString -> ByteString
BL.fromStrict 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.EdSigningCurve25519 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.EdSigningCurve448 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.EdSigningCurve25519 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.EdSigningCurve448 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

putUnencryptedSKAddendum :: SomePKPayload -> SKey -> Put
putUnencryptedSKAddendum :: SomePKPayload -> SKey -> Put
putUnencryptedSKAddendum SomePKPayload
pkp 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
    -> SKAddendumV v
    -> Put
putSKAddendumForPKPayloadTyped :: forall (v :: KeyVersion). SomePKPayload -> SKAddendumV v -> Put
putSKAddendumForPKPayloadTyped SomePKPayload
pkp (SKAUnencryptedLegacy SKey
sk Word16
checksum) = do
    let skb :: ByteString
skb =
            Put -> ByteString
runPut
                ( 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
                )
    SomePKPayload -> SKey -> Put
putUnencryptedSKAddendum SomePKPayload
pkp SKey
sk
    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) =
    SomePKPayload -> SKey -> Put
putUnencryptedSKAddendum SomePKPayload
pkp SKey
sk
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 =
                            PktWithBytes -> WireRepRef -> ByteRange -> Int -> PktWithWireRep
PktWithWireRep
                                (ByteString -> Pkt -> PktWithBytes
PktWithBytes ByteString
raw Pkt
pkt)
                                (ParseState -> WireRepRef
psSource ParseState
state)
                                (Int64 -> Int64 -> ByteRange
ByteRange (ParseState -> Int64
psOffset ParseState
state) Int64
consumed)
                                (ParseState -> Int
psIndex ParseState
state)
                     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 =
    PktWithBytes -> WireRepRef -> ByteRange -> Int -> PktWithWireRep
PktWithWireRep
        (ByteString -> Pkt -> PktWithBytes
PktWithBytes (ParsedPacketChunk -> ByteString
ppcRaw ParsedPacketChunk
ppc) (ParsedPacketChunk -> Pkt
ppcValue ParsedPacketChunk
ppc))
        WireRepRef
src
        (ParsedPacketChunk -> ByteRange
ppcRange ParsedPacketChunk
ppc)
        (ParsedPacketChunk -> Int
ppcIndex 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)