    -- 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 bs :: ByteString
    bs
      | ByteString -> Bool
    BL.null ByteString
    bs = 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
    * 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 (ByteString -> Word8
    BL.head ByteString
    bs) 7)
      where
        go :: Word8 -> Int -> Word8
        go :: Word8 -> Int -> Word8
    go _ 0 = 7
        go n :: Word8
    n b :: Int
    b =
          if Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Word8
    n Int
    b
            then 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
    - 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 0 "lastLD placeholder")
        (Word8 -> ByteString -> Pkt
    OtherPacketPkt 0 "lastUIDorUAt placeholder")
        (Word8 -> ByteString -> Pkt
    OtherPacketPkt 0 "lastSig placeholder")
        (Word8 -> ByteString -> Pkt
    OtherPacketPkt 0 "lastPrimaryKey placeholder")
        (Word8 -> ByteString -> Pkt
    OtherPacketPkt 0 "lastSubkey placeholder")

    issuer :: Pkt -> Maybe EightOctetKeyId
    issuer :: Pkt -> Maybe EightOctetKeyId
    issuer (SignaturePkt (SigV4 _ _ _ _ usubs :: [SigSubPacket]
    usubs _ _)) =
      (SigSubPacket -> EightOctetKeyId)
    -> Maybe SigSubPacket -> Maybe EightOctetKeyId
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(SigSubPacket _ (Issuer i :: 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 _ = Maybe EightOctetKeyId
    forall a. Maybe a
    Nothing

    issuerFP :: Pkt -> Maybe TwentyOctetFingerprint
    issuerFP :: Pkt -> Maybe TwentyOctetFingerprint
    issuerFP (SignaturePkt (SigV4 _ _ _ hsubs :: [SigSubPacket]
    hsubs _ _ _)) =
      (SigSubPacket -> TwentyOctetFingerprint)
    -> Maybe SigSubPacket -> Maybe TwentyOctetFingerprint
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\(SigSubPacket _ (IssuerFingerprint _ i :: 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 _ = Maybe TwentyOctetFingerprint
    forall a. Maybe a
    Nothing

    pubkeyToMPIs :: PKey -> [MPI]
    pubkeyToMPIs :: PKey -> [MPI]
    pubkeyToMPIs (RSAPubKey (RSA_PublicKey k :: 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 k :: 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 f :: 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 p :: Integer
    p g :: Integer
    g y :: Integer
    y) = [Integer -> MPI
    MPI Integer
    p, Integer -> MPI
    MPI Integer
    g, Integer -> MPI
    MPI Integer
    y]
    pubkeyToMPIs (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey _ q :: PublicPoint
    q))) _ _) =
      [Integer -> MPI
    MPI (ByteString -> Integer
    forall ba. ByteArrayAccess ba => ba -> Integer
    os2ip (PublicPoint -> ByteString
    point2BS PublicPoint
    q))]
    pubkeyToMPIs (ECDHPubKey (EdDSAPubKey _ (EPoint x :: Integer
    x)) _ _) = [Integer -> MPI
    MPI Integer
    x]
    pubkeyToMPIs (ECDSAPubKey ((ECDSA_PublicKey (ECDSA.PublicKey _ q :: PublicPoint
    q)))) =
      [Integer -> MPI
    MPI (ByteString -> Integer
    forall ba. ByteArrayAccess ba => ba -> Integer
    os2ip (PublicPoint -> ByteString
    point2BS PublicPoint
    q))]
    pubkeyToMPIs (EdDSAPubKey _ (EPoint x :: Integer
    x)) = [Integer -> MPI
    MPI Integer
    x]

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

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

    point2BS :: ECCT.PublicPoint -> B.ByteString
    point2BS :: PublicPoint -> ByteString
    point2BS (ECCT.Point x :: Integer
    x y :: Integer
    y) = [ByteString] -> ByteString
    B.concat [Word8 -> ByteString
    B.singleton 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 ECCT.PointO = String -> ByteString
    forall a. HasCallStack => String -> a
    error "FIXME: point at infinity"

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

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

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

    curveFromCurve :: ECCT.Curve -> ECCCurve
    curveFromCurve :: Curve -> ECCCurve
    curveFromCurve c :: 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