module Data.Conduit.OpenPGP.Verify (
conduitVerify
) where
import qualified Crypto.Cipher.DSA as DSA
import qualified Crypto.Cipher.RSA as RSA
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Conduit
import Data.Either (lefts, rights)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Serialize.Put (runPut)
import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID)
import Codec.Encryption.OpenPGP.Internal (countBits, integerToBEBS)
import Codec.Encryption.OpenPGP.SerializeForSigs (putPartialSigforSigning, putSigTrailer)
import Codec.Encryption.OpenPGP.Types
import Data.Conduit.OpenPGP.Internal (PacketStreamContext(..), payloadForSig, asn1Prefix, hash, issuer)
conduitVerify :: MonadResource m => Keyring -> Conduit Packet m (Either String PKPayload)
conduitVerify kr = conduitState (PacketStreamContext (Marker B.empty) (Marker B.empty) (Marker B.empty) (Marker B.empty) (Marker B.empty)) push close
where
push state ld@(LiteralData {}) = return $ StateProducing (state { lastLD = ld }) []
push state uid@(UserId _) = return $ StateProducing (state { lastUIDorUAt = uid }) []
push state uat@(UserAttribute _) = return $ StateProducing (state { lastUIDorUAt = uat }) []
push state pk@(PublicKey _) = return $ StateProducing (state { lastPrimaryKey = pk }) []
push state pk@(PublicSubkey _) = return $ StateProducing (state { lastSubkey = pk }) []
push state sk@(SecretKey _ _) = return $ StateProducing (state { lastPrimaryKey = sk }) []
push state sk@(SecretSubkey _ _) = return $ StateProducing (state { lastSubkey = sk }) []
push state sig@(Signature (SigV4 {})) = return $ StateProducing state { lastSig = sig } [verifySig kr sig state]
push state (OnePassSignature _ _ _ _ _ False) = return $ StateProducing state []
push state _ = return $ StateProducing state []
close _ = return []
normLineEndings = id
verifySig :: Keyring -> Packet -> PacketStreamContext -> Either String PKPayload
verifySig kr sig@(Signature (SigV4 st _ _ _ _ _ _)) state = verify kr sig (payloadForSig st state)
verifySig _ _ _ = Left "This should never happen."
verify :: Keyring -> Packet -> ByteString -> Either String PKPayload
verify kr sig payload = do
i <- maybe (Left "issuer not found") Right (issuer sig)
tpkset <- maybe (Left "pubkey not found") Right (Map.lookup i kr)
let allrelevantpkps = filter (\x -> issuer sig == Just (eightOctetKeyID x)) (concatMap (\x -> tkPKP x:map subPKP (tkSubs x)) (Set.toAscList tpkset))
let results = map (\pkp -> verify' sig pkp (hashalgo sig) (finalPayload sig payload)) allrelevantpkps
case rights results of
[] -> Left (concatMap (++"/") (lefts results))
[r] -> Right r
_ -> Left "multiple successes; unexpected condition"
where
subPKP (pack, _, _) = subPKP' pack
subPKP' (PublicSubkey p) = p
subPKP' (SecretSubkey p _) = p
verify' (Signature s) (pub@(PubV4 _ _ pkey)) ha pl = verify'' (pkaAndMPIs s) ha pub pkey pl
verify' _ _ _ _ = error "This should never happen."
verify'' (DSA,mpis) ha pub (DSAPubKey pkey) bs = verify''' (dsaVerify mpis ha pkey bs) pub
verify'' (RSA,mpis) ha pub (RSAPubKey pkey) bs = verify''' (rsaVerify mpis ha pkey bs) pub
verify'' _ _ _ _ _ = Left "unimplemented key type"
verify''' f pub = case f of
Left _ -> Left "invalid signature"
Right False -> Left "verification failed"
Right True -> Right pub
dsaVerify mpis ha pkey bs = DSA.verify (dsaMPIsToSig mpis) (dsaTruncate pkey . hash ha) pkey bs
rsaVerify mpis ha pkey bs = RSA.verify (hash ha) (asn1Prefix ha) pkey bs (rsaMPItoSig mpis)
dsaMPIsToSig mpis = (unMPI (mpis !! 0), unMPI (mpis !! 1))
rsaMPItoSig mpis = integerToBEBS (unMPI (head mpis))
finalPayload s pl = B.concat [pl, sigbit s, trailer s]
sigbit s = runPut $ putPartialSigforSigning s
hashalgo :: Packet -> HashAlgorithm
hashalgo (Signature (SigV4 _ _ ha _ _ _ _)) = ha
hashalgo _ = error "This should never happen."
trailer :: Packet -> ByteString
trailer s@(Signature (SigV4 {})) = runPut $ putSigTrailer s
trailer _ = B.empty
dsaTruncate pkey bs = if countBits bs > dsaQLen pkey then B.take (fromIntegral (dsaQLen pkey) `div` 8) bs else bs
dsaQLen pk = (\(_,_,z) -> countBits (integerToBEBS z)) (DSA.public_params pk)
pkaAndMPIs (SigV4 _ pka _ _ _ _ mpis) = (pka,mpis)
pkaAndMPIs _ = error "This should never happen."