From ff5c89ee76c707228afc66afac573c6fd0efffa3 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 16 May 2020 08:32:17 -0400 Subject: Refactor toward draft-ietf-openpgp-rfc4880bis-09. --- Data/OpenPGP.hs | 7 --- Data/OpenPGP/Internal.hs | 86 ++++++++++++++++++++++++++++++----- Data/OpenPGP/Util/Base.hs | 3 -- Data/OpenPGP/Util/Cv25519.hs | 13 ------ Data/OpenPGP/Util/Decrypt.hs | 4 +- Data/OpenPGP/Util/DecryptSecretKey.hs | 25 ++++------ Data/OpenPGP/Util/Fingerprint.hs | 10 +--- Data/OpenPGP/Util/Sign.hs | 2 +- Data/OpenPGP/Util/Verify.hs | 4 +- 9 files changed, 89 insertions(+), 65 deletions(-) diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index 4133f38..f05f83e 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs @@ -129,9 +129,6 @@ compress algo = toStrictBS . lazyCompress algo . toLazyBS decompress :: CompressionAlgorithm -> B.ByteString -> B.ByteString decompress algo = toStrictBS . lazyDecompress algo . toLazyBS -toStrictBS :: LZ.ByteString -> B.ByteString -toStrictBS = B.concat . LZ.toChunks - toLazyBS :: B.ByteString -> LZ.ByteString toLazyBS = LZ.fromChunks . (:[]) @@ -194,10 +191,6 @@ pad l s = replicate (l - length s) '0' ++ s padBS :: Int -> B.ByteString -> B.ByteString padBS l s = B.replicate (fromIntegral l - B.length s) 0 `B.append` s -checksum :: B.ByteString -> Word16 -checksum = fromIntegral . - B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) (0::Integer) - data Packet = AsymmetricSessionKeyPacket { version :: Word8, diff --git a/Data/OpenPGP/Internal.hs b/Data/OpenPGP/Internal.hs index a4cdc10..a62923a 100644 --- a/Data/OpenPGP/Internal.hs +++ b/Data/OpenPGP/Internal.hs @@ -1,17 +1,47 @@ -{-# LANGUAGE BangPatterns, MagicHash #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} module Data.OpenPGP.Internal where -import Data.Bits -import qualified Data.ByteString as BS -import qualified Data.ByteString.Internal as BS -import Data.Word -import Foreign.ForeignPtr -import Foreign.Ptr -import Foreign.Storable -import GHC.Exts -import GHC.Integer.GMP.Internals -import System.Endian -import System.IO.Unsafe +import Data.Bits +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BS +import qualified Data.ByteString.Lazy as BL +import Data.Char +import Data.Int +import Data.Word +import Foreign.ForeignPtr +import Foreign.Ptr +import Foreign.Storable +import GHC.Exts +import GHC.Integer.GMP.Internals +import System.Endian +import System.IO.Unsafe +import Numeric (showHex) + +#if defined(VERSION_cryptonite) +import qualified Data.ByteArray as Bytes +import Crypto.Hash.Algorithms +import Crypto.Hash +import Crypto.Error +#else +import qualified Data.Byteable as Vincent +import Crypto.Hash.SHA1 as SHA1 +#endif + +#ifdef CEREAL +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as B (fromString, toString) +import Data.Serialize +#define BINARY_CLASS Serialize +#else +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy.UTF8 as B (fromString, toString) +#define BINARY_CLASS Binary +#endif @@ -91,3 +121,35 @@ integerToLE i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \p let Ptr addr = ptr cnt <- exportIntegerToAddr i addr 0# return () + +toStrictBS :: B.ByteString -> BS.ByteString +toStrictBS = BS.concat . B.toChunks + +checksum :: B.ByteString -> Word16 +checksum = fromIntegral . + B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) (0::Integer) + + +checksumForKey :: Word8 {- s2k_usage byte -} -> (Int64, B.ByteString -> BS.ByteString) +checksumForKey 254 = (20, sha1 . toStrictBS) + where +#if defined(VERSION_cryptonite) + sha1 x = Bytes.convert (hash x :: Digest SHA1) +#else + sha1 = SHA1.hash +#endif +checksumForKey _ = (2, toStrictBS . encode . checksum) + -- Words16s are written as 2 bytes in big-endian (network) order + +hexString :: [Word8] -> String +hexString = foldr (pad `oo` showHex) "" + where + pad s | odd $ length s = '0':s + | otherwise = s + + oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c + oo = (.) . (.) + +hexify :: BS.ByteString -> String +hexify = map toUpper . hexString . BS.unpack + diff --git a/Data/OpenPGP/Util/Base.hs b/Data/OpenPGP/Util/Base.hs index b43427c..431c12c 100644 --- a/Data/OpenPGP/Util/Base.hs +++ b/Data/OpenPGP/Util/Base.hs @@ -76,9 +76,6 @@ ecdsaKey k = Vincent.ECDSA.PublicKey curve (Vincent.ECDSA.Point x y) curve = curveFromOID (keyParam 'c' k) -toStrictBS :: LZ.ByteString -> BS.ByteString -toStrictBS = BS.concat . LZ.toChunks - toLazyBS :: BS.ByteString -> LZ.ByteString toLazyBS = LZ.fromChunks . (:[]) diff --git a/Data/OpenPGP/Util/Cv25519.hs b/Data/OpenPGP/Util/Cv25519.hs index abf1ba6..bc1cacb 100644 --- a/Data/OpenPGP/Util/Cv25519.hs +++ b/Data/OpenPGP/Util/Cv25519.hs @@ -67,19 +67,6 @@ privateCv25519Key k@SecretKeyPacket { key_algorithm = ECC, symmetric_algorithm = CryptoPassed cv25519sec -> Just cv25519sec CryptoFailed err -> Nothing -hexify = map toUpper . hexString . BS.unpack - - - -hexString :: [Word8] -> String -hexString = foldr (pad `oo` showHex) "" - where - pad s | odd $ length s = '0':s - | otherwise = s - - oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c - oo = (.) . (.) - cv25519Key :: [(Char,MPI)] -> Maybe Cv25519.PublicKey cv25519Key k = do MPI flag <- lookup 'f' k diff --git a/Data/OpenPGP/Util/Decrypt.hs b/Data/OpenPGP/Util/Decrypt.hs index 84bead5..637d754 100644 --- a/Data/OpenPGP/Util/Decrypt.hs +++ b/Data/OpenPGP/Util/Decrypt.hs @@ -14,7 +14,7 @@ import Data.OpenPGP.Util.Base -- decryption codec for withS2K simpleUnCFB :: (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString -simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . toStrictBS) +simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . LZ.toStrict) withS2K' :: OpenPGP.SymmetricAlgorithm -> Maybe OpenPGP.S2K -> LZ.ByteString -> (forall b. Vincent.BlockCipher b => b -> x) -> x @@ -29,7 +29,7 @@ string2key ms2k s = cipher where #if defined(VERSION_cryptonite) CryptoPassed cipher = Vincent.cipherInit k - k = toStrictBS $ LZ.take ksize $ maybe s (\s2k -> OpenPGP.string2key hashBySymbol s2k s) ms2k + k = LZ.toStrict $ LZ.take ksize $ maybe s (\s2k -> OpenPGP.string2key hashBySymbol s2k s) ms2k #else cipher = Vincent.cipherInit k Right k = Vincent.makeKey $ toStrictBS $ diff --git a/Data/OpenPGP/Util/DecryptSecretKey.hs b/Data/OpenPGP/Util/DecryptSecretKey.hs index 57dd8c3..9f9e42a 100644 --- a/Data/OpenPGP/Util/DecryptSecretKey.hs +++ b/Data/OpenPGP/Util/DecryptSecretKey.hs @@ -4,10 +4,11 @@ module Data.OpenPGP.Util.DecryptSecretKey where import qualified Data.OpenPGP as OpenPGP -import Data.OpenPGP.Internal (decode_s2k_count) +import Data.OpenPGP.Internal (decode_s2k_count,checksumForKey) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LZ -import Data.Word (Word16) +import Data.Word +import Data.Int import Data.Maybe import Control.Monad (foldM) import Data.Binary (get,Binary,Get,encode,put) @@ -53,7 +54,7 @@ data Enciphered = withIV :: forall k. (Vincent.BlockCipher k) => (Vincent.IV k -> LZ.ByteString -> LZ.ByteString) -> Enciphered -> LZ.ByteString withIV f (EncipheredWithIV s) = f iv bs where - Just iv = Vincent.makeIV (toStrictBS ivbs) + Just iv = Vincent.makeIV (LZ.toStrict ivbs) (ivbs,bs) = LZ.splitAt (fromIntegral ivlen) s #if defined(VERSION_cryptonite) ivlen = Bytes.length (Vincent.nullIV :: Vincent.IV k) @@ -64,6 +65,7 @@ withIV f (EncipheredWithIV s) = f iv bs #endif withIV f (EncipheredZeroIV s) = f Vincent.nullIV s + decryptSecretKey :: BS.ByteString -- ^ Passphrase -> OpenPGP.Packet -- ^ Encrypted SecretKeyPacket @@ -74,7 +76,7 @@ decryptSecretKey pass k@(OpenPGP.SecretKeyPacket { OpenPGP.version = 4, OpenPGP.key_algorithm = kalgo, OpenPGP.s2k = s2k, OpenPGP.symmetric_algorithm = salgo, OpenPGP.key = existing, OpenPGP.encrypted_data = encd - }) | chkF material == toStrictBS chk = + }) | chkF material == LZ.toStrict chk = fmap (\m -> k { OpenPGP.s2k_useage = 0, OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted, @@ -87,18 +89,9 @@ decryptSecretKey pass k@(OpenPGP.SecretKeyPacket { (foldM (\m f -> do {mpi <- get; return $ (f,mpi):m}) existing (OpenPGP.secret_key_fields kalgo)) material (material, chk) = LZ.splitAt (LZ.length decd - chkSize) decd - (chkSize, chkF) - | OpenPGP.s2k_useage k == 254 = (20, sha1 . toStrictBS) - | otherwise = (2, toStrictBS . encode . checksum . toStrictBS) - -- Words16s are written as 2 bytes in big-endian (network) order + (chkSize, chkF) = checksumForKey (OpenPGP.s2k_useage k) decd = withS2K simpleUnCFB salgo (Just s2k) (toLazyBS pass) (EncipheredWithIV encd) -#if defined(VERSION_cryptonite) - sha1 x = Bytes.convert (hash x :: Digest SHA1) -#else - sha1 = SHA1.hash -#endif - decryptSecretKey _ _ = Nothing checksum :: BS.ByteString -> Word16 @@ -133,7 +126,7 @@ withS2K codec OpenPGP.CAST5 s2k s = withIV $ codec (string2key s2k s :: Thoma withS2K codec algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.withS2K" simpleCFB :: forall k g. (Vincent.BlockCipher k, RG g) => g -> k -> LZ.ByteString -> (LZ.ByteString, g) -simpleCFB g k bs = ( padThenUnpad k (LZ.fromChunks . (ivbs:) . (:[]) . Vincent.cfbEncrypt k iv . toStrictBS) bs +simpleCFB g k bs = ( padThenUnpad k (LZ.fromChunks . (ivbs:) . (:[]) . Vincent.cfbEncrypt k iv . LZ.toStrict) bs , g' ) where Just iv = Vincent.makeIV ivbs @@ -180,7 +173,7 @@ encryptSecretKey passphrase s2k salgo plain = do -- two-octet checksum is required. s2k_usage_octet = 255 -- chkSize = 2 - chkF = toStrictBS . encode . checksum . toStrictBS + chkF = LZ.toStrict . encode . checksum . LZ.toStrict -- k = string2key s2k passphrase -- OpenPGP.string2key hashBySymbol s2k passphrase diff --git a/Data/OpenPGP/Util/Fingerprint.hs b/Data/OpenPGP/Util/Fingerprint.hs index cda25f6..955748d 100644 --- a/Data/OpenPGP/Util/Fingerprint.hs +++ b/Data/OpenPGP/Util/Fingerprint.hs @@ -2,6 +2,7 @@ module Data.OpenPGP.Util.Fingerprint (fingerprint,fingerprintv,Fingerprint(..),hex) where import qualified Data.OpenPGP as OpenPGP +import Data.OpenPGP.Internal import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LZ import Data.Char (toUpper) @@ -28,15 +29,6 @@ instance Show Fingerprint where hex :: Fingerprint -> String hex (Fingerprint bs) = hexify bs - where - hexify = map toUpper . hexString . BS.unpack - - hexString :: [Word8] -> String - hexString = foldr (pad `oo` showHex) "" - where - pad s | odd $ length s = '0':s - | otherwise = s - -- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket -- diff --git a/Data/OpenPGP/Util/Sign.hs b/Data/OpenPGP/Util/Sign.hs index b9c6435..a074dcb 100644 --- a/Data/OpenPGP/Util/Sign.hs +++ b/Data/OpenPGP/Util/Sign.hs @@ -113,7 +113,7 @@ unsafeSign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [s (Right rsaFinal,_) = Vincent.RSA.signSafer g desc (privateRSAkey k) dta #endif dsaTruncate (Vincent.DSA.PrivateKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q) - dta = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig + dta = LZ.toStrict $ encode over `LZ.append` OpenPGP.trailer sig sig = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over) -- padding = emsa_pkcs1_v1_5_hash_padding hsh desc = hashAlgoDesc hsh diff --git a/Data/OpenPGP/Util/Verify.hs b/Data/OpenPGP/Util/Verify.hs index 66db2ab..52e9005 100644 --- a/Data/OpenPGP/Util/Verify.hs +++ b/Data/OpenPGP/Util/Verify.hs @@ -46,7 +46,7 @@ verify keys over = over {OpenPGP.signatures_over = mapMaybe (uncurry $ verifyOne keys) sigs} where sigs :: [(OpenPGP.Packet,BS.ByteString)] - sigs = map (\s -> (s, toStrictBS $ encode over `LZ.append` OpenPGP.trailer s)) + sigs = map (\s -> (s, LZ.toStrict $ encode over `LZ.append` OpenPGP.trailer s)) (OpenPGP.signatures_over over) verifyOne :: OpenPGP.Message -> OpenPGP.Packet -> BS.ByteString -> Maybe OpenPGP.Packet @@ -93,7 +93,7 @@ verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard #else rsaVerify k = Just $ Vincent.RSA.verify desc (rsaKey k) over rsaSig #endif - [rsaSig] = map (toStrictBS . LZ.drop 2 . encode) (OpenPGP.signature sig) + [rsaSig] = map (LZ.toStrict . LZ.drop 2 . encode) (OpenPGP.signature sig) dsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in Vincent.DSA.Signature r s ecdsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in -- cgit v1.2.3