-- Signatures.hs: OpenPGP (RFC4880) signature verification
-- Copyright © 2012-2020  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
module Codec.Encryption.OpenPGP.Signatures
  ( verifySigWith
  , verifyAgainstKeyring
  , verifyAgainstKeys
  , verifyTKWith
  , signUserIDwithRSA
  , crossSignSubkeyWithRSA
  , signDataWithRSA
  ) where

import Control.Applicative ((<|>))
import Control.Error.Util (hush)
import Control.Lens ((^.), _1)
import Control.Monad (liftM2)

import Crypto.Error (eitherCryptoError)
import Crypto.Hash (hashWith)
import qualified Crypto.Hash.Algorithms as CHA
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.Ed25519 as Ed25519
import qualified Crypto.PubKey.RSA.PKCS15 as P15
import qualified Crypto.PubKey.RSA.Types as RSATypes

import Data.Bifunctor (first)
import Data.Binary.Put (runPut)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Either (isRight, lefts, rights)
import Data.Function (on)
import Data.IxSet.Typed ((@=))
import qualified Data.IxSet.Typed as IxSet
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import Data.Time.Clock (UTCTime(..), diffUTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)

import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)
import Codec.Encryption.OpenPGP.Internal
  ( PktStreamContext(..)
  , emptyPSC
  , issuer
  , issuerFP
  )
import Codec.Encryption.OpenPGP.Ontology
  ( isRevocationKeySSP
  , isRevokerP
  , isSubkeyBindingSig
  , isSubkeyRevocation
  )

import Codec.Encryption.OpenPGP.SerializeForSigs
  ( payloadForSig
  , putKeyforSigning
  , putPartialSigforSigning
  , putSigTrailer
  , putUforSigning
  )
import Codec.Encryption.OpenPGP.Types
import Data.Conduit.OpenPGP.Keyring.Instances ()

verifySigWith ::
     (Pkt -> Maybe UTCTime -> ByteString -> Either String Verification)
  -> Pkt
  -> PktStreamContext
  -> Maybe UTCTime
  -> Either String Verification -- FIXME: check expiration here?
verifySigWith :: (Pkt -> Maybe UTCTime -> ByteString -> Either String Verification)
-> Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either String Verification
verifySigWith vf :: Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
vf sig :: Pkt
sig@(SignaturePkt (SigV4 st :: SigType
st _ _ hs :: [SigSubPacket]
hs _ _ _)) state :: PktStreamContext
state mt :: Maybe UTCTime
mt = do
  Verification
v <- Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
vf Pkt
sig Maybe UTCTime
mt (SigType -> PktStreamContext -> ByteString
payloadForSig SigType
st PktStreamContext
state)
  (SigSubPacket -> Either String Bool)
-> [SigSubPacket] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PKPayload -> SigSubPacketPayload -> Either String Bool
checkI (Verification
v Verification
-> Getting PKPayload Verification PKPayload -> PKPayload
forall s a. s -> Getting a s a -> a
^. Getting PKPayload Verification PKPayload
Lens' Verification PKPayload
verificationSigner) (SigSubPacketPayload -> Either String Bool)
-> (SigSubPacket -> SigSubPacketPayload)
-> SigSubPacket
-> Either String Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigSubPacket -> SigSubPacketPayload
_sspPayload) [SigSubPacket]
hs
  Verification -> Either String Verification
forall (m :: * -> *) a. Monad m => a -> m a
return Verification
v
  where
    checkI :: PKPayload -> SigSubPacketPayload -> Either String Bool
checkI s :: PKPayload
s i :: SigSubPacketPayload
i@Issuer {} = Either String EightOctetKeyId
-> SigSubPacketPayload -> Either String Bool
checkIssuer (PKPayload -> Either String EightOctetKeyId
eightOctetKeyID PKPayload
s) SigSubPacketPayload
i
    checkI s :: PKPayload
s i :: SigSubPacketPayload
i@IssuerFingerprint {} = TwentyOctetFingerprint -> SigSubPacketPayload -> Either String Bool
checkIssuerFP (PKPayload -> TwentyOctetFingerprint
fingerprint PKPayload
s) SigSubPacketPayload
i
    checkI _ _ = Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
    checkIssuer ::
         Either String EightOctetKeyId
      -> SigSubPacketPayload
      -> Either String Bool
    checkIssuer :: Either String EightOctetKeyId
-> SigSubPacketPayload -> Either String Bool
checkIssuer (Right signer :: EightOctetKeyId
signer) (Issuer i :: EightOctetKeyId
i) =
      if EightOctetKeyId
signer EightOctetKeyId -> EightOctetKeyId -> Bool
forall a. Eq a => a -> a -> Bool
== EightOctetKeyId
i
        then Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
        else String -> Either String Bool
forall a b. a -> Either a b
Left "issuer subpacket does not match"
    checkIssuer (Left err :: String
err) (Issuer _) =
      String -> Either String Bool
forall a b. a -> Either a b
Left (String -> Either String Bool) -> String -> Either String Bool
forall a b. (a -> b) -> a -> b
$ "issuer subpacket cannot be checked (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"
    checkIssuer _ _ = Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
    checkIssuerFP ::
         TwentyOctetFingerprint -> SigSubPacketPayload -> Either String Bool
    checkIssuerFP :: TwentyOctetFingerprint -> SigSubPacketPayload -> Either String Bool
checkIssuerFP signer :: TwentyOctetFingerprint
signer (IssuerFingerprint _ i :: TwentyOctetFingerprint
i) =
      if TwentyOctetFingerprint
signer TwentyOctetFingerprint -> TwentyOctetFingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== TwentyOctetFingerprint
i
        then Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
        else String -> Either String Bool
forall a b. a -> Either a b
Left "issuer fingerprint subpacket does not match"
    checkIssuerFP _ _ = Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
verifySigWith _ _ _ _ = String -> Either String Verification
forall a b. a -> Either a b
Left "This should never happen (verifySigWith)."

verifyTKWith ::
     (Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification)
  -> Maybe UTCTime
  -> TK
  -> Either String TK
verifyTKWith :: (Pkt
 -> PktStreamContext -> Maybe UTCTime -> Either String Verification)
-> Maybe UTCTime -> TK -> Either String TK
verifyTKWith vsf :: Pkt
-> PktStreamContext -> Maybe UTCTime -> Either String Verification
vsf mt :: Maybe UTCTime
mt key :: TK
key = do
  [(PubKeyAlgorithm, TwentyOctetFingerprint)]
revokers <- TK -> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall a.
TK -> Either a [(PubKeyAlgorithm, TwentyOctetFingerprint)]
checkRevokers TK
key
  [SignaturePayload]
revs <- [(PubKeyAlgorithm, TwentyOctetFingerprint)]
-> TK -> Either String [SignaturePayload]
checkKeyRevocations [(PubKeyAlgorithm, TwentyOctetFingerprint)]
revokers TK
key
  let uids :: [(Text, [SignaturePayload])]
uids = ((Text, [SignaturePayload]) -> Bool)
-> [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Text, [SignaturePayload]) -> Bool)
-> (Text, [SignaturePayload])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SignaturePayload] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SignaturePayload] -> Bool)
-> ((Text, [SignaturePayload]) -> [SignaturePayload])
-> (Text, [SignaturePayload])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd) ([(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])])
-> ([(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])])
-> [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
checkUidSigs ([(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])])
-> [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
forall a b. (a -> b) -> a -> b
$ TK
key TK
-> Getting
     [(Text, [SignaturePayload])] TK [(Text, [SignaturePayload])]
-> [(Text, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Text, [SignaturePayload])] TK [(Text, [SignaturePayload])]
Lens' TK [(Text, [SignaturePayload])]
tkUIDs -- FIXME: check revocations here?
  let uats :: [([UserAttrSubPacket], [SignaturePayload])]
uats = (([UserAttrSubPacket], [SignaturePayload]) -> Bool)
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (([UserAttrSubPacket], [SignaturePayload]) -> Bool)
-> ([UserAttrSubPacket], [SignaturePayload])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SignaturePayload] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SignaturePayload] -> Bool)
-> (([UserAttrSubPacket], [SignaturePayload])
    -> [SignaturePayload])
-> ([UserAttrSubPacket], [SignaturePayload])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([UserAttrSubPacket], [SignaturePayload]) -> [SignaturePayload]
forall a b. (a, b) -> b
snd) ([([UserAttrSubPacket], [SignaturePayload])]
 -> [([UserAttrSubPacket], [SignaturePayload])])
-> ([([UserAttrSubPacket], [SignaturePayload])]
    -> [([UserAttrSubPacket], [SignaturePayload])])
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
checkUAtSigs ([([UserAttrSubPacket], [SignaturePayload])]
 -> [([UserAttrSubPacket], [SignaturePayload])])
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall a b. (a -> b) -> a -> b
$ TK
key TK
-> Getting
     [([UserAttrSubPacket], [SignaturePayload])]
     TK
     [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting
  [([UserAttrSubPacket], [SignaturePayload])]
  TK
  [([UserAttrSubPacket], [SignaturePayload])]
Lens' TK [([UserAttrSubPacket], [SignaturePayload])]
tkUAts -- FIXME: check revocations here?
  let subs :: [(Pkt, [SignaturePayload])]
subs = ((Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])])
-> [(Pkt, [SignaturePayload])] -> [(Pkt, [SignaturePayload])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])]
checkSub ([(Pkt, [SignaturePayload])] -> [(Pkt, [SignaturePayload])])
-> [(Pkt, [SignaturePayload])] -> [(Pkt, [SignaturePayload])]
forall a b. (a -> b) -> a -> b
$ TK
key TK
-> Getting
     [(Pkt, [SignaturePayload])] TK [(Pkt, [SignaturePayload])]
-> [(Pkt, [SignaturePayload])]
forall s a. s -> Getting a s a -> a
^. Getting [(Pkt, [SignaturePayload])] TK [(Pkt, [SignaturePayload])]
Lens' TK [(Pkt, [SignaturePayload])]
tkSubs -- FIXME: check revocations here?
  TK -> Either String TK
forall (m :: * -> *) a. Monad m => a -> m a
return ((PKPayload, Maybe SKAddendum)
-> [SignaturePayload]
-> [(Text, [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [(Pkt, [SignaturePayload])]
-> TK
TK (TK
key TK
-> Getting
     (PKPayload, Maybe SKAddendum) TK (PKPayload, Maybe SKAddendum)
-> (PKPayload, Maybe SKAddendum)
forall s a. s -> Getting a s a -> a
^. Getting
  (PKPayload, Maybe SKAddendum) TK (PKPayload, Maybe SKAddendum)
Lens' TK (PKPayload, Maybe SKAddendum)
tkKey) [SignaturePayload]
revs [(Text, [SignaturePayload])]
uids [([UserAttrSubPacket], [SignaturePayload])]
uats [(Pkt, [SignaturePayload])]
subs)
  where
    checkRevokers :: TK -> Either a [(PubKeyAlgorithm, TwentyOctetFingerprint)]
checkRevokers =
      [(PubKeyAlgorithm, TwentyOctetFingerprint)]
-> Either a [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall a b. b -> Either a b
Right ([(PubKeyAlgorithm, TwentyOctetFingerprint)]
 -> Either a [(PubKeyAlgorithm, TwentyOctetFingerprint)])
-> (TK -> [(PubKeyAlgorithm, TwentyOctetFingerprint)])
-> TK
-> Either a [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(PubKeyAlgorithm, TwentyOctetFingerprint)]]
-> [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(PubKeyAlgorithm, TwentyOctetFingerprint)]]
 -> [(PubKeyAlgorithm, TwentyOctetFingerprint)])
-> (TK -> [[(PubKeyAlgorithm, TwentyOctetFingerprint)]])
-> TK
-> [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]]
-> [[(PubKeyAlgorithm, TwentyOctetFingerprint)]]
forall a b. [Either a b] -> [b]
rights ([Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]]
 -> [[(PubKeyAlgorithm, TwentyOctetFingerprint)]])
-> (TK
    -> [Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]])
-> TK
-> [[(PubKeyAlgorithm, TwentyOctetFingerprint)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload
 -> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)])
-> [SignaturePayload]
-> [Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]]
forall a b. (a -> b) -> [a] -> [b]
map SignaturePayload
-> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]
verifyRevoker ([SignaturePayload]
 -> [Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]])
-> (TK -> [SignaturePayload])
-> TK
-> [Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SignaturePayload -> Bool
isRevokerP ([SignaturePayload] -> [SignaturePayload])
-> (TK -> [SignaturePayload]) -> TK -> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TK -> [SignaturePayload]
_tkRevs
    checkKeyRevocations ::
         [(PubKeyAlgorithm, TwentyOctetFingerprint)]
      -> TK
      -> Either String [SignaturePayload]
    checkKeyRevocations :: [(PubKeyAlgorithm, TwentyOctetFingerprint)]
-> TK -> Either String [SignaturePayload]
checkKeyRevocations rs :: [(PubKeyAlgorithm, TwentyOctetFingerprint)]
rs k :: TK
k =
      [Either String SignaturePayload]
-> Either String [SignaturePayload]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
Prelude.sequence ([Either String SignaturePayload]
 -> Either String [SignaturePayload])
-> ([SignaturePayload] -> [Either String SignaturePayload])
-> [SignaturePayload]
-> Either String [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SignaturePayload, Verification)
 -> [Either String SignaturePayload])
-> [(SignaturePayload, Verification)]
-> [Either String SignaturePayload]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(PubKeyAlgorithm, TwentyOctetFingerprint)]
-> (SignaturePayload, Verification)
-> [Either String SignaturePayload]
filterRevs [(PubKeyAlgorithm, TwentyOctetFingerprint)]
rs) ([(SignaturePayload, Verification)]
 -> [Either String SignaturePayload])
-> ([SignaturePayload] -> [(SignaturePayload, Verification)])
-> [SignaturePayload]
-> [Either String SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String (SignaturePayload, Verification)]
-> [(SignaturePayload, Verification)]
forall a b. [Either a b] -> [b]
rights ([Either String (SignaturePayload, Verification)]
 -> [(SignaturePayload, Verification)])
-> ([SignaturePayload]
    -> [Either String (SignaturePayload, Verification)])
-> [SignaturePayload]
-> [(SignaturePayload, Verification)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (SignaturePayload
 -> Either String (SignaturePayload, Verification))
-> [SignaturePayload]
-> [Either String (SignaturePayload, Verification)]
forall a b. (a -> b) -> [a] -> [b]
map (((Verification -> (SignaturePayload, Verification))
 -> Either String Verification
 -> Either String (SignaturePayload, Verification))
-> (SignaturePayload
    -> Verification -> (SignaturePayload, Verification))
-> (SignaturePayload -> Either String Verification)
-> SignaturePayload
-> Either String (SignaturePayload, Verification)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Verification -> (SignaturePayload, Verification))
-> Either String Verification
-> Either String (SignaturePayload, Verification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,) SignaturePayload -> Either String Verification
vSig) ([SignaturePayload] -> Either String [SignaturePayload])
-> [SignaturePayload] -> Either String [SignaturePayload]
forall a b. (a -> b) -> a -> b
$
      TK
k TK
-> Getting [SignaturePayload] TK [SignaturePayload]
-> [SignaturePayload]
forall s a. s -> Getting a s a -> a
^.
      Getting [SignaturePayload] TK [SignaturePayload]
Lens' TK [SignaturePayload]
tkRevs
    checkUidSigs :: [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
    checkUidSigs :: [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
checkUidSigs =
      ((Text, [SignaturePayload]) -> (Text, [SignaturePayload]))
-> [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
map
        (\(uid :: Text
uid, sps :: [SignaturePayload]
sps) ->
           (Text
uid, ([Either String SignaturePayload] -> [SignaturePayload]
forall a b. [Either a b] -> [b]
rights ([Either String SignaturePayload] -> [SignaturePayload])
-> ([SignaturePayload] -> [Either String SignaturePayload])
-> [SignaturePayload]
-> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload -> Either String SignaturePayload)
-> [SignaturePayload] -> [Either String SignaturePayload]
forall a b. (a -> b) -> [a] -> [b]
map (\sp :: SignaturePayload
sp -> (Verification -> SignaturePayload)
-> Either String Verification -> Either String SignaturePayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SignaturePayload -> Verification -> SignaturePayload
forall a b. a -> b -> a
const SignaturePayload
sp) ((Text, SignaturePayload) -> Either String Verification
vUid (Text
uid, SignaturePayload
sp)))) [SignaturePayload]
sps))
    checkUAtSigs ::
         [([UserAttrSubPacket], [SignaturePayload])]
      -> [([UserAttrSubPacket], [SignaturePayload])]
    checkUAtSigs :: [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
checkUAtSigs =
      (([UserAttrSubPacket], [SignaturePayload])
 -> ([UserAttrSubPacket], [SignaturePayload]))
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
map
        (\(uat :: [UserAttrSubPacket]
uat, sps :: [SignaturePayload]
sps) ->
           ([UserAttrSubPacket]
uat, ([Either String SignaturePayload] -> [SignaturePayload]
forall a b. [Either a b] -> [b]
rights ([Either String SignaturePayload] -> [SignaturePayload])
-> ([SignaturePayload] -> [Either String SignaturePayload])
-> [SignaturePayload]
-> [SignaturePayload]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignaturePayload -> Either String SignaturePayload)
-> [SignaturePayload] -> [Either String SignaturePayload]
forall a b. (a -> b) -> [a] -> [b]
map (\sp :: SignaturePayload
sp -> (Verification -> SignaturePayload)
-> Either String Verification -> Either String SignaturePayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SignaturePayload -> Verification -> SignaturePayload
forall a b. a -> b -> a
const SignaturePayload
sp) (([UserAttrSubPacket], SignaturePayload)
-> Either String Verification
vUAt ([UserAttrSubPacket]
uat, SignaturePayload
sp)))) [SignaturePayload]
sps))
    checkSub :: (Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])]
    checkSub :: (Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])]
checkSub (pkt :: Pkt
pkt, sps :: [SignaturePayload]
sps) =
      if Pkt -> [SignaturePayload] -> Bool
revokedSub Pkt
pkt [SignaturePayload]
sps
        then []
        else Pkt -> [SignaturePayload] -> [(Pkt, [SignaturePayload])]
checkSub' Pkt
pkt [SignaturePayload]
sps
    revokedSub :: Pkt -> [SignaturePayload] -> Bool
    revokedSub :: Pkt -> [SignaturePayload] -> Bool
revokedSub _ [] = Bool
False
    revokedSub p :: Pkt
p sigs :: [SignaturePayload]
sigs = (SignaturePayload -> Bool) -> [SignaturePayload] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pkt -> SignaturePayload -> Bool
vSubSig Pkt
p) ((SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SignaturePayload -> Bool
isSubkeyRevocation [SignaturePayload]
sigs)
    checkSub' :: Pkt -> [SignaturePayload] -> [(Pkt, [SignaturePayload])]
    checkSub' :: Pkt -> [SignaturePayload] -> [(Pkt, [SignaturePayload])]
checkSub' p :: Pkt
p sps :: [SignaturePayload]
sps =
      let goodsigs :: [SignaturePayload]
goodsigs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter (Pkt -> SignaturePayload -> Bool
vSubSig Pkt
p) ((SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SignaturePayload -> Bool
isSubkeyBindingSig [SignaturePayload]
sps)
       in if [SignaturePayload] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignaturePayload]
goodsigs
            then []
            else [(Pkt
p, [SignaturePayload]
goodsigs)]
    getHasheds :: SignaturePayload -> [SigSubPacket]
getHasheds (SigV4 _ _ _ ha :: [SigSubPacket]
ha _ _ _) = [SigSubPacket]
ha
    getHasheds _ = []
    filterRevs ::
         [(PubKeyAlgorithm, TwentyOctetFingerprint)]
      -> (SignaturePayload, Verification)
      -> [Either String SignaturePayload]
    filterRevs :: [(PubKeyAlgorithm, TwentyOctetFingerprint)]
-> (SignaturePayload, Verification)
-> [Either String SignaturePayload]
filterRevs vokers :: [(PubKeyAlgorithm, TwentyOctetFingerprint)]
vokers spv :: (SignaturePayload, Verification)
spv =
      case (SignaturePayload, Verification)
spv of
        (s :: SignaturePayload
s@(SigV4 SignatureDirectlyOnAKey _ _ _ _ _ _), _) -> [SignaturePayload -> Either String SignaturePayload
forall a b. b -> Either a b
Right SignaturePayload
s]
        (s :: SignaturePayload
s@(SigV4 KeyRevocationSig pka :: PubKeyAlgorithm
pka _ _ _ _ _), v :: Verification
v) ->
          if (Verification
v Verification
-> Getting PKPayload Verification PKPayload -> PKPayload
forall s a. s -> Getting a s a -> a
^. Getting PKPayload Verification PKPayload
Lens' Verification PKPayload
verificationSigner PKPayload -> PKPayload -> Bool
forall a. Eq a => a -> a -> Bool
== TK
key TK -> Getting PKPayload TK PKPayload -> PKPayload
forall s a. s -> Getting a s a -> a
^. ((PKPayload, Maybe SKAddendum)
 -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> TK -> Const PKPayload TK
Lens' TK (PKPayload, Maybe SKAddendum)
tkKey (((PKPayload, Maybe SKAddendum)
  -> Const PKPayload (PKPayload, Maybe SKAddendum))
 -> TK -> Const PKPayload TK)
-> ((PKPayload -> Const PKPayload PKPayload)
    -> (PKPayload, Maybe SKAddendum)
    -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> Getting PKPayload TK PKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PKPayload -> Const PKPayload PKPayload)
-> (PKPayload, Maybe SKAddendum)
-> Const PKPayload (PKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
_1) Bool -> Bool -> Bool
||
             ((PubKeyAlgorithm, TwentyOctetFingerprint) -> Bool)
-> [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
               (\(p :: PubKeyAlgorithm
p, f :: TwentyOctetFingerprint
f) ->
                  PubKeyAlgorithm
p PubKeyAlgorithm -> PubKeyAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyAlgorithm
pka Bool -> Bool -> Bool
&& TwentyOctetFingerprint
f TwentyOctetFingerprint -> TwentyOctetFingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== PKPayload -> TwentyOctetFingerprint
fingerprint (Verification
v Verification
-> Getting PKPayload Verification PKPayload -> PKPayload
forall s a. s -> Getting a s a -> a
^. Getting PKPayload Verification PKPayload
Lens' Verification PKPayload
verificationSigner))
               [(PubKeyAlgorithm, TwentyOctetFingerprint)]
vokers
            then [String -> Either String SignaturePayload
forall a b. a -> Either a b
Left "Key revoked"]
            else [SignaturePayload -> Either String SignaturePayload
forall a b. b -> Either a b
Right SignaturePayload
s]
        _ -> []
    vUid :: (Text, SignaturePayload) -> Either String Verification
    vUid :: (Text, SignaturePayload) -> Either String Verification
vUid (uid :: Text
uid, sp :: SignaturePayload
sp) =
      Pkt
-> PktStreamContext -> Maybe UTCTime -> Either String Verification
vsf
        (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
        PktStreamContext
emptyPSC
          { lastPrimaryKey :: Pkt
lastPrimaryKey = PKPayload -> Pkt
PublicKeyPkt (TK
key TK -> Getting PKPayload TK PKPayload -> PKPayload
forall s a. s -> Getting a s a -> a
^. ((PKPayload, Maybe SKAddendum)
 -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> TK -> Const PKPayload TK
Lens' TK (PKPayload, Maybe SKAddendum)
tkKey (((PKPayload, Maybe SKAddendum)
  -> Const PKPayload (PKPayload, Maybe SKAddendum))
 -> TK -> Const PKPayload TK)
-> ((PKPayload -> Const PKPayload PKPayload)
    -> (PKPayload, Maybe SKAddendum)
    -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> Getting PKPayload TK PKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PKPayload -> Const PKPayload PKPayload)
-> (PKPayload, Maybe SKAddendum)
-> Const PKPayload (PKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
_1)
          , lastUIDorUAt :: Pkt
lastUIDorUAt = Text -> Pkt
UserIdPkt Text
uid
          }
        Maybe UTCTime
mt
    vUAt ::
         ([UserAttrSubPacket], SignaturePayload) -> Either String Verification
    vUAt :: ([UserAttrSubPacket], SignaturePayload)
-> Either String Verification
vUAt (uat :: [UserAttrSubPacket]
uat, sp :: SignaturePayload
sp) =
      Pkt
-> PktStreamContext -> Maybe UTCTime -> Either String Verification
vsf
        (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
        PktStreamContext
emptyPSC
          { lastPrimaryKey :: Pkt
lastPrimaryKey = PKPayload -> Pkt
PublicKeyPkt (TK
key TK -> Getting PKPayload TK PKPayload -> PKPayload
forall s a. s -> Getting a s a -> a
^. ((PKPayload, Maybe SKAddendum)
 -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> TK -> Const PKPayload TK
Lens' TK (PKPayload, Maybe SKAddendum)
tkKey (((PKPayload, Maybe SKAddendum)
  -> Const PKPayload (PKPayload, Maybe SKAddendum))
 -> TK -> Const PKPayload TK)
-> ((PKPayload -> Const PKPayload PKPayload)
    -> (PKPayload, Maybe SKAddendum)
    -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> Getting PKPayload TK PKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PKPayload -> Const PKPayload PKPayload)
-> (PKPayload, Maybe SKAddendum)
-> Const PKPayload (PKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
_1)
          , lastUIDorUAt :: Pkt
lastUIDorUAt = [UserAttrSubPacket] -> Pkt
UserAttributePkt [UserAttrSubPacket]
uat
          }
        Maybe UTCTime
mt
    vSig :: SignaturePayload -> Either String Verification
    vSig :: SignaturePayload -> Either String Verification
vSig sp :: SignaturePayload
sp =
      Pkt
-> PktStreamContext -> Maybe UTCTime -> Either String Verification
vsf
        (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
        PktStreamContext
emptyPSC {lastPrimaryKey :: Pkt
lastPrimaryKey = PKPayload -> Pkt
PublicKeyPkt (TK
key TK -> Getting PKPayload TK PKPayload -> PKPayload
forall s a. s -> Getting a s a -> a
^. ((PKPayload, Maybe SKAddendum)
 -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> TK -> Const PKPayload TK
Lens' TK (PKPayload, Maybe SKAddendum)
tkKey (((PKPayload, Maybe SKAddendum)
  -> Const PKPayload (PKPayload, Maybe SKAddendum))
 -> TK -> Const PKPayload TK)
-> ((PKPayload -> Const PKPayload PKPayload)
    -> (PKPayload, Maybe SKAddendum)
    -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> Getting PKPayload TK PKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PKPayload -> Const PKPayload PKPayload)
-> (PKPayload, Maybe SKAddendum)
-> Const PKPayload (PKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
_1)}
        Maybe UTCTime
mt
    vSubSig :: Pkt -> SignaturePayload -> Bool
    vSubSig :: Pkt -> SignaturePayload -> Bool
vSubSig sk :: Pkt
sk sp :: SignaturePayload
sp =
      Either String Verification -> Bool
forall a b. Either a b -> Bool
isRight
        (Pkt
-> PktStreamContext -> Maybe UTCTime -> Either String Verification
vsf
           (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
           PktStreamContext
emptyPSC
             { lastPrimaryKey :: Pkt
lastPrimaryKey = PKPayload -> Pkt
PublicKeyPkt (TK
key TK -> Getting PKPayload TK PKPayload -> PKPayload
forall s a. s -> Getting a s a -> a
^. ((PKPayload, Maybe SKAddendum)
 -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> TK -> Const PKPayload TK
Lens' TK (PKPayload, Maybe SKAddendum)
tkKey (((PKPayload, Maybe SKAddendum)
  -> Const PKPayload (PKPayload, Maybe SKAddendum))
 -> TK -> Const PKPayload TK)
-> ((PKPayload -> Const PKPayload PKPayload)
    -> (PKPayload, Maybe SKAddendum)
    -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> Getting PKPayload TK PKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PKPayload -> Const PKPayload PKPayload)
-> (PKPayload, Maybe SKAddendum)
-> Const PKPayload (PKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
_1)
             , lastSubkey :: Pkt
lastSubkey = Pkt
sk
             }
           Maybe UTCTime
mt)
    verifyRevoker ::
         SignaturePayload
      -> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]
    verifyRevoker :: SignaturePayload
-> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]
verifyRevoker sp :: SignaturePayload
sp = do
      Verification
_ <- SignaturePayload -> Either String Verification
vSig SignaturePayload
sp
      [(PubKeyAlgorithm, TwentyOctetFingerprint)]
-> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        ((SigSubPacket -> (PubKeyAlgorithm, TwentyOctetFingerprint))
-> [SigSubPacket] -> [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall a b. (a -> b) -> [a] -> [b]
map (\(SigSubPacket _ (RevocationKey _ pka :: PubKeyAlgorithm
pka fp :: TwentyOctetFingerprint
fp)) -> (PubKeyAlgorithm
pka, TwentyOctetFingerprint
fp)) ([SigSubPacket] -> [(PubKeyAlgorithm, TwentyOctetFingerprint)])
-> ([SigSubPacket] -> [SigSubPacket])
-> [SigSubPacket]
-> [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (SigSubPacket -> Bool) -> [SigSubPacket] -> [SigSubPacket]
forall a. (a -> Bool) -> [a] -> [a]
filter SigSubPacket -> Bool
isRevocationKeySSP ([SigSubPacket] -> [(PubKeyAlgorithm, TwentyOctetFingerprint)])
-> [SigSubPacket] -> [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall a b. (a -> b) -> a -> b
$
         SignaturePayload -> [SigSubPacket]
getHasheds SignaturePayload
sp)

verifyAgainstKeyring ::
     Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
verifyAgainstKeyring :: Keyring
-> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
verifyAgainstKeyring kr :: Keyring
kr sig :: Pkt
sig mt :: Maybe UTCTime
mt payload :: ByteString
payload = do
  let ikeys :: Maybe Keyring
ikeys = (Keyring
kr Keyring -> EightOctetKeyId -> Keyring
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@=) (EightOctetKeyId -> Keyring)
-> Maybe EightOctetKeyId -> Maybe Keyring
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt -> Maybe EightOctetKeyId
issuer Pkt
sig
      ifpkeys :: Maybe Keyring
ifpkeys = (Keyring
kr Keyring -> TwentyOctetFingerprint -> Keyring
forall (ixs :: [*]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@=) (TwentyOctetFingerprint -> Keyring)
-> Maybe TwentyOctetFingerprint -> Maybe Keyring
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt -> Maybe TwentyOctetFingerprint
issuerFP Pkt
sig
  Keyring
keyset <- Either String Keyring
-> (Keyring -> Either String Keyring)
-> Maybe Keyring
-> Either String Keyring
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Keyring
forall a b. a -> Either a b
Left "issuer not found") Keyring -> Either String Keyring
forall a b. b -> Either a b
Right (Maybe Keyring
ifpkeys Maybe Keyring -> Maybe Keyring -> Maybe Keyring
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Keyring
ikeys)
  Keyring
potentialmatches <-
    if Keyring -> Bool
forall (ixs :: [*]) a. IxSet ixs a -> Bool
IxSet.null Keyring
keyset
      then String -> Either String Keyring
forall a b. a -> Either a b
Left "pubkey not found"
      else Keyring -> Either String Keyring
forall a b. b -> Either a b
Right Keyring
keyset
  [TK]
-> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
verifyAgainstKeys (Keyring -> [TK]
forall (ixs :: [*]) a. IxSet ixs a -> [a]
IxSet.toList Keyring
potentialmatches) Pkt
sig Maybe UTCTime
mt ByteString
payload

verifyAgainstKeys ::
     [TK] -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
verifyAgainstKeys :: [TK]
-> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
verifyAgainstKeys ks :: [TK]
ks sig :: Pkt
sig mt :: Maybe UTCTime
mt payload :: ByteString
payload = do
  let allrelevantpkps :: [PKPayload]
allrelevantpkps =
        (PKPayload -> Bool) -> [PKPayload] -> [PKPayload]
forall a. (a -> Bool) -> [a] -> [a]
filter
          (\x :: PKPayload
x ->
             (((PKPayload -> TwentyOctetFingerprint
fingerprint PKPayload
x TwentyOctetFingerprint -> TwentyOctetFingerprint -> Bool
forall a. Eq a => a -> a -> Bool
==) (TwentyOctetFingerprint -> Bool)
-> Maybe TwentyOctetFingerprint -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt -> Maybe TwentyOctetFingerprint
issuerFP Pkt
sig) Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) Bool -> Bool -> Bool
||
             (EightOctetKeyId -> EightOctetKeyId -> Bool
forall a. Eq a => a -> a -> Bool
(==) (EightOctetKeyId -> EightOctetKeyId -> Bool)
-> Maybe EightOctetKeyId -> Maybe (EightOctetKeyId -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pkt -> Maybe EightOctetKeyId
issuer Pkt
sig Maybe (EightOctetKeyId -> Bool)
-> Maybe EightOctetKeyId -> Maybe Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String EightOctetKeyId -> Maybe EightOctetKeyId
forall a b. Either a b -> Maybe b
hush (PKPayload -> Either String EightOctetKeyId
eightOctetKeyID PKPayload
x)) Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
==
             Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
          ((TK -> [PKPayload]) -> [TK] -> [PKPayload]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: TK
x -> (TK
x TK -> Getting PKPayload TK PKPayload -> PKPayload
forall s a. s -> Getting a s a -> a
^. ((PKPayload, Maybe SKAddendum)
 -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> TK -> Const PKPayload TK
Lens' TK (PKPayload, Maybe SKAddendum)
tkKey (((PKPayload, Maybe SKAddendum)
  -> Const PKPayload (PKPayload, Maybe SKAddendum))
 -> TK -> Const PKPayload TK)
-> ((PKPayload -> Const PKPayload PKPayload)
    -> (PKPayload, Maybe SKAddendum)
    -> Const PKPayload (PKPayload, Maybe SKAddendum))
-> Getting PKPayload TK PKPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PKPayload -> Const PKPayload PKPayload)
-> (PKPayload, Maybe SKAddendum)
-> Const PKPayload (PKPayload, Maybe SKAddendum)
forall s t a b. Field1 s t a b => Lens s t a b
_1) PKPayload -> [PKPayload] -> [PKPayload]
forall a. a -> [a] -> [a]
: ((Pkt, [SignaturePayload]) -> PKPayload)
-> [(Pkt, [SignaturePayload])] -> [PKPayload]
forall a b. (a -> b) -> [a] -> [b]
map (Pkt, [SignaturePayload]) -> PKPayload
forall b. (Pkt, b) -> PKPayload
subPKP (TK -> [(Pkt, [SignaturePayload])]
_tkSubs TK
x)) [TK]
ks)
  let results :: [Either String Verification]
results =
        (PKPayload -> Either String Verification)
-> [PKPayload] -> [Either String Verification]
forall a b. (a -> b) -> [a] -> [b]
map
          (\pkp :: PKPayload
pkp ->
             PKPayload
-> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
verifyAgainstKey'
               PKPayload
pkp
               Pkt
sig
               Maybe UTCTime
mt
               ByteString
payload)
          [PKPayload]
allrelevantpkps
  case [Either String Verification] -> [Verification]
forall a b. [Either a b] -> [b]
rights [Either String Verification]
results of
    [] -> String -> Either String Verification
forall a b. a -> Either a b
Left ((String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/") ([Either String Verification] -> [String]
forall a b. [Either a b] -> [a]
lefts [Either String Verification]
results))
    [r :: Verification
r] -> do
      Bool
_ <- Pkt -> Maybe UTCTime -> Either String Bool
isSignatureExpired Pkt
sig Maybe UTCTime
mt
      Verification -> Either String Verification
forall (m :: * -> *) a. Monad m => a -> m a
return Verification
r
    _ -> String -> Either String Verification
forall a b. a -> Either a b
Left "multiple successes; unexpected condition"
  where
    subPKP :: (Pkt, b) -> PKPayload
subPKP (pack :: Pkt
pack, _) = Pkt -> PKPayload
subPKP' Pkt
pack
    subPKP' :: Pkt -> PKPayload
subPKP' (PublicSubkeyPkt p :: PKPayload
p) = PKPayload
p
    subPKP' (SecretSubkeyPkt p :: PKPayload
p _) = PKPayload
p
    subPKP' _ = String -> PKPayload
forall a. HasCallStack => String -> a
error "This should never happen (subPKP')"

verifyAgainstKey' ::
     PKPayload -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
verifyAgainstKey' :: PKPayload
-> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
verifyAgainstKey' pkp :: PKPayload
pkp sig :: Pkt
sig mt :: Maybe UTCTime
mt payload :: ByteString
payload = do
--  FIXME: check flags
--  FIXME: check expiration time
      PKPayload
r <- Pkt
-> PKPayload
-> HashAlgorithm
-> ByteString
-> Either String PKPayload
verify'
               Pkt
sig
               PKPayload
pkp
               (Pkt -> HashAlgorithm
hashalgo Pkt
sig)
               (ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload Pkt
sig ByteString
payload))
--  FIXME: check signature hash against policy
--  FIXME: check pka against policy
      Verification -> Either String Verification
forall (m :: * -> *) a. Monad m => a -> m a
return (PKPayload -> SignaturePayload -> Verification
Verification PKPayload
r ((Signature -> SignaturePayload
_signaturePayload (Signature -> SignaturePayload)
-> (Pkt -> Signature) -> Pkt -> SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Signature
forall a. Packet a => Pkt -> a
fromPkt) Pkt
sig))
  where
    verify' :: Pkt
-> PKPayload
-> HashAlgorithm
-> ByteString
-> Either String PKPayload
verify' (SignaturePkt s :: SignaturePayload
s) pub :: PKPayload
pub@(PKPayload V4 _ _ _ pkey :: PKey
pkey) SHA1 pl :: ByteString
pl =
      (PubKeyAlgorithm, NonEmpty MPI)
-> SHA1
-> PKPayload
-> PKey
-> ByteString
-> Either String PKPayload
forall a b.
(Show a, HashAlgorithmASN1 a) =>
(PubKeyAlgorithm, NonEmpty MPI)
-> a -> b -> PKey -> ByteString -> Either String b
verify'' (SignaturePayload -> (PubKeyAlgorithm, NonEmpty MPI)
pkaAndMPIs SignaturePayload
s) SHA1
CHA.SHA1 PKPayload
pub PKey
pkey ByteString
pl
    verify' (SignaturePkt s :: SignaturePayload
s) pub :: PKPayload
pub@(PKPayload V4 _ _ _ pkey :: PKey
pkey) RIPEMD160 pl :: ByteString
pl =
      (PubKeyAlgorithm, NonEmpty MPI)
-> RIPEMD160
-> PKPayload
-> PKey
-> ByteString
-> Either String PKPayload
forall a b.
(Show a, HashAlgorithmASN1 a) =>
(PubKeyAlgorithm, NonEmpty MPI)
-> a -> b -> PKey -> ByteString -> Either String b
verify'' (SignaturePayload -> (PubKeyAlgorithm, NonEmpty MPI)
pkaAndMPIs SignaturePayload
s) RIPEMD160
CHA.RIPEMD160 PKPayload
pub PKey
pkey ByteString
pl
    verify' (SignaturePkt s :: SignaturePayload
s) pub :: PKPayload
pub@(PKPayload V4 _ _ _ pkey :: PKey
pkey) SHA256 pl :: ByteString
pl =
      (PubKeyAlgorithm, NonEmpty MPI)
-> SHA256
-> PKPayload
-> PKey
-> ByteString
-> Either String PKPayload
forall a b.
(Show a, HashAlgorithmASN1 a) =>
(PubKeyAlgorithm, NonEmpty MPI)
-> a -> b -> PKey -> ByteString -> Either String b
verify'' (SignaturePayload -> (PubKeyAlgorithm, NonEmpty MPI)
pkaAndMPIs SignaturePayload
s) SHA256
CHA.SHA256 PKPayload
pub PKey
pkey ByteString
pl
    verify' (SignaturePkt s :: SignaturePayload
s) pub :: PKPayload
pub@(PKPayload V4 _ _ _ pkey :: PKey
pkey) SHA384 pl :: ByteString
pl =
      (PubKeyAlgorithm, NonEmpty MPI)
-> SHA384
-> PKPayload
-> PKey
-> ByteString
-> Either String PKPayload
forall a b.
(Show a, HashAlgorithmASN1 a) =>
(PubKeyAlgorithm, NonEmpty MPI)
-> a -> b -> PKey -> ByteString -> Either String b
verify'' (SignaturePayload -> (PubKeyAlgorithm, NonEmpty MPI)
pkaAndMPIs SignaturePayload
s) SHA384
CHA.SHA384 PKPayload
pub PKey
pkey ByteString
pl
    verify' (SignaturePkt s :: SignaturePayload
s) pub :: PKPayload
pub@(PKPayload V4 _ _ _ pkey :: PKey
pkey) SHA512 pl :: ByteString
pl =
      (PubKeyAlgorithm, NonEmpty MPI)
-> SHA512
-> PKPayload
-> PKey
-> ByteString
-> Either String PKPayload
forall a b.
(Show a, HashAlgorithmASN1 a) =>
(PubKeyAlgorithm, NonEmpty MPI)
-> a -> b -> PKey -> ByteString -> Either String b
verify'' (SignaturePayload -> (PubKeyAlgorithm, NonEmpty MPI)
pkaAndMPIs SignaturePayload
s) SHA512
CHA.SHA512 PKPayload
pub PKey
pkey ByteString
pl
    verify' (SignaturePkt s :: SignaturePayload
s) pub :: PKPayload
pub@(PKPayload V4 _ _ _ pkey :: PKey
pkey) SHA224 pl :: ByteString
pl =
      (PubKeyAlgorithm, NonEmpty MPI)
-> SHA224
-> PKPayload
-> PKey
-> ByteString
-> Either String PKPayload
forall a b.
(Show a, HashAlgorithmASN1 a) =>
(PubKeyAlgorithm, NonEmpty MPI)
-> a -> b -> PKey -> ByteString -> Either String b
verify'' (SignaturePayload -> (PubKeyAlgorithm, NonEmpty MPI)
pkaAndMPIs SignaturePayload
s) SHA224
CHA.SHA224 PKPayload
pub PKey
pkey ByteString
pl
    verify' (SignaturePkt s :: SignaturePayload
s) pub :: PKPayload
pub@(PKPayload V4 _ _ _ pkey :: PKey
pkey) DeprecatedMD5 pl :: ByteString
pl =
      (PubKeyAlgorithm, NonEmpty MPI)
-> MD5
-> PKPayload
-> PKey
-> ByteString
-> Either String PKPayload
forall a b.
(Show a, HashAlgorithmASN1 a) =>
(PubKeyAlgorithm, NonEmpty MPI)
-> a -> b -> PKey -> ByteString -> Either String b
verify'' (SignaturePayload -> (PubKeyAlgorithm, NonEmpty MPI)
pkaAndMPIs SignaturePayload
s) MD5
CHA.MD5 PKPayload
pub PKey
pkey ByteString
pl
    verify' _ _ _ _ = String -> Either String PKPayload
forall a. HasCallStack => String -> a
error "This should never happen (verify')."
    verify'' :: (PubKeyAlgorithm, NonEmpty MPI)
-> a -> b -> PKey -> ByteString -> Either String b
verify'' (DSA, mpis :: NonEmpty MPI
mpis) hd :: a
hd pub :: b
pub (DSAPubKey (DSA_PublicKey pkey :: PublicKey
pkey)) bs :: ByteString
bs =
      b
-> NonEmpty MPI -> a -> PublicKey -> ByteString -> Either String b
forall e a b.
(ByteArrayAccess e, HashAlgorithm a, Show a, Show e) =>
b -> NonEmpty MPI -> a -> PublicKey -> e -> Either String b
dsaVerify b
pub NonEmpty MPI
mpis a
hd PublicKey
pkey ByteString
bs
    verify'' (ECDSA, mpis :: NonEmpty MPI
mpis) hd :: a
hd pub :: b
pub (ECDSAPubKey (ECDSA_PublicKey pkey :: PublicKey
pkey)) bs :: ByteString
bs =
      b
-> NonEmpty MPI -> a -> PublicKey -> ByteString -> Either String b
forall e a b.
(ByteArrayAccess e, HashAlgorithm a, Show a, Show e) =>
b -> NonEmpty MPI -> a -> PublicKey -> e -> Either String b
ecdsaVerify b
pub NonEmpty MPI
mpis a
hd PublicKey
pkey ByteString
bs
    verify'' (EdDSA, mpis :: NonEmpty MPI
mpis) hd :: a
hd pub :: b
pub (EdDSAPubKey Ed25519 pkey :: EPoint
pkey) bs :: ByteString
bs =
      b
-> NonEmpty MPI -> a -> ByteString -> ByteString -> Either String b
forall a e b.
(Show a, Show e, HashAlgorithm a, ByteArrayAccess e) =>
b -> NonEmpty MPI -> a -> ByteString -> e -> Either String b
ed25519Verify b
pub NonEmpty MPI
mpis a
hd (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp (EPoint -> Integer
unEPoint EPoint
pkey)) ByteString
bs
    verify'' (RSA, mpis :: NonEmpty MPI
mpis) hd :: a
hd pub :: b
pub (RSAPubKey (RSA_PublicKey pkey :: PublicKey
pkey)) bs :: ByteString
bs =
      b
-> NonEmpty MPI -> a -> PublicKey -> ByteString -> Either String b
forall a b.
(HashAlgorithmASN1 a, Show a) =>
b
-> NonEmpty MPI -> a -> PublicKey -> ByteString -> Either String b
rsaVerify b
pub NonEmpty MPI
mpis a
hd PublicKey
pkey ByteString
bs
    verify'' _ _ _ _ _ = String -> Either String b
forall a b. a -> Either a b
Left "unimplemented key type"
    dsaVerify :: b -> NonEmpty MPI -> a -> PublicKey -> e -> Either String b
dsaVerify pub :: b
pub (r :: MPI
r :| [s :: MPI
s]) hd :: a
hd pkey :: PublicKey
pkey bs :: e
bs =
      if a -> PublicKey -> Signature -> e -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
DSA.verify a
hd PublicKey
pkey (MPI -> MPI -> Signature
dsaMPIsToSig MPI
r MPI
s) e
bs
        then b -> Either String b
forall a b. b -> Either a b
Right b
pub
        else String -> Either String b
forall a b. a -> Either a b
Left ("DSA verification failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a, PublicKey, MPI, MPI, e) -> String
forall a. Show a => a -> String
show (a
hd, PublicKey
pkey, MPI
r, MPI
s, e
bs))
    dsaVerify _ _ _ _ _ = String -> Either String b
forall a b. a -> Either a b
Left "cannot verify DSA signature of wrong shape"
    ecdsaVerify :: b -> NonEmpty MPI -> a -> PublicKey -> e -> Either String b
ecdsaVerify pub :: b
pub (r :: MPI
r :| [s :: MPI
s]) hd :: a
hd pkey :: PublicKey
pkey bs :: e
bs =
      if a -> PublicKey -> Signature -> e -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify a
hd PublicKey
pkey (MPI -> MPI -> Signature
ecdsaMPIsToSig MPI
r MPI
s) e
bs
        then b -> Either String b
forall a b. b -> Either a b
Right b
pub
        else String -> Either String b
forall a b. a -> Either a b
Left ("ECDSA verification failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a, PublicKey, MPI, MPI, e) -> String
forall a. Show a => a -> String
show (a
hd, PublicKey
pkey, MPI
r, MPI
s, e
bs))
    ecdsaVerify _ _ _ _ _ = String -> Either String b
forall a b. a -> Either a b
Left "cannot verify ECDSA signature of wrong shape"
    ed25519Verify :: b -> NonEmpty MPI -> a -> ByteString -> e -> Either String b
ed25519Verify pub :: b
pub (r :: MPI
r :| [s :: MPI
s]) hd :: a
hd pkey :: ByteString
pkey bs :: e
bs =
      (String -> Either String b)
-> (b -> Either String b) -> Either String b -> Either String b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b)
-> (String -> String) -> String -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (("Ed25519 verification failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a, ByteString, MPI, MPI, e) -> String
forall a. Show a => a -> String
show (a
hd, ByteString
pkey, MPI
r, MPI
s, e
bs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": ") String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         String -> String
forall a. Show a => a -> String
show)
        b -> Either String b
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String b -> Either String b)
-> Either String b -> Either String b
forall a b. (a -> b) -> a -> b
$ do
        PublicKey
ep <- CryptoFailable PublicKey -> Either String PublicKey
forall b. CryptoFailable b -> Either String b
cf2es (ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey (Int -> ByteString -> ByteString
B.drop 1 ByteString
pkey)) -- drop the 0x40
        Signature
es <- CryptoFailable Signature -> Either String Signature
forall b. CryptoFailable b -> Either String b
cf2es (ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature ((ByteString -> ByteString -> ByteString
B.append (ByteString -> ByteString -> ByteString)
-> (MPI -> ByteString) -> MPI -> MPI -> ByteString
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp (Integer -> ByteString) -> (MPI -> Integer) -> MPI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPI -> Integer
unMPI) MPI
r MPI
s))
        let prehash :: ByteString
prehash = a -> e -> ByteString
forall c alg ba.
(ByteArray c, HashAlgorithm alg, ByteArrayAccess ba) =>
alg -> ba -> c
crazyHash a
hd e
bs :: B.ByteString
        if PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
ep ByteString
prehash Signature
es
          then b -> Either String b
forall a b. b -> Either a b
Right b
pub
          else String -> Either String b
forall a b. a -> Either a b
Left "does not verify"
    ed25519Verify _ _ _ _ _ =
      String -> Either String b
forall a b. a -> Either a b
Left "cannot verify Ed25519 signature of wrong shape"
    cf2es :: CryptoFailable b -> Either String b
cf2es = (CryptoError -> Either String b)
-> (b -> Either String b)
-> Either CryptoError b
-> Either String b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b)
-> (CryptoError -> String) -> CryptoError -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> String
forall a. Show a => a -> String
show) b -> Either String b
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CryptoError b -> Either String b)
-> (CryptoFailable b -> Either CryptoError b)
-> CryptoFailable b
-> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable b -> Either CryptoError b
forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError
    rsaVerify :: b
-> NonEmpty MPI -> a -> PublicKey -> ByteString -> Either String b
rsaVerify pub :: b
pub mpis :: NonEmpty MPI
mpis hd :: a
hd pkey :: PublicKey
pkey bs :: ByteString
bs =
      if Maybe a -> PublicKey -> ByteString -> ByteString -> Bool
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
P15.verify (a -> Maybe a
forall a. a -> Maybe a
Just a
hd) PublicKey
pkey ByteString
bs (NonEmpty MPI -> ByteString
forall ba. ByteArray ba => NonEmpty MPI -> ba
rsaMPItoSig NonEmpty MPI
mpis)
        then b -> Either String b
forall a b. b -> Either a b
Right b
pub
        else String -> Either String b
forall a b. a -> Either a b
Left ("DSA verification failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a, PublicKey, NonEmpty MPI, ByteString) -> String
forall a. Show a => a -> String
show (a
hd, PublicKey
pkey, NonEmpty MPI
mpis, ByteString
bs))
    dsaMPIsToSig :: MPI -> MPI -> Signature
dsaMPIsToSig r :: MPI
r s :: MPI
s = Integer -> Integer -> Signature
DSA.Signature (MPI -> Integer
unMPI MPI
r) (MPI -> Integer
unMPI MPI
s)
    ecdsaMPIsToSig :: MPI -> MPI -> Signature
ecdsaMPIsToSig r :: MPI
r s :: MPI
s = Integer -> Integer -> Signature
ECDSA.Signature (MPI -> Integer
unMPI MPI
r) (MPI -> Integer
unMPI MPI
s)
    rsaMPItoSig :: NonEmpty MPI -> ba
rsaMPItoSig (s :: MPI
s :| []) = Integer -> ba
forall ba. ByteArray ba => Integer -> ba
i2osp (MPI -> Integer
unMPI MPI
s)
    hashalgo :: Pkt -> HashAlgorithm
    hashalgo :: Pkt -> HashAlgorithm
hashalgo (SignaturePkt (SigV4 _ _ ha :: HashAlgorithm
ha _ _ _ _)) = HashAlgorithm
ha
    hashalgo _ = String -> HashAlgorithm
forall a. HasCallStack => String -> a
error "This should never happen (hashalgo)."
    pkaAndMPIs :: SignaturePayload -> (PubKeyAlgorithm, NonEmpty MPI)
pkaAndMPIs (SigV4 _ pka :: PubKeyAlgorithm
pka _ _ _ _ mpis :: NonEmpty MPI
mpis) = (PubKeyAlgorithm
pka, NonEmpty MPI
mpis)
    pkaAndMPIs _ = String -> (PubKeyAlgorithm, NonEmpty MPI)
forall a. HasCallStack => String -> a
error "This should never happen (pkaAndMPIs)."
    crazyHash :: alg -> ba -> c
crazyHash h :: alg
h = Digest alg -> c
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest alg -> c) -> (ba -> Digest alg) -> ba -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. alg -> ba -> Digest alg
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith alg
h

isSignatureExpired :: Pkt -> Maybe UTCTime -> Either String Bool
isSignatureExpired :: Pkt -> Maybe UTCTime -> Either String Bool
isSignatureExpired _ Nothing = Bool -> Either String Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isSignatureExpired s :: Pkt
s (Just t :: UTCTime
t) =
      if (SigSubPacket -> Bool) -> [SigSubPacket] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
           (UTCTime -> SigSubPacket -> Bool
expiredBefore UTCTime
t)
           ((\(SigV4 _ _ _ h :: [SigSubPacket]
h _ _ _) -> [SigSubPacket]
h) (SignaturePayload -> [SigSubPacket])
-> (Pkt -> SignaturePayload) -> Pkt -> [SigSubPacket]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> SignaturePayload
_signaturePayload (Signature -> SignaturePayload)
-> (Pkt -> Signature) -> Pkt -> SignaturePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Signature
forall a. Packet a => Pkt -> a
fromPkt (Pkt -> [SigSubPacket]) -> Pkt -> [SigSubPacket]
forall a b. (a -> b) -> a -> b
$ Pkt
s)
        then String -> Either String Bool
forall a b. a -> Either a b
Left "signature expired"
        else Bool -> Either String Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  where
    expiredBefore :: UTCTime -> SigSubPacket -> Bool
    expiredBefore :: UTCTime -> SigSubPacket -> Bool
expiredBefore ct :: UTCTime
ct (SigSubPacket _ (SigExpirationTime et :: ThirtyTwoBitDuration
et)) =
      NominalDiffTime -> Int
forall a. Enum a => a -> Int
fromEnum ((NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (ThirtyTwoBitDuration -> NominalDiffTime)
-> ThirtyTwoBitDuration
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> NominalDiffTime
forall a. Enum a => Int -> a
toEnum (Int -> NominalDiffTime)
-> (ThirtyTwoBitDuration -> Int)
-> ThirtyTwoBitDuration
-> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirtyTwoBitDuration -> Int
forall a. Enum a => a -> Int
fromEnum) ThirtyTwoBitDuration
et UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
ct) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<
      0
    expiredBefore _ _ = Bool
False

finalPayload :: Pkt -> ByteString -> ByteString
finalPayload :: Pkt -> ByteString -> ByteString
finalPayload s :: Pkt
s pl :: ByteString
pl = [ByteString] -> ByteString
BL.concat [ByteString
pl, ByteString
sigbit, Pkt -> ByteString
trailer Pkt
s]
  where
    sigbit :: ByteString
sigbit = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Pkt -> Put
putPartialSigforSigning Pkt
s
    trailer :: Pkt -> ByteString
    trailer :: Pkt -> ByteString
trailer (SignaturePkt SigV4 {}) = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Pkt -> Put
putSigTrailer Pkt
s
    trailer _ = ByteString
BL.empty

signUserIDwithRSA ::
     PKPayload -- ^ public key "payload" of user ID being signed
  -> UserId -- ^ user ID being signed
  -> [SigSubPacket] -- ^ hashed signature subpackets
  -> [SigSubPacket] -- ^ unhashed signature subpackets
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> Either String SignaturePayload
signUserIDwithRSA :: PKPayload
-> UserId
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> Either String SignaturePayload
signUserIDwithRSA pkp :: PKPayload
pkp uid :: UserId
uid hsigsubs :: [SigSubPacket]
hsigsubs usigsubs :: [SigSubPacket]
usigsubs prv :: PrivateKey
prv = do
  ByteString
uidsig <-
    (Error -> String)
-> Either Error ByteString -> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      Error -> String
forall a. Show a => a -> String
show
      (Maybe Blinder
-> Maybe SHA512
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign
         Maybe Blinder
forall a. Maybe a
Nothing
         (SHA512 -> Maybe SHA512
forall a. a -> Maybe a
Just SHA512
CHA.SHA512)
         PrivateKey
prv
         (ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
uidsigp) ByteString
uidpayload)))
  SignaturePayload -> Either String SignaturePayload
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> SignaturePayload
uidsigp' ByteString
uidsig)
  where
    uidpayload :: ByteString
uidpayload =
      Put -> ByteString
runPut
        ([Put] -> Put
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
           [Pkt -> Put
putKeyforSigning (PKPayload -> Pkt
PublicKeyPkt PKPayload
pkp), Pkt -> Put
putUforSigning (UserId -> Pkt
forall a. Packet a => a -> Pkt
toPkt UserId
uid)])
    uidsigp :: SignaturePayload
uidsigp =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4 SigType
PositiveCert PubKeyAlgorithm
RSA HashAlgorithm
SHA512 [SigSubPacket]
hsigsubs [SigSubPacket]
usigsubs 0 ([MPI] -> NonEmpty MPI
forall a. [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI 0])
    uidsigp' :: ByteString -> SignaturePayload
uidsigp' us :: ByteString
us =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
        SigType
PositiveCert
        PubKeyAlgorithm
RSA
        HashAlgorithm
SHA512
        [SigSubPacket]
hsigsubs
        [SigSubPacket]
usigsubs
        (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (Int -> ByteString -> ByteString
B.take 2 ByteString
us)))
        ([MPI] -> NonEmpty MPI
forall a. [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
us)])

crossSignSubkeyWithRSA ::
     PKPayload -- ^ public key "payload" of key being signed
  -> PKPayload -- ^ public subkey "payload" of key being signed
  -> [SigSubPacket] -- ^ hashed signature subpackets for binding sig
  -> [SigSubPacket] -- ^ unhashed signature subpackets for binding sig
  -> [SigSubPacket] -- ^ hashed signature subpackets for embedded sig
  -> [SigSubPacket] -- ^ unhashed signature subpackets for embedded sig
  -> RSATypes.PrivateKey -- ^ RSA signing key
  -> RSATypes.PrivateKey -- ^ RSA signing subkey
  -> Either String SignaturePayload
crossSignSubkeyWithRSA :: PKPayload
-> PKPayload
-> [SigSubPacket]
-> [SigSubPacket]
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> PrivateKey
-> Either String SignaturePayload
crossSignSubkeyWithRSA pkp :: PKPayload
pkp subpkp :: PKPayload
subpkp subhsigsubs :: [SigSubPacket]
subhsigsubs subusigsubs :: [SigSubPacket]
subusigsubs embhsigsubs :: [SigSubPacket]
embhsigsubs embusigsubs :: [SigSubPacket]
embusigsubs prv :: PrivateKey
prv ssb :: PrivateKey
ssb = do
  ByteString
embsig <-
    (Error -> String)
-> Either Error ByteString -> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      Error -> String
forall a. Show a => a -> String
show
      (Maybe Blinder
-> Maybe SHA512
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign
         Maybe Blinder
forall a. Maybe a
Nothing
         (SHA512 -> Maybe SHA512
forall a. a -> Maybe a
Just SHA512
CHA.SHA512)
         PrivateKey
ssb
         (ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
embsigp) ByteString
subkeypayload)))
  ByteString
subsig <-
    (Error -> String)
-> Either Error ByteString -> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      Error -> String
forall a. Show a => a -> String
show
      (Maybe Blinder
-> Maybe SHA512
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign
         Maybe Blinder
forall a. Maybe a
Nothing
         (SHA512 -> Maybe SHA512
forall a. a -> Maybe a
Just SHA512
CHA.SHA512)
         PrivateKey
prv
         (ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt SignaturePayload
subsigp) ByteString
subkeypayload)))
  SignaturePayload -> Either String SignaturePayload
forall (m :: * -> *) a. Monad m => a -> m a
return (SignaturePayload -> ByteString -> SignaturePayload
subsigp' (ByteString -> SignaturePayload
embsigp' ByteString
embsig) ByteString
subsig)
  where
    subkeypayload :: ByteString
subkeypayload =
      Put -> ByteString
runPut
        ([Put] -> Put
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
           [ Pkt -> Put
putKeyforSigning (PKPayload -> Pkt
PublicKeyPkt PKPayload
pkp)
           , Pkt -> Put
putKeyforSigning (PKPayload -> Pkt
PublicSubkeyPkt PKPayload
subpkp)
           ])
    embsigp :: SignaturePayload
embsigp =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
        SigType
PrimaryKeyBindingSig
        PubKeyAlgorithm
RSA
        HashAlgorithm
SHA512
        [SigSubPacket]
embhsigsubs
        [SigSubPacket]
embusigsubs
        0
        ([MPI] -> NonEmpty MPI
forall a. [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI 0])
    embsigp' :: ByteString -> SignaturePayload
embsigp' es :: ByteString
es =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
        SigType
PrimaryKeyBindingSig
        PubKeyAlgorithm
RSA
        HashAlgorithm
SHA512
        [SigSubPacket]
embhsigsubs
        [SigSubPacket]
embusigsubs
        (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (Int -> ByteString -> ByteString
B.take 2 ByteString
es)))
        ([MPI] -> NonEmpty MPI
forall a. [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
es)])
    subsigp :: SignaturePayload
subsigp =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4 SigType
SubkeyBindingSig PubKeyAlgorithm
RSA HashAlgorithm
SHA512 [SigSubPacket]
subhsigsubs [] 0 ([MPI] -> NonEmpty MPI
forall a. [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI 0])
    sspes :: SignaturePayload -> SigSubPacket
sspes es :: SignaturePayload
es = Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (SignaturePayload -> SigSubPacketPayload
EmbeddedSignature SignaturePayload
es)
    subsigp' :: SignaturePayload -> ByteString -> SignaturePayload
subsigp' es :: SignaturePayload
es ss :: ByteString
ss =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
        SigType
SubkeyBindingSig
        PubKeyAlgorithm
RSA
        HashAlgorithm
SHA512
        [SigSubPacket]
subhsigsubs
        (SignaturePayload -> SigSubPacket
sspes SignaturePayload
es SigSubPacket -> [SigSubPacket] -> [SigSubPacket]
forall a. a -> [a] -> [a]
: [SigSubPacket]
subusigsubs)
        (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (Int -> ByteString -> ByteString
B.take 2 ByteString
ss)))
        ([MPI] -> NonEmpty MPI
forall a. [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
ss)])

signDataWithRSA ::
     SigType
  -> RSATypes.PrivateKey
  -> [SigSubPacket]
  -> [SigSubPacket]
  -> ByteString
  -> Either String SignaturePayload
signDataWithRSA :: SigType
-> PrivateKey
-> [SigSubPacket]
-> [SigSubPacket]
-> ByteString
-> Either String SignaturePayload
signDataWithRSA st :: SigType
st prv :: PrivateKey
prv has :: [SigSubPacket]
has uhas :: [SigSubPacket]
uhas payload :: ByteString
payload =
  SigType -> ByteString -> SignaturePayload
sp SigType
st (ByteString -> SignaturePayload)
-> Either String ByteString -> Either String SignaturePayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Error -> String)
-> Either Error ByteString -> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
    Error -> String
forall a. Show a => a -> String
show
    (Maybe Blinder
-> Maybe SHA512
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
P15.sign
       Maybe Blinder
forall a. Maybe a
Nothing
       (SHA512 -> Maybe SHA512
forall a. a -> Maybe a
Just SHA512
CHA.SHA512)
       PrivateKey
prv
       (ByteString -> ByteString
BL.toStrict (Pkt -> ByteString -> ByteString
finalPayload (SignaturePayload -> Pkt
SignaturePkt (SigType -> SignaturePayload
sp0 SigType
st)) ByteString
payload)))
  where
    sp0 :: SigType -> SignaturePayload
sp0 st :: SigType
st = SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4 SigType
st PubKeyAlgorithm
RSA HashAlgorithm
SHA512 [SigSubPacket]
has [] 0 ([MPI] -> NonEmpty MPI
forall a. [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI 0])
    sp :: SigType -> ByteString -> SignaturePayload
sp st :: SigType
st ss :: ByteString
ss =
      SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4
        SigType
st
        PubKeyAlgorithm
RSA
        HashAlgorithm
SHA512
        [SigSubPacket]
has
        [SigSubPacket]
uhas
        (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (Int -> ByteString -> ByteString
B.take 2 ByteString
ss)))
        ([MPI] -> NonEmpty MPI
forall a. [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
ss)])