From c111dfeb8e91d0e0d0b0daf10f4c9657244de463 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Thu, 21 May 2015 11:09:48 +0100 Subject: [PATCH] [pubkey] remove bytestring from MaskGenFunction --- Crypto/PubKey/MaskGenFunction.hs | 40 +++++++++++++++++++------------- Crypto/PubKey/RSA/OAEP.hs | 23 ++++++++++-------- Crypto/PubKey/RSA/PSS.hs | 22 +++++++++++------- 3 files changed, 50 insertions(+), 35 deletions(-) diff --git a/Crypto/PubKey/MaskGenFunction.hs b/Crypto/PubKey/MaskGenFunction.hs index 4ced936..480170f 100644 --- a/Crypto/PubKey/MaskGenFunction.hs +++ b/Crypto/PubKey/MaskGenFunction.hs @@ -5,28 +5,36 @@ -- Stability : experimental -- Portability : Good -- +{-# LANGUAGE BangPatterns #-} module Crypto.PubKey.MaskGenFunction ( MaskGenAlgorithm , mgf1 ) where -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Crypto.Number.Serialize (i2ospOf_) -import Crypto.Hash (hashWith, HashAlgorithm) -import qualified Crypto.Internal.ByteArray as B (convert) +import Crypto.Number.Serialize (i2ospOf_) +import Crypto.Hash +import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes) +import qualified Crypto.Internal.ByteArray as B -- | Represent a mask generation algorithm -type MaskGenAlgorithm = - ByteString -- ^ seed - -> Int -- ^ length to generate - -> ByteString +type MaskGenAlgorithm seed output = + seed -- ^ seed + -> Int -- ^ length to generate + -> output -- | Mask generation algorithm MGF1 -mgf1 :: HashAlgorithm hashAlg => hashAlg -> MaskGenAlgorithm -mgf1 hashAlg seed len = loop B.empty 0 - where loop t counter - | B.length t >= len = B.take len t - | otherwise = let counterBS = i2ospOf_ 4 counter - newT = t `B.append` B.convert (hashWith hashAlg (seed `B.append` counterBS)) - in loop newT (counter+1) +mgf1 :: (ByteArrayAccess seed, ByteArray output, HashAlgorithm hashAlg) + => hashAlg + -> seed + -> Int + -> output +mgf1 hashAlg seed len = + let !seededCtx = hashUpdate (hashInitWith hashAlg) seed + in B.take len $ B.concat $ map (hashCounter seededCtx) [0..fromIntegral (maxCounter-1)] + where + digestLen = hashDigestSize hashAlg + (chunks,left) = len `divMod` digestLen + maxCounter = if left > 0 then chunks + 1 else chunks + + hashCounter :: HashAlgorithm a => Context a -> Integer -> Digest a + hashCounter ctx counter = hashFinalize $ hashUpdate ctx (i2ospOf_ 4 counter :: Bytes) diff --git a/Crypto/PubKey/RSA/OAEP.hs b/Crypto/PubKey/RSA/OAEP.hs index 770c7fb..9626520 100644 --- a/Crypto/PubKey/RSA/OAEP.hs +++ b/Crypto/PubKey/RSA/OAEP.hs @@ -31,17 +31,20 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Bits (xor) +import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray) import qualified Crypto.Internal.ByteArray as B (convert) -- | Parameters for OAEP encryption/decryption -data OAEPParams hash = OAEPParams - { oaepHash :: hash -- ^ Hash function to use. - , oaepMaskGenAlg :: MaskGenAlgorithm -- ^ Mask Gen algorithm to use. - , oaepLabel :: Maybe ByteString -- ^ Optional label prepended to message. +data OAEPParams hash seed output = OAEPParams + { oaepHash :: hash -- ^ Hash function to use. + , oaepMaskGenAlg :: MaskGenAlgorithm seed output -- ^ Mask Gen algorithm to use. + , oaepLabel :: Maybe ByteString -- ^ Optional label prepended to message. } -- | Default Params with a specified hash function -defaultOAEPParams :: HashAlgorithm hash => hash -> OAEPParams hash +defaultOAEPParams :: (ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) + => hash + -> OAEPParams hash seed output defaultOAEPParams hashAlg = OAEPParams { oaepHash = hashAlg , oaepMaskGenAlg = mgf1 hashAlg @@ -51,7 +54,7 @@ defaultOAEPParams hashAlg = -- | Encrypt a message using OAEP with a predefined seed. encryptWithSeed :: HashAlgorithm hash => ByteString -- ^ Seed - -> OAEPParams hash -- ^ OAEP params to use for encryption + -> OAEPParams hash ByteString ByteString -- ^ OAEP params to use for encryption -> PublicKey -- ^ Public key. -> ByteString -- ^ Message to encrypt -> Either Error ByteString @@ -78,7 +81,7 @@ encryptWithSeed seed oaep pk msg -- | Encrypt a message using OAEP encrypt :: (HashAlgorithm hash, MonadRandom m) - => OAEPParams hash -- ^ OAEP params to use for encryption. + => OAEPParams hash ByteString ByteString -- ^ OAEP params to use for encryption. -> PublicKey -- ^ Public key. -> ByteString -- ^ Message to encrypt -> m (Either Error ByteString) @@ -92,7 +95,7 @@ encrypt oaep pk msg = do -- -- It doesn't apply the RSA decryption primitive unpad :: HashAlgorithm hash - => OAEPParams hash -- ^ OAEP params to use + => OAEPParams hash ByteString ByteString -- ^ OAEP params to use -> Int -- ^ size of the key in bytes -> ByteString -- ^ encoded message (not encrypted) -> Either Error ByteString @@ -128,7 +131,7 @@ unpad oaep k em -- If unsure always set a blinder or use decryptSafer decrypt :: HashAlgorithm hash => Maybe Blinder -- ^ Optional blinder - -> OAEPParams hash -- ^ OAEP params to use for decryption + -> OAEPParams hash ByteString ByteString -- ^ OAEP params to use for decryption -> PrivateKey -- ^ Private key -> ByteString -- ^ Cipher text -> Either Error ByteString @@ -142,7 +145,7 @@ decrypt blinder oaep pk cipher -- | Decrypt a ciphertext using OAEP and by automatically generating a blinder. decryptSafer :: (HashAlgorithm hash, MonadRandom m) - => OAEPParams hash -- ^ OAEP params to use for decryption + => OAEPParams hash ByteString ByteString -- ^ OAEP params to use for decryption -> PrivateKey -- ^ Private key -> ByteString -- ^ Cipher text -> m (Either Error ByteString) diff --git a/Crypto/PubKey/RSA/PSS.hs b/Crypto/PubKey/RSA/PSS.hs index 2bf8871..c449a97 100644 --- a/Crypto/PubKey/RSA/PSS.hs +++ b/Crypto/PubKey/RSA/PSS.hs @@ -25,20 +25,23 @@ import Crypto.Hash import Data.Bits (xor, shiftR, (.&.)) import Data.Word +import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray) import qualified Crypto.Internal.ByteArray as B (convert) import Data.ByteString (ByteString) import qualified Data.ByteString as B -- | Parameters for PSS signature/verification. -data PSSParams hash = PSSParams +data PSSParams hash seed output = PSSParams { pssHash :: hash -- ^ Hash function to use - , pssMaskGenAlg :: MaskGenAlgorithm -- ^ Mask Gen algorithm to use + , pssMaskGenAlg :: MaskGenAlgorithm seed output -- ^ Mask Gen algorithm to use , pssSaltLength :: Int -- ^ Length of salt. need to be <= to hLen. , pssTrailerField :: Word8 -- ^ Trailer field, usually 0xbc } -- | Default Params with a specified hash function -defaultPSSParams :: HashAlgorithm hash => hash -> PSSParams hash +defaultPSSParams :: (ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) + => hash + -> PSSParams hash seed output defaultPSSParams hashAlg = PSSParams { pssHash = hashAlg , pssMaskGenAlg = mgf1 hashAlg @@ -47,7 +50,7 @@ defaultPSSParams hashAlg = } -- | Default Params using SHA1 algorithm. -defaultPSSParamsSHA1 :: PSSParams SHA1 +defaultPSSParamsSHA1 :: PSSParams SHA1 ByteString ByteString defaultPSSParamsSHA1 = defaultPSSParams SHA1 -- | Sign using the PSS parameters and the salt explicitely passed as parameters. @@ -56,7 +59,7 @@ defaultPSSParamsSHA1 = defaultPSSParams SHA1 signWithSalt :: HashAlgorithm hash => ByteString -- ^ Salt to use -> Maybe Blinder -- ^ optional blinder to use - -> PSSParams hash -- ^ PSS Parameters to use + -> PSSParams hash ByteString ByteString -- ^ PSS Parameters to use -> PrivateKey -- ^ RSA Private Key -> ByteString -- ^ Message to sign -> Either Error ByteString @@ -80,7 +83,7 @@ signWithSalt salt blinder params pk m -- | Sign using the PSS Parameters sign :: (HashAlgorithm hash, MonadRandom m) => Maybe Blinder -- ^ optional blinder to use - -> PSSParams hash -- ^ PSS Parameters to use + -> PSSParams hash ByteString ByteString -- ^ PSS Parameters to use -> PrivateKey -- ^ RSA Private Key -> ByteString -- ^ Message to sign -> m (Either Error ByteString) @@ -90,7 +93,7 @@ sign blinder params pk m = do -- | Sign using the PSS Parameters and an automatically generated blinder. signSafer :: (HashAlgorithm hash, MonadRandom m) - => PSSParams hash -- ^ PSS Parameters to use + => PSSParams hash ByteString ByteString -- ^ PSS Parameters to use -> PrivateKey -- ^ private key -> ByteString -- ^ message to sign -> m (Either Error ByteString) @@ -100,8 +103,9 @@ signSafer params pk m = do -- | Verify a signature using the PSS Parameters verify :: HashAlgorithm hash - => PSSParams hash -- ^ PSS Parameters to use to verify, - -- this need to be identical to the parameters when signing + => PSSParams hash ByteString ByteString + -- ^ PSS Parameters to use to verify, + -- this need to be identical to the parameters when signing -> PublicKey -- ^ RSA Public Key -> ByteString -- ^ Message to verify -> ByteString -- ^ Signature