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
verifySigWith :: (Pkt -> Maybe UTCTime -> ByteString -> Either String Verification)
-> Pkt
-> PktStreamContext
-> Maybe UTCTime
-> Either String Verification
verifySigWith Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
vf sig :: Pkt
sig@(SignaturePkt (SigV4 SigType
st PubKeyAlgorithm
_ HashAlgorithm
_ [SigSubPacket]
hs [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) PktStreamContext
state 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 a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Verification
v
where
checkI :: PKPayload -> SigSubPacketPayload -> Either String Bool
checkI PKPayload
s i :: SigSubPacketPayload
i@Issuer {} = Either String EightOctetKeyId
-> SigSubPacketPayload -> Either String Bool
checkIssuer (PKPayload -> Either String EightOctetKeyId
eightOctetKeyID PKPayload
s) SigSubPacketPayload
i
checkI PKPayload
s i :: SigSubPacketPayload
i@IssuerFingerprint {} = TwentyOctetFingerprint -> SigSubPacketPayload -> Either String Bool
checkIssuerFP (PKPayload -> TwentyOctetFingerprint
fingerprint PKPayload
s) SigSubPacketPayload
i
checkI PKPayload
_ SigSubPacketPayload
_ = 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 EightOctetKeyId
signer) (Issuer 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 String
"issuer subpacket does not match"
checkIssuer (Left String
err) (Issuer EightOctetKeyId
_) =
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
$ String
"issuer subpacket cannot be checked (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
checkIssuer Either String EightOctetKeyId
_ SigSubPacketPayload
_ = 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 TwentyOctetFingerprint
signer (IssuerFingerprint Word8
_ 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 String
"issuer fingerprint subpacket does not match"
checkIssuerFP TwentyOctetFingerprint
_ SigSubPacketPayload
_ = Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
verifySigWith Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
_ Pkt
_ PktStreamContext
_ Maybe UTCTime
_ = String -> Either String Verification
forall a b. a -> Either a b
Left String
"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 Pkt
-> PktStreamContext -> Maybe UTCTime -> Either String Verification
vsf Maybe UTCTime
mt 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 a. [a] -> 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
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 a. [a] -> 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
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
TK -> Either String TK
forall a. a -> Either String a
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 [(PubKeyAlgorithm, TwentyOctetFingerprint)]
rs TK
k =
[Either String SignaturePayload]
-> Either String [SignaturePayload]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 a b. (a -> b) -> Either String a -> Either String b
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
(\(Text
uid, [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 (\SignaturePayload
sp -> (Verification -> SignaturePayload)
-> Either String Verification -> Either String SignaturePayload
forall a b. (a -> b) -> Either String a -> Either String b
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
(\([UserAttrSubPacket]
uat, [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 (\SignaturePayload
sp -> (Verification -> SignaturePayload)
-> Either String Verification -> Either String SignaturePayload
forall a b. (a -> b) -> Either String a -> Either String b
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, [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 Pkt
_ [] = Bool
False
revokedSub Pkt
p [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' Pkt
p [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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignaturePayload]
goodsigs
then []
else [(Pkt
p, [SignaturePayload]
goodsigs)]
getHasheds :: SignaturePayload -> [SigSubPacket]
getHasheds (SigV4 SigType
_ PubKeyAlgorithm
_ HashAlgorithm
_ [SigSubPacket]
ha [SigSubPacket]
_ Word16
_ NonEmpty MPI
_) = [SigSubPacket]
ha
getHasheds SignaturePayload
_ = []
filterRevs ::
[(PubKeyAlgorithm, TwentyOctetFingerprint)]
-> (SignaturePayload, Verification)
-> [Either String SignaturePayload]
filterRevs :: [(PubKeyAlgorithm, TwentyOctetFingerprint)]
-> (SignaturePayload, Verification)
-> [Either String SignaturePayload]
filterRevs [(PubKeyAlgorithm, TwentyOctetFingerprint)]
vokers (SignaturePayload, Verification)
spv =
case (SignaturePayload, Verification)
spv of
(s :: SignaturePayload
s@(SigV4 SigType
SignatureDirectlyOnAKey PubKeyAlgorithm
_ HashAlgorithm
_ [SigSubPacket]
_ [SigSubPacket]
_ Word16
_ NonEmpty MPI
_), Verification
_) -> [SignaturePayload -> Either String SignaturePayload
forall a b. b -> Either a b
Right SignaturePayload
s]
(s :: SignaturePayload
s@(SigV4 SigType
KeyRevocationSig PubKeyAlgorithm
pka HashAlgorithm
_ [SigSubPacket]
_ [SigSubPacket]
_ Word16
_ NonEmpty MPI
_), 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
Lens
(PKPayload, Maybe SKAddendum)
(PKPayload, Maybe SKAddendum)
PKPayload
PKPayload
_1) Bool -> Bool -> Bool
||
((PubKeyAlgorithm, TwentyOctetFingerprint) -> Bool)
-> [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
(\(PubKeyAlgorithm
p, 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 String
"Key revoked"]
else [SignaturePayload -> Either String SignaturePayload
forall a b. b -> Either a b
Right SignaturePayload
s]
(SignaturePayload, Verification)
_ -> []
vUid :: (Text, SignaturePayload) -> Either String Verification
vUid :: (Text, SignaturePayload) -> Either String Verification
vUid (Text
uid, SignaturePayload
sp) =
Pkt
-> PktStreamContext -> Maybe UTCTime -> Either String Verification
vsf
(SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
PktStreamContext
emptyPSC
{ lastPrimaryKey = PublicKeyPkt (key ^. tkKey . _1)
, lastUIDorUAt = UserIdPkt uid
}
Maybe UTCTime
mt
vUAt ::
([UserAttrSubPacket], SignaturePayload) -> Either String Verification
vUAt :: ([UserAttrSubPacket], SignaturePayload)
-> Either String Verification
vUAt ([UserAttrSubPacket]
uat, SignaturePayload
sp) =
Pkt
-> PktStreamContext -> Maybe UTCTime -> Either String Verification
vsf
(SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
PktStreamContext
emptyPSC
{ lastPrimaryKey = PublicKeyPkt (key ^. tkKey . _1)
, lastUIDorUAt = UserAttributePkt uat
}
Maybe UTCTime
mt
vSig :: SignaturePayload -> Either String Verification
vSig :: SignaturePayload -> Either String Verification
vSig SignaturePayload
sp =
Pkt
-> PktStreamContext -> Maybe UTCTime -> Either String Verification
vsf
(SignaturePayload -> Pkt
SignaturePkt SignaturePayload
sp)
PktStreamContext
emptyPSC {lastPrimaryKey = PublicKeyPkt (key ^. tkKey . _1)}
Maybe UTCTime
mt
vSubSig :: Pkt -> SignaturePayload -> Bool
vSubSig :: Pkt -> SignaturePayload -> Bool
vSubSig Pkt
sk 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 = PublicKeyPkt (key ^. tkKey . _1)
, lastSubkey = sk
}
Maybe UTCTime
mt)
verifyRevoker ::
SignaturePayload
-> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]
verifyRevoker :: SignaturePayload
-> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]
verifyRevoker SignaturePayload
sp = do
Verification
_ <- SignaturePayload -> Either String Verification
vSig SignaturePayload
sp
[(PubKeyAlgorithm, TwentyOctetFingerprint)]
-> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return
((SigSubPacket -> (PubKeyAlgorithm, TwentyOctetFingerprint))
-> [SigSubPacket] -> [(PubKeyAlgorithm, TwentyOctetFingerprint)]
forall a b. (a -> b) -> [a] -> [b]
map (\(SigSubPacket Bool
_ (RevocationKey Set RevocationClass
_ PubKeyAlgorithm
pka 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 Keyring
kr Pkt
sig Maybe UTCTime
mt 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 String
"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 a. Maybe a -> Maybe a -> Maybe a
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 String
"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 [TK]
ks Pkt
sig Maybe UTCTime
mt ByteString
payload = do
let allrelevantpkps :: [PKPayload]
allrelevantpkps =
(PKPayload -> Bool) -> [PKPayload] -> [PKPayload]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
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 (\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
Lens
(PKPayload, Maybe SKAddendum)
(PKPayload, Maybe SKAddendum)
PKPayload
PKPayload
_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
(\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]
++ String
"/") ([Either String Verification] -> [String]
forall a b. [Either a b] -> [a]
lefts [Either String Verification]
results))
[Verification
r] -> do
Bool
_ <- Pkt -> Maybe UTCTime -> Either String Bool
isSignatureExpired Pkt
sig Maybe UTCTime
mt
Verification -> Either String Verification
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Verification
r
[Verification]
_ -> String -> Either String Verification
forall a b. a -> Either a b
Left String
"multiple successes; unexpected condition"
where
subPKP :: (Pkt, b) -> PKPayload
subPKP (Pkt
pack, b
_) = Pkt -> PKPayload
subPKP' Pkt
pack
subPKP' :: Pkt -> PKPayload
subPKP' (PublicSubkeyPkt PKPayload
p) = PKPayload
p
subPKP' (SecretSubkeyPkt PKPayload
p SKAddendum
_) = PKPayload
p
subPKP' Pkt
_ = String -> PKPayload
forall a. HasCallStack => String -> a
error String
"This should never happen (subPKP')"
verifyAgainstKey' ::
PKPayload -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
verifyAgainstKey' :: PKPayload
-> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification
verifyAgainstKey' PKPayload
pkp Pkt
sig Maybe UTCTime
mt ByteString
payload = do
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))
Verification -> Either String Verification
forall a. a -> Either String a
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 SignaturePayload
s) pub :: PKPayload
pub@(PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
pkey) HashAlgorithm
SHA1 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 SignaturePayload
s) pub :: PKPayload
pub@(PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
pkey) HashAlgorithm
RIPEMD160 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 SignaturePayload
s) pub :: PKPayload
pub@(PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
pkey) HashAlgorithm
SHA256 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 SignaturePayload
s) pub :: PKPayload
pub@(PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
pkey) HashAlgorithm
SHA384 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 SignaturePayload
s) pub :: PKPayload
pub@(PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
pkey) HashAlgorithm
SHA512 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 SignaturePayload
s) pub :: PKPayload
pub@(PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
pkey) HashAlgorithm
SHA224 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 SignaturePayload
s) pub :: PKPayload
pub@(PKPayload KeyVersion
V4 ThirtyTwoBitTimeStamp
_ Word16
_ PubKeyAlgorithm
_ PKey
pkey) HashAlgorithm
DeprecatedMD5 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' Pkt
_ PKPayload
_ HashAlgorithm
_ ByteString
_ = String -> Either String PKPayload
forall a. HasCallStack => String -> a
error String
"This should never happen (verify')."
verify'' :: (PubKeyAlgorithm, NonEmpty MPI)
-> a -> b -> PKey -> ByteString -> Either String b
verify'' (PubKeyAlgorithm
DSA, NonEmpty MPI
mpis) a
hd b
pub (DSAPubKey (DSA_PublicKey PublicKey
pkey)) 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'' (PubKeyAlgorithm
ECDSA, NonEmpty MPI
mpis) a
hd b
pub (ECDSAPubKey (ECDSA_PublicKey PublicKey
pkey)) 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'' (PubKeyAlgorithm
EdDSA, NonEmpty MPI
mpis) a
hd b
pub (EdDSAPubKey EdSigningCurve
Ed25519 EPoint
pkey) 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'' (PubKeyAlgorithm
RSA, NonEmpty MPI
mpis) a
hd b
pub (RSAPubKey (RSA_PublicKey PublicKey
pkey)) 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'' (PubKeyAlgorithm, NonEmpty MPI)
_ a
_ b
_ PKey
_ ByteString
_ = String -> Either String b
forall a b. a -> Either a b
Left String
"unimplemented key type"
dsaVerify :: b -> NonEmpty MPI -> a -> PublicKey -> e -> Either String b
dsaVerify b
pub (MPI
r :| [MPI
s]) a
hd PublicKey
pkey 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 (String
"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 b
_ NonEmpty MPI
_ a
_ PublicKey
_ e
_ = String -> Either String b
forall a b. a -> Either a b
Left String
"cannot verify DSA signature of wrong shape"
ecdsaVerify :: b -> NonEmpty MPI -> a -> PublicKey -> e -> Either String b
ecdsaVerify b
pub (MPI
r :| [MPI
s]) a
hd PublicKey
pkey 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 (String
"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 b
_ NonEmpty MPI
_ a
_ PublicKey
_ e
_ = String -> Either String b
forall a b. a -> Either a b
Left String
"cannot verify ECDSA signature of wrong shape"
ed25519Verify :: b -> NonEmpty MPI -> a -> ByteString -> e -> Either String b
ed25519Verify b
pub (MPI
r :| [MPI
s]) a
hd ByteString
pkey 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
.
((String
"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 -> 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 a. a -> Either String a
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 Int
1 ByteString
pkey))
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} {a}.
(ByteArray c, HashAlgorithm alg, ByteArrayAccess a) =>
alg -> a -> 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 String
"does not verify"
ed25519Verify b
_ NonEmpty MPI
_ a
_ ByteString
_ e
_ =
String -> Either String b
forall a b. a -> Either a b
Left String
"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 a. a -> Either String a
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 b
pub NonEmpty MPI
mpis a
hd PublicKey
pkey 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 (String
"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 MPI
r MPI
s = Integer -> Integer -> Signature
DSA.Signature (MPI -> Integer
unMPI MPI
r) (MPI -> Integer
unMPI MPI
s)
ecdsaMPIsToSig :: MPI -> MPI -> Signature
ecdsaMPIsToSig MPI
r MPI
s = Integer -> Integer -> Signature
ECDSA.Signature (MPI -> Integer
unMPI MPI
r) (MPI -> Integer
unMPI MPI
s)
rsaMPItoSig :: NonEmpty MPI -> ba
rsaMPItoSig (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 SigType
_ PubKeyAlgorithm
_ HashAlgorithm
ha [SigSubPacket]
_ [SigSubPacket]
_ Word16
_ NonEmpty MPI
_)) = HashAlgorithm
ha
hashalgo Pkt
_ = String -> HashAlgorithm
forall a. HasCallStack => String -> a
error String
"This should never happen (hashalgo)."
pkaAndMPIs :: SignaturePayload -> (PubKeyAlgorithm, NonEmpty MPI)
pkaAndMPIs (SigV4 SigType
_ PubKeyAlgorithm
pka HashAlgorithm
_ [SigSubPacket]
_ [SigSubPacket]
_ Word16
_ NonEmpty MPI
mpis) = (PubKeyAlgorithm
pka, NonEmpty MPI
mpis)
pkaAndMPIs SignaturePayload
_ = String -> (PubKeyAlgorithm, NonEmpty MPI)
forall a. HasCallStack => String -> a
error String
"This should never happen (pkaAndMPIs)."
crazyHash :: alg -> a -> c
crazyHash alg
h = Digest alg -> c
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest alg -> c) -> (a -> Digest alg) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. alg -> a -> 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 Pkt
_ Maybe UTCTime
Nothing = Bool -> Either String Bool
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isSignatureExpired Pkt
s (Just 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 SigType
_ PubKeyAlgorithm
_ HashAlgorithm
_ [SigSubPacket]
h [SigSubPacket]
_ Word16
_ NonEmpty MPI
_) -> [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 String
"signature expired"
else Bool -> Either String Bool
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
where
expiredBefore :: UTCTime -> SigSubPacket -> Bool
expiredBefore :: UTCTime -> SigSubPacket -> Bool
expiredBefore UTCTime
ct (SigSubPacket Bool
_ (SigExpirationTime 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
<
Int
0
expiredBefore UTCTime
_ SigSubPacket
_ = Bool
False
finalPayload :: Pkt -> ByteString -> ByteString
finalPayload :: Pkt -> ByteString -> ByteString
finalPayload Pkt
s 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 Pkt
_ = ByteString
BL.empty
signUserIDwithRSA ::
PKPayload
-> UserId
-> [SigSubPacket]
-> [SigSubPacket]
-> RSATypes.PrivateKey
-> Either String SignaturePayload
signUserIDwithRSA :: PKPayload
-> UserId
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> Either String SignaturePayload
signUserIDwithRSA PKPayload
pkp UserId
uid [SigSubPacket]
hsigsubs [SigSubPacket]
usigsubs PrivateKey
prv = do
ByteString
uidsig <-
(Error -> String)
-> Either Error ByteString -> Either String ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
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 a. a -> Either String a
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 Word16
0 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0])
uidsigp' :: ByteString -> SignaturePayload
uidsigp' 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 Int
2 ByteString
us)))
([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
us)])
crossSignSubkeyWithRSA ::
PKPayload
-> PKPayload
-> [SigSubPacket]
-> [SigSubPacket]
-> [SigSubPacket]
-> [SigSubPacket]
-> RSATypes.PrivateKey
-> RSATypes.PrivateKey
-> Either String SignaturePayload
crossSignSubkeyWithRSA :: PKPayload
-> PKPayload
-> [SigSubPacket]
-> [SigSubPacket]
-> [SigSubPacket]
-> [SigSubPacket]
-> PrivateKey
-> PrivateKey
-> Either String SignaturePayload
crossSignSubkeyWithRSA PKPayload
pkp PKPayload
subpkp [SigSubPacket]
subhsigsubs [SigSubPacket]
subusigsubs [SigSubPacket]
embhsigsubs [SigSubPacket]
embusigsubs PrivateKey
prv PrivateKey
ssb = do
ByteString
embsig <-
(Error -> String)
-> Either Error ByteString -> Either String ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
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 a b c. (a -> b) -> Either a c -> Either b c
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 a. a -> Either String a
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
Word16
0
([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0])
embsigp' :: ByteString -> SignaturePayload
embsigp' 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 Int
2 ByteString
es)))
([MPI] -> NonEmpty MPI
forall a. HasCallStack => [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 [] Word16
0 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0])
sspes :: SignaturePayload -> SigSubPacket
sspes SignaturePayload
es = Bool -> SigSubPacketPayload -> SigSubPacket
SigSubPacket Bool
False (SignaturePayload -> SigSubPacketPayload
EmbeddedSignature SignaturePayload
es)
subsigp' :: SignaturePayload -> ByteString -> SignaturePayload
subsigp' SignaturePayload
es 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 Int
2 ByteString
ss)))
([MPI] -> NonEmpty MPI
forall a. HasCallStack => [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 SigType
st PrivateKey
prv [SigSubPacket]
has [SigSubPacket]
uhas 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 a b c. (a -> b) -> Either a c -> Either b c
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 SigType
st = SigType
-> PubKeyAlgorithm
-> HashAlgorithm
-> [SigSubPacket]
-> [SigSubPacket]
-> Word16
-> NonEmpty MPI
-> SignaturePayload
SigV4 SigType
st PubKeyAlgorithm
RSA HashAlgorithm
SHA512 [SigSubPacket]
has [] Word16
0 ([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI Integer
0])
sp :: SigType -> ByteString -> SignaturePayload
sp SigType
st 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 Int
2 ByteString
ss)))
([MPI] -> NonEmpty MPI
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Integer -> MPI
MPI (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
ss)])