module Codec.Encryption.OpenPGP.Internal (
countBits
, beBSToInteger
, integerToBEBS
, PktStreamContext(..)
, hashDescr
, issuer
, emptyPSC
, pubkeyToMPIs
, multiplicativeInverse
, sigType
, sigPKA
, sigHA
, sigCT
) where
import Crypto.PubKey.HashDescr (HashDescr(..), hashDescrMD5, hashDescrSHA1, hashDescrSHA224, hashDescrSHA256, hashDescrSHA384, hashDescrSHA512, hashDescrRIPEMD160)
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.RSA as RSA
import Data.Bits (testBit, shiftL, shiftR, (.&.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.List (find, mapAccumR, unfoldr)
import Data.Word (Word8, Word16)
import Codec.Encryption.OpenPGP.Types
countBits :: ByteString -> Word16
countBits bs
| B.null bs = 0
| otherwise = fromIntegral (B.length bs * 8) fromIntegral (go (B.head bs) 7)
where
go :: Word8 -> Int -> Word8
go _ 0 = 7
go n b = if testBit n b then 7 fromIntegral b else go n (b1)
beBSToInteger :: ByteString -> Integer
beBSToInteger = sum . snd . mapAccumR (\acc x -> (acc + 8, fromIntegral x `shiftL` acc)) 0 . B.unpack
integerToBEBS :: Integer -> ByteString
integerToBEBS = B.pack . reverse . unfoldr (\x -> if x == 0 then Nothing else Just ((fromIntegral x :: Word8) .&. 0xff, x `shiftR` 8))
data PktStreamContext = PktStreamContext { lastLD :: Pkt
, lastUIDorUAt :: Pkt
, lastSig :: Pkt
, lastPrimaryKey :: Pkt
, lastSubkey :: Pkt
}
emptyPSC :: PktStreamContext
emptyPSC = PktStreamContext (OtherPacketPkt 0 "lastLD placeholder") (OtherPacketPkt 0 "lastUIDorUAt placeholder") (OtherPacketPkt 0 "lastSig placeholder") (OtherPacketPkt 0 "lastPrimaryKey placeholder") (OtherPacketPkt 0 "lastSubkey placeholder")
issuer :: Pkt -> Maybe EightOctetKeyId
issuer (SignaturePkt (SigV4 _ _ _ _ usubs _ _)) = fmap (\(SigSubPacket _ (Issuer i)) -> i) (find isIssuer usubs)
where
isIssuer (SigSubPacket _ (Issuer _)) = True
isIssuer _ = False
issuer _ = Nothing
hashDescr :: HashAlgorithm -> Either String HashDescr
hashDescr SHA1 = Right hashDescrSHA1
hashDescr RIPEMD160 = Right hashDescrRIPEMD160
hashDescr SHA256 = Right hashDescrSHA256
hashDescr SHA384 = Right hashDescrSHA384
hashDescr SHA512 = Right hashDescrSHA512
hashDescr SHA224 = Right hashDescrSHA224
hashDescr DeprecatedMD5 = Right hashDescrMD5
hashDescr x = Left $ "Unknown hash problem: " ++ show x
pubkeyToMPIs :: PKey -> [MPI]
pubkeyToMPIs (RSAPubKey k) = [MPI (RSA.public_n k), MPI (RSA.public_e k)]
pubkeyToMPIs (DSAPubKey k) = [
pkParams DSA.params_p
, pkParams DSA.params_q
, pkParams DSA.params_g
, MPI . DSA.public_y $ k
]
where pkParams f = MPI . f . DSA.public_params $ k
pubkeyToMPIs (ElGamalPubKey k) = fmap MPI k
multiplicativeInverse :: Integral a => a -> a -> a
multiplicativeInverse _ 1 = 1
multiplicativeInverse q p = (n * q + 1) `div` p
where n = p multiplicativeInverse p (q `mod` p)
sigType :: SignaturePayload -> Maybe SigType
sigType (SigV3 st _ _ _ _ _ _) = Just st
sigType (SigV4 st _ _ _ _ _ _) = Just st
sigType _ = Nothing
sigPKA :: SignaturePayload -> Maybe PubKeyAlgorithm
sigPKA (SigV3 _ _ _ pka _ _ _) = Just pka
sigPKA (SigV4 _ pka _ _ _ _ _) = Just pka
sigPKA _ = Nothing
sigHA :: SignaturePayload -> Maybe HashAlgorithm
sigHA (SigV3 _ _ _ _ ha _ _) = Just ha
sigHA (SigV4 _ _ ha _ _ _ _) = Just ha
sigHA _ = Nothing
sigCT :: SignaturePayload -> Maybe TimeStamp
sigCT (SigV3 _ ct _ _ _ _ _) = Just ct
sigCT (SigV4 _ _ _ hsubs _ _ _) = fmap (\(SigSubPacket _ (SigCreationTime i)) -> i) (find isSigCreationTime hsubs)
where
isSigCreationTime (SigSubPacket _ (SigCreationTime _)) = True
isSigCreationTime _ = False
sigCT _ = Nothing