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

    module Codec.Encryption.OpenPGP.Internal
      ( countBits
      , PktStreamContext(..)
      , issuer
      , issuerFP
      , emptyPSC
      , pubkeyToMPIs
      , multiplicativeInverse
      , curveoidBSToCurve
      , curveToCurveoidBS
      , point2BS
      , 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, isIssuerFPSSP, 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")

    issuer :: Pkt -> Maybe EightOctetKeyId
    issuer :: Pkt -> Maybe EightOctetKeyId
    issuer (SignaturePkt (SigV4 SigType
    _ PubKeyAlgorithm
    _ HashAlgorithm
    _ [SigSubPacket]
    _ [SigSubPacket]
    usubs Word16
    _ NonEmpty MPI
    _)) =
      (SigSubPacket -> EightOctetKeyId)
    -> Maybe SigSubPacket -> Maybe EightOctetKeyId
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(SigSubPacket Bool
    _ (Issuer EightOctetKeyId
    i)) -> EightOctetKeyId
    i) ((SigSubPacket -> Bool) -> [SigSubPacket] -> Maybe SigSubPacket
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find SigSubPacket -> Bool
    isIssuerSSP [SigSubPacket]
    usubs)
    issuer Pkt
    _ = Maybe EightOctetKeyId
    forall a. Maybe a
    Nothing

    issuerFP :: Pkt -> Maybe TwentyOctetFingerprint
    issuerFP :: Pkt -> Maybe TwentyOctetFingerprint
    issuerFP (SignaturePkt (SigV4 SigType
    _ PubKeyAlgorithm
    _ HashAlgorithm
    _ [SigSubPacket]
    hsubs [SigSubPacket]
    _ Word16
    _ NonEmpty MPI
    _)) =
      (SigSubPacket -> TwentyOctetFingerprint)
    -> Maybe SigSubPacket -> Maybe TwentyOctetFingerprint
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(SigSubPacket Bool
    _ (IssuerFingerprint Word8
    _ TwentyOctetFingerprint
    i)) -> TwentyOctetFingerprint
    i) ((SigSubPacket -> Bool) -> [SigSubPacket] -> Maybe SigSubPacket
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find SigSubPacket -> Bool
    isIssuerFPSSP [SigSubPacket]
    hsubs)
    issuerFP Pkt
    _ = Maybe TwentyOctetFingerprint
    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
    point2BS PublicPoint
    q))]
    pubkeyToMPIs (ECDHPubKey (EdDSAPubKey EdSigningCurve
    _ (EPoint Integer
    x)) HashAlgorithm
    _ SymmetricAlgorithm
    _) = [Integer -> MPI
    MPI Integer
    x]
    pubkeyToMPIs (ECDSAPubKey ((ECDSA_PublicKey (ECDSA.PublicKey Curve
    _ PublicPoint
    q)))) =
      [Integer -> MPI
    MPI (ByteString -> Integer
    forall ba. ByteArrayAccess ba => ba -> Integer
    os2ip (PublicPoint -> ByteString
    point2BS PublicPoint
    q))]
    pubkeyToMPIs (EdDSAPubKey EdSigningCurve
    _ (EPoint Integer
    x)) = [Integer -> MPI
    MPI 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
      | 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
    _ = [Char] -> Either [Char] ByteString
    forall a b. a -> Either a b
    Left [Char]
    "unknown curve"

    point2BS :: ECCT.PublicPoint -> B.ByteString
    point2BS :: PublicPoint -> ByteString
    point2BS (ECCT.Point Integer
    x Integer
    y) = [ByteString] -> ByteString
    B.concat [Word8 -> ByteString
    B.singleton Word8
    0x04, Integer -> ByteString
    forall ba. ByteArray ba => Integer -> ba
    i2osp Integer
    x, Integer -> ByteString
    forall ba. ByteArray ba => Integer -> ba
    i2osp Integer
    y] -- FIXME: check for length equality?
    point2BS PublicPoint
    ECCT.PointO = [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "FIXME: point at infinity"

    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
      | 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]

    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