-- Internal.hs: private utility functions and such
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}

module Codec.Encryption.OpenPGP.Internal
  ( countBits
  , PktStreamContext(..)
  , issuer
  , issuerFP
  , emptyPSC
  , leftPadTo
  , pubkeyToMPIs
  , multiplicativeInverse
  , curveoidBSToCurve
  , curveToCurveoidBS
  , point2MBS
  , curveoidBSToEdSigningCurve
  , edSigningCurveToCurveoidBS
  , curve2Curve
  , curveFromCurve
  ) where

import Crypto.Number.Serialize (i2osp, os2ip)
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Types as ECCT
import qualified Crypto.PubKey.RSA as RSA

import Data.Bits (testBit)
import qualified Data.ByteString as B
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.List (find)
import Data.Word (Word16, Word8)

import Codec.Encryption.OpenPGP.Ontology (isIssuerSSP, isSigCreationTime)
import Codec.Encryption.OpenPGP.Types

countBits :: ByteString -> Word16
countBits :: ByteString -> Word16
countBits ByteString
bs
  | ByteString -> Bool
BL.null ByteString
bs = Word16
0
  | Bool
otherwise =
    Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
bs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
8) Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int -> Word8
go (HasCallStack => ByteString -> Word8
ByteString -> Word8
BL.head ByteString
bs) Int
7)
  where
    go :: Word8 -> Int -> Word8
    go :: Word8 -> Int -> Word8
go Word8
_ Int
0 = Word8
7
    go Word8
n Int
b =
      if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
n Int
b
        then Word8
7 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b
        else Word8 -> Int -> Word8
go Word8
n (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

data PktStreamContext =
  PktStreamContext
    { PktStreamContext -> Pkt
lastLD :: Pkt
    , PktStreamContext -> Pkt
lastUIDorUAt :: Pkt
    , PktStreamContext -> Pkt
lastSig :: Pkt
    , PktStreamContext -> Pkt
lastPrimaryKey :: Pkt
    , PktStreamContext -> Pkt
lastSubkey :: Pkt
    }

emptyPSC :: PktStreamContext
emptyPSC :: PktStreamContext
emptyPSC =
  Pkt -> Pkt -> Pkt -> Pkt -> Pkt -> PktStreamContext
PktStreamContext
    (Word8 -> ByteString -> Pkt
OtherPacketPkt Word8
0 ByteString
"lastLD placeholder")
    (Word8 -> ByteString -> Pkt
OtherPacketPkt Word8
0 ByteString
"lastUIDorUAt placeholder")
    (Word8 -> ByteString -> Pkt
OtherPacketPkt Word8
0 ByteString
"lastSig placeholder")
    (Word8 -> ByteString -> Pkt
OtherPacketPkt Word8
0 ByteString
"lastPrimaryKey placeholder")
    (Word8 -> ByteString -> Pkt
OtherPacketPkt Word8
0 ByteString
"lastSubkey placeholder")

leftPadTo :: Int -> B.ByteString -> B.ByteString
leftPadTo :: Int -> ByteString -> ByteString
leftPadTo Int
targetLen ByteString
bs
  | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetLen = ByteString
bs
  | Bool
otherwise = 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

issuer :: Pkt -> Maybe EightOctetKeyId
issuer :: Pkt -> Maybe EightOctetKeyId
issuer Pkt
pkt =
  case Pkt -> Maybe IssuerExtractionCase
fromPktIssuerExtractionCase Pkt
pkt of
    Just IssuerExtractionCase
extractionCase ->
      (SigSubPacket -> Bool) -> [SigSubPacket] -> Maybe SigSubPacket
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find SigSubPacket -> Bool
isIssuerSSP (IssuerExtractionCase -> [SigSubPacket]
unhashedSubpackets IssuerExtractionCase
extractionCase) Maybe SigSubPacket
-> (SigSubPacket -> Maybe EightOctetKeyId) -> Maybe EightOctetKeyId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SigSubPacket -> Maybe EightOctetKeyId
issuerFromSubpacket
    Maybe IssuerExtractionCase
Nothing -> Maybe EightOctetKeyId
forall a. Maybe a
Nothing

issuerFP :: Pkt -> Maybe Fingerprint
issuerFP :: Pkt -> Maybe Fingerprint
issuerFP Pkt
pkt =
  case Pkt -> Maybe IssuerExtractionCase
fromPktIssuerExtractionCase Pkt
pkt of
    Just IssuerExtractionCase
extractionCase ->
      (SigSubPacket -> Bool) -> [SigSubPacket] -> Maybe SigSubPacket
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
        (IssuerFingerprintVersion -> SigSubPacket -> Bool
isIssuerFingerprintFor (IssuerExtractionCase -> IssuerFingerprintVersion
issuerFingerprintVersion IssuerExtractionCase
extractionCase))
        (IssuerExtractionCase -> [SigSubPacket]
hashedSubpackets IssuerExtractionCase
extractionCase) Maybe SigSubPacket
-> (SigSubPacket -> Maybe Fingerprint) -> Maybe Fingerprint
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      SigSubPacket -> Maybe Fingerprint
issuerFingerprintFromSubpacket
    Maybe IssuerExtractionCase
Nothing -> Maybe Fingerprint
forall a. Maybe a
Nothing

data IssuerExtractionCase where
  IssuerExtractionCaseV4 :: SignaturePayloadV 'SigPayloadV4 -> IssuerExtractionCase
  IssuerExtractionCaseV6 :: SignaturePayloadV 'SigPayloadV6 -> IssuerExtractionCase

fromPktIssuerExtractionCase :: Pkt -> Maybe IssuerExtractionCase
fromPktIssuerExtractionCase :: Pkt -> Maybe IssuerExtractionCase
fromPktIssuerExtractionCase Pkt
pkt =
  case Pkt -> Either [Char] SomeSignatureV
fromPktEitherSomeSignatureV Pkt
pkt of
    Right (SomeSignatureV (SignatureV4Packet SignaturePayloadV 'SigPayloadV4
payload)) ->
      IssuerExtractionCase -> Maybe IssuerExtractionCase
forall a. a -> Maybe a
Just (SignaturePayloadV 'SigPayloadV4 -> IssuerExtractionCase
IssuerExtractionCaseV4 SignaturePayloadV 'SigPayloadV4
payload)
    Right (SomeSignatureV (SignatureV6Packet SignaturePayloadV 'SigPayloadV6
payload)) ->
      IssuerExtractionCase -> Maybe IssuerExtractionCase
forall a. a -> Maybe a
Just (SignaturePayloadV 'SigPayloadV6 -> IssuerExtractionCase
IssuerExtractionCaseV6 SignaturePayloadV 'SigPayloadV6
payload)
    Either [Char] SomeSignatureV
_ -> Maybe IssuerExtractionCase
forall a. Maybe a
Nothing

hashedSubpackets :: IssuerExtractionCase -> [SigSubPacket]
hashedSubpackets :: IssuerExtractionCase -> [SigSubPacket]
hashedSubpackets (IssuerExtractionCaseV4 (SigPayloadV4Data SigType
_ PubKeyAlgorithm
_ HashAlgorithm
_ [SigSubPacket]
hsubs [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) = [SigSubPacket]
hsubs
hashedSubpackets (IssuerExtractionCaseV6 (SigPayloadV6Data SigType
_ PubKeyAlgorithm
_ HashAlgorithm
_ SignatureSalt
_ [SigSubPacket]
hsubs [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) = [SigSubPacket]
hsubs

unhashedSubpackets :: IssuerExtractionCase -> [SigSubPacket]
unhashedSubpackets :: IssuerExtractionCase -> [SigSubPacket]
unhashedSubpackets (IssuerExtractionCaseV4 (SigPayloadV4Data SigType
_ PubKeyAlgorithm
_ HashAlgorithm
_ [SigSubPacket]
_ [SigSubPacket]
usubs Word16
_ NonEmpty MPI
_)) = [SigSubPacket]
usubs
unhashedSubpackets (IssuerExtractionCaseV6 (SigPayloadV6Data SigType
_ PubKeyAlgorithm
_ HashAlgorithm
_ SignatureSalt
_ [SigSubPacket]
_ [SigSubPacket]
usubs Word16
_ NonEmpty MPI
_)) = [SigSubPacket]
usubs

issuerFingerprintVersion :: IssuerExtractionCase -> IssuerFingerprintVersion
issuerFingerprintVersion :: IssuerExtractionCase -> IssuerFingerprintVersion
issuerFingerprintVersion IssuerExtractionCaseV4 {} = IssuerFingerprintVersion
IssuerFingerprintV4
issuerFingerprintVersion IssuerExtractionCaseV6 {} = IssuerFingerprintVersion
IssuerFingerprintV6

isIssuerFingerprintFor :: IssuerFingerprintVersion -> SigSubPacket -> Bool
isIssuerFingerprintFor :: IssuerFingerprintVersion -> SigSubPacket -> Bool
isIssuerFingerprintFor IssuerFingerprintVersion
version (SigSubPacket Bool
_ (IssuerFingerprint IssuerFingerprintVersion
packetVersion Fingerprint
_)) =
  IssuerFingerprintVersion
packetVersion IssuerFingerprintVersion -> IssuerFingerprintVersion -> Bool
forall a. Eq a => a -> a -> Bool
== IssuerFingerprintVersion
version
isIssuerFingerprintFor IssuerFingerprintVersion
_ SigSubPacket
_ = Bool
False

issuerFingerprintFromSubpacket :: SigSubPacket -> Maybe Fingerprint
issuerFingerprintFromSubpacket :: SigSubPacket -> Maybe Fingerprint
issuerFingerprintFromSubpacket (SigSubPacket Bool
_ (IssuerFingerprint IssuerFingerprintVersion
_ Fingerprint
i)) = Fingerprint -> Maybe Fingerprint
forall a. a -> Maybe a
Just Fingerprint
i
issuerFingerprintFromSubpacket SigSubPacket
_ = Maybe Fingerprint
forall a. Maybe a
Nothing

issuerFromSubpacket :: SigSubPacket -> Maybe EightOctetKeyId
issuerFromSubpacket :: SigSubPacket -> Maybe EightOctetKeyId
issuerFromSubpacket (SigSubPacket Bool
_ (Issuer EightOctetKeyId
i)) = EightOctetKeyId -> Maybe EightOctetKeyId
forall a. a -> Maybe a
Just EightOctetKeyId
i
issuerFromSubpacket SigSubPacket
_ = Maybe EightOctetKeyId
forall a. Maybe a
Nothing

pubkeyToMPIs :: PKey -> [MPI]
pubkeyToMPIs :: PKey -> [MPI]
pubkeyToMPIs (RSAPubKey (RSA_PublicKey PublicKey
k)) =
  [Integer -> MPI
MPI (PublicKey -> Integer
RSA.public_n PublicKey
k), Integer -> MPI
MPI (PublicKey -> Integer
RSA.public_e PublicKey
k)]
pubkeyToMPIs (DSAPubKey (DSA_PublicKey PublicKey
k)) =
  [ (Params -> Integer) -> MPI
pkParams Params -> Integer
DSA.params_p
  , (Params -> Integer) -> MPI
pkParams Params -> Integer
DSA.params_q
  , (Params -> Integer) -> MPI
pkParams Params -> Integer
DSA.params_g
  , Integer -> MPI
MPI (Integer -> MPI) -> (PublicKey -> Integer) -> PublicKey -> MPI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Integer
DSA.public_y (PublicKey -> MPI) -> PublicKey -> MPI
forall a b. (a -> b) -> a -> b
$ PublicKey
k
  ]
  where
    pkParams :: (Params -> Integer) -> MPI
pkParams Params -> Integer
f = Integer -> MPI
MPI (Integer -> MPI) -> (PublicKey -> Integer) -> PublicKey -> MPI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> Integer
f (Params -> Integer)
-> (PublicKey -> Params) -> PublicKey -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Params
DSA.public_params (PublicKey -> MPI) -> PublicKey -> MPI
forall a b. (a -> b) -> a -> b
$ PublicKey
k
pubkeyToMPIs (ElGamalPubKey Integer
p Integer
g Integer
y) = [Integer -> MPI
MPI Integer
p, Integer -> MPI
MPI Integer
g, Integer -> MPI
MPI Integer
y]
pubkeyToMPIs (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey Curve
_ PublicPoint
q))) HashAlgorithm
_ SymmetricAlgorithm
_) =
  [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (PublicPoint -> ByteString
pointToBSOrError PublicPoint
q))]
pubkeyToMPIs (ECDHPubKey (EdDSAPubKey EdSigningCurve
_ EdPoint
ep) HashAlgorithm
_ SymmetricAlgorithm
_) = [Integer -> MPI
MPI (EdPoint -> Integer
edPointInteger EdPoint
ep)]
pubkeyToMPIs (ECDSAPubKey ((ECDSA_PublicKey (ECDSA.PublicKey Curve
_ PublicPoint
q)))) =
  [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (PublicPoint -> ByteString
pointToBSOrError PublicPoint
q))]
pubkeyToMPIs (EdDSAPubKey EdSigningCurve
_ EdPoint
ep) = [Integer -> MPI
MPI (EdPoint -> Integer
edPointInteger EdPoint
ep)]

edPointInteger :: EdPoint -> Integer
edPointInteger :: EdPoint -> Integer
edPointInteger (PrefixedNativeEPoint (EPoint Integer
x)) = Integer
x
edPointInteger (NativeEPoint (EPoint Integer
x)) = Integer
x

multiplicativeInverse :: Integral a => a -> a -> a
multiplicativeInverse :: forall a. Integral a => a -> a -> a
multiplicativeInverse a
_ a
1 = a
1
multiplicativeInverse a
q a
p = (a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
q a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
p
  where
    n :: a
n = a
p a -> a -> a
forall a. Num a => a -> a -> a
- a -> a -> a
forall a. Integral a => a -> a -> a
multiplicativeInverse a
p (a
q a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
p)

curveoidBSToCurve :: B.ByteString -> Either String ECCCurve
curveoidBSToCurve :: ByteString -> Either [Char] ECCCurve
curveoidBSToCurve ByteString
oidbs
  | [Word8] -> ByteString
B.pack [Word8
0x2A, Word8
0x86, Word8
0x48, Word8
0xCE, Word8
0x3D, Word8
0x03, Word8
0x01, Word8
0x07] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
oidbs =
    ECCCurve -> Either [Char] ECCCurve
forall a b. b -> Either a b
Right (ECCCurve -> Either [Char] ECCCurve)
-> ECCCurve -> Either [Char] ECCCurve
forall a b. (a -> b) -> a -> b
$ ECCCurve
NISTP256 -- ECCT.getCurveByName ECCT.SEC_p256r1
  | [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x81, Word8
0x04, Word8
0x00, Word8
0x22] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
oidbs = ECCCurve -> Either [Char] ECCCurve
forall a b. b -> Either a b
Right (ECCCurve -> Either [Char] ECCCurve)
-> ECCCurve -> Either [Char] ECCCurve
forall a b. (a -> b) -> a -> b
$ ECCCurve
NISTP384 -- ECCT.getCurveByName ECCT.SEC_p384r1
  | [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x81, Word8
0x04, Word8
0x00, Word8
0x23] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
oidbs = ECCCurve -> Either [Char] ECCCurve
forall a b. b -> Either a b
Right (ECCCurve -> Either [Char] ECCCurve)
-> ECCCurve -> Either [Char] ECCCurve
forall a b. (a -> b) -> a -> b
$ ECCCurve
NISTP521 -- ECCT.getCurveByName ECCT.SEC_p521r1
  | [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x06, Word8
0x01, Word8
0x04, Word8
0x01, Word8
0x97, Word8
0x55, Word8
0x01, Word8
0x05, Word8
0x01] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
oidbs =
    ECCCurve -> Either [Char] ECCCurve
forall a b. b -> Either a b
Right ECCCurve
Curve25519
  | [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x65, Word8
0x6F] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
oidbs =
    ECCCurve -> Either [Char] ECCCurve
forall a b. b -> Either a b
Right ECCCurve
Curve448
  | Bool
otherwise = [Char] -> Either [Char] ECCCurve
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ECCCurve)
-> [Char] -> Either [Char] ECCCurve
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"unknown curve (...", [Word8] -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> [Word8]
B.unpack ByteString
oidbs), [Char]
")"]

curveToCurveoidBS :: ECCCurve -> Either String B.ByteString
curveToCurveoidBS :: ECCCurve -> Either [Char] ByteString
curveToCurveoidBS ECCCurve
NISTP256 =
  ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8
0x2A, Word8
0x86, Word8
0x48, Word8
0xCE, Word8
0x3D, Word8
0x03, Word8
0x01, Word8
0x07]
curveToCurveoidBS ECCCurve
NISTP384 = ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x81, Word8
0x04, Word8
0x00, Word8
0x22]
curveToCurveoidBS ECCCurve
NISTP521 = ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x81, Word8
0x04, Word8
0x00, Word8
0x23]
curveToCurveoidBS ECCCurve
Curve25519 =
  ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x06, Word8
0x01, Word8
0x04, Word8
0x01, Word8
0x97, Word8
0x55, Word8
0x01, Word8
0x05, Word8
0x01]
curveToCurveoidBS ECCCurve
Curve448 = ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x65, Word8
0x6F]
curveToCurveoidBS ECCCurve
_ = [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left [Char]
"unknown curve"

point2MBS :: ECCT.PublicPoint -> Maybe B.ByteString
point2MBS :: PublicPoint -> Maybe ByteString
point2MBS (ECCT.Point Integer
x Integer
y)
  | ByteString -> Bool
B.null ByteString
xb Bool -> Bool -> Bool
|| ByteString -> Bool
B.null ByteString
yb = Maybe ByteString
forall a. Maybe a
Nothing
  | ByteString -> Int
B.length ByteString
xb Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Int
B.length ByteString
yb = Maybe ByteString
forall a. Maybe a
Nothing
  | Bool
otherwise = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ([ByteString] -> ByteString
B.concat [Word8 -> ByteString
B.singleton Word8
0x04, ByteString
xb, ByteString
yb])
  where
    xb :: ByteString
xb = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
x
    yb :: ByteString
yb = Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
y
point2MBS PublicPoint
ECCT.PointO = Maybe ByteString
forall a. Maybe a
Nothing

pointToBSOrError :: ECCT.PublicPoint -> B.ByteString
pointToBSOrError :: PublicPoint -> ByteString
pointToBSOrError PublicPoint
point =
  case PublicPoint
point of
    PublicPoint
ECCT.PointO -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"OpenPGP forbids serializing the point at infinity"
    PublicPoint
_ ->
      case PublicPoint -> Maybe ByteString
point2MBS PublicPoint
point of
        Just ByteString
bs -> ByteString
bs
        Maybe ByteString
Nothing ->
          [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error
            [Char]
"OpenPGP EC point serialization requires equal non-empty coordinate widths"

curveoidBSToEdSigningCurve :: B.ByteString -> Either String EdSigningCurve
curveoidBSToEdSigningCurve :: ByteString -> Either [Char] EdSigningCurve
curveoidBSToEdSigningCurve ByteString
oidbs
  | [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x06, Word8
0x01, Word8
0x04, Word8
0x01, Word8
0xDA, Word8
0x47, Word8
0x0F, Word8
0x01] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
oidbs =
    EdSigningCurve -> Either [Char] EdSigningCurve
forall a b. b -> Either a b
Right EdSigningCurve
Ed25519
  | [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x65, Word8
0x71] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
oidbs =
    EdSigningCurve -> Either [Char] EdSigningCurve
forall a b. b -> Either a b
Right EdSigningCurve
Ed448
  | Bool
otherwise =
    [Char] -> Either [Char] EdSigningCurve
forall a b. a -> Either a b
Left ([Char] -> Either [Char] EdSigningCurve)
-> [Char] -> Either [Char] EdSigningCurve
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"unknown Edwards signing curve (...", [Word8] -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> [Word8]
B.unpack ByteString
oidbs), [Char]
")"]

edSigningCurveToCurveoidBS :: EdSigningCurve -> Either String B.ByteString
edSigningCurveToCurveoidBS :: EdSigningCurve -> Either [Char] ByteString
edSigningCurveToCurveoidBS EdSigningCurve
Ed25519 =
  ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x06, Word8
0x01, Word8
0x04, Word8
0x01, Word8
0xDA, Word8
0x47, Word8
0x0F, Word8
0x01]
edSigningCurveToCurveoidBS EdSigningCurve
Ed448 = ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack [Word8
0x2B, Word8
0x65, Word8
0x71]

curve2Curve :: ECCCurve -> ECCT.Curve
curve2Curve :: ECCCurve -> Curve
curve2Curve ECCCurve
NISTP256 = CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p256r1
curve2Curve ECCCurve
NISTP384 = CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p384r1
curve2Curve ECCCurve
NISTP521 = CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p521r1

curveFromCurve :: ECCT.Curve -> ECCCurve
curveFromCurve :: Curve -> ECCCurve
curveFromCurve Curve
c
  | Curve
c Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p256r1 = ECCCurve
NISTP256
  | Curve
c Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p384r1 = ECCCurve
NISTP384
  | Curve
c Curve -> Curve -> Bool
forall a. Eq a => a -> a -> Bool
== CurveName -> Curve
ECCT.getCurveByName CurveName
ECCT.SEC_p521r1 = ECCCurve
NISTP521