module Crypto.PubKey.RSA.PSS
( PSSParams(..)
, defaultPSSParams
, defaultPSSParamsSHA1
, signWithSalt
, signDigestWithSalt
, sign
, signDigest
, signSafer
, signDigestSafer
, verify
, verifyDigest
) where
import Crypto.Random.Types
import Crypto.PubKey.RSA.Types
import Crypto.PubKey.RSA.Prim
import Crypto.PubKey.RSA (generateBlinder)
import Crypto.PubKey.MaskGenFunction
import Crypto.Hash
import Crypto.Number.Basic (numBits)
import Data.Bits (xor, shiftR, (.&.))
import Data.Word
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)
import qualified Crypto.Internal.ByteArray as B (convert, eq)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
data PSSParams hash seed output = PSSParams
{ forall hash seed output. PSSParams hash seed output -> hash
pssHash :: hash
, forall hash seed output.
PSSParams hash seed output -> MaskGenAlgorithm seed output
pssMaskGenAlg :: MaskGenAlgorithm seed output
, forall hash seed output. PSSParams hash seed output -> Int
pssSaltLength :: Int
, forall hash seed output. PSSParams hash seed output -> Word8
pssTrailerField :: Word8
}
defaultPSSParams :: (ByteArrayAccess seed, ByteArray output, HashAlgorithm hash)
=> hash
-> PSSParams hash seed output
defaultPSSParams :: forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> PSSParams hash seed output
defaultPSSParams hash
hashAlg =
PSSParams { pssHash :: hash
pssHash = hash
hashAlg
, pssMaskGenAlg :: MaskGenAlgorithm seed output
pssMaskGenAlg = forall seed output hashAlg.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hashAlg) =>
hashAlg -> seed -> Int -> output
mgf1 hash
hashAlg
, pssSaltLength :: Int
pssSaltLength = forall a. HashAlgorithm a => a -> Int
hashDigestSize hash
hashAlg
, pssTrailerField :: Word8
pssTrailerField = Word8
0xbc
}
defaultPSSParamsSHA1 :: PSSParams SHA1 ByteString ByteString
defaultPSSParamsSHA1 :: PSSParams SHA1 ByteString ByteString
defaultPSSParamsSHA1 = forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> PSSParams hash seed output
defaultPSSParams SHA1
SHA1
signDigestWithSalt :: HashAlgorithm hash
=> ByteString
-> Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> Digest hash
-> Either Error ByteString
signDigestWithSalt :: forall hash.
HashAlgorithm hash =>
ByteString
-> Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> Digest hash
-> Either Error ByteString
signDigestWithSalt ByteString
salt Maybe Blinder
blinder PSSParams hash ByteString ByteString
params PrivateKey
pk Digest hash
digest
| Int
emLen forall a. Ord a => a -> a -> Bool
< Int
hashLen forall a. Num a => a -> a -> a
+ Int
saltLen forall a. Num a => a -> a -> a
+ Int
2 = forall a b. a -> Either a b
Left Error
InvalidParameters
| Bool
otherwise = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall ba. ByteArray ba => Maybe Blinder -> PrivateKey -> ba -> ba
dp Maybe Blinder
blinder PrivateKey
pk ByteString
em
where k :: Int
k = PrivateKey -> Int
private_size PrivateKey
pk
emLen :: Int
emLen = if Int -> Bool
emTruncate Int
pubBits then Int
k forall a. Num a => a -> a -> a
- Int
1 else Int
k
mHash :: ByteString
mHash = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Digest hash
digest
dbLen :: Int
dbLen = Int
emLen forall a. Num a => a -> a -> a
- Int
hashLen forall a. Num a => a -> a -> a
- Int
1
saltLen :: Int
saltLen = ByteString -> Int
B.length ByteString
salt
hashLen :: Int
hashLen = forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall hash seed output. PSSParams hash seed output -> hash
pssHash PSSParams hash ByteString ByteString
params)
pubBits :: Int
pubBits = Integer -> Int
numBits (PrivateKey -> Integer
private_n PrivateKey
pk)
m' :: ByteString
m' = [ByteString] -> ByteString
B.concat [Int -> Word8 -> ByteString
B.replicate Int
8 Word8
0,ByteString
mHash,ByteString
salt]
h :: ByteString
h = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall a b. (a -> b) -> a -> b
$ forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith (forall hash seed output. PSSParams hash seed output -> hash
pssHash PSSParams hash ByteString ByteString
params) ByteString
m'
db :: ByteString
db = [ByteString] -> ByteString
B.concat [Int -> Word8 -> ByteString
B.replicate (Int
dbLen forall a. Num a => a -> a -> a
- Int
saltLen forall a. Num a => a -> a -> a
- Int
1) Word8
0,Word8 -> ByteString
B.singleton Word8
1,ByteString
salt]
dbmask :: ByteString
dbmask = forall hash seed output.
PSSParams hash seed output -> MaskGenAlgorithm seed output
pssMaskGenAlg PSSParams hash ByteString ByteString
params ByteString
h Int
dbLen
maskedDB :: ByteString
maskedDB = [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
normalizeToKeySize Int
pubBits forall a b. (a -> b) -> a -> b
$ forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
B.zipWith forall a. Bits a => a -> a -> a
xor ByteString
db ByteString
dbmask
em :: ByteString
em = [ByteString] -> ByteString
B.concat [ByteString
maskedDB, ByteString
h, Word8 -> ByteString
B.singleton (forall hash seed output. PSSParams hash seed output -> Word8
pssTrailerField PSSParams hash ByteString ByteString
params)]
signWithSalt :: HashAlgorithm hash
=> ByteString
-> Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> Either Error ByteString
signWithSalt :: forall hash.
HashAlgorithm hash =>
ByteString
-> Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> Either Error ByteString
signWithSalt ByteString
salt Maybe Blinder
blinder PSSParams hash ByteString ByteString
params PrivateKey
pk ByteString
m = forall hash.
HashAlgorithm hash =>
ByteString
-> Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> Digest hash
-> Either Error ByteString
signDigestWithSalt ByteString
salt Maybe Blinder
blinder PSSParams hash ByteString ByteString
params PrivateKey
pk Digest hash
mHash
where mHash :: Digest hash
mHash = forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith (forall hash seed output. PSSParams hash seed output -> hash
pssHash PSSParams hash ByteString ByteString
params) ByteString
m
sign :: (HashAlgorithm hash, MonadRandom m)
=> Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> m (Either Error ByteString)
sign :: forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> m (Either Error ByteString)
sign Maybe Blinder
blinder PSSParams hash ByteString ByteString
params PrivateKey
pk ByteString
m = do
ByteString
salt <- forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (forall hash seed output. PSSParams hash seed output -> Int
pssSaltLength PSSParams hash ByteString ByteString
params)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall hash.
HashAlgorithm hash =>
ByteString
-> Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> Either Error ByteString
signWithSalt ByteString
salt Maybe Blinder
blinder PSSParams hash ByteString ByteString
params PrivateKey
pk ByteString
m)
signDigest :: (HashAlgorithm hash, MonadRandom m)
=> Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> Digest hash
-> m (Either Error ByteString)
signDigest :: forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> Digest hash
-> m (Either Error ByteString)
signDigest Maybe Blinder
blinder PSSParams hash ByteString ByteString
params PrivateKey
pk Digest hash
digest = do
ByteString
salt <- forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (forall hash seed output. PSSParams hash seed output -> Int
pssSaltLength PSSParams hash ByteString ByteString
params)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall hash.
HashAlgorithm hash =>
ByteString
-> Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> Digest hash
-> Either Error ByteString
signDigestWithSalt ByteString
salt Maybe Blinder
blinder PSSParams hash ByteString ByteString
params PrivateKey
pk Digest hash
digest)
signSafer :: (HashAlgorithm hash, MonadRandom m)
=> PSSParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> m (Either Error ByteString)
signSafer :: forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
PSSParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either Error ByteString)
signSafer PSSParams hash ByteString ByteString
params PrivateKey
pk ByteString
m = do
Blinder
blinder <- forall (m :: * -> *). MonadRandom m => Integer -> m Blinder
generateBlinder (PrivateKey -> Integer
private_n PrivateKey
pk)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> ByteString
-> m (Either Error ByteString)
sign (forall a. a -> Maybe a
Just Blinder
blinder) PSSParams hash ByteString ByteString
params PrivateKey
pk ByteString
m
signDigestSafer :: (HashAlgorithm hash, MonadRandom m)
=> PSSParams hash ByteString ByteString
-> PrivateKey
-> Digest hash
-> m (Either Error ByteString)
signDigestSafer :: forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
PSSParams hash ByteString ByteString
-> PrivateKey -> Digest hash -> m (Either Error ByteString)
signDigestSafer PSSParams hash ByteString ByteString
params PrivateKey
pk Digest hash
digest = do
Blinder
blinder <- forall (m :: * -> *). MonadRandom m => Integer -> m Blinder
generateBlinder (PrivateKey -> Integer
private_n PrivateKey
pk)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
Maybe Blinder
-> PSSParams hash ByteString ByteString
-> PrivateKey
-> Digest hash
-> m (Either Error ByteString)
signDigest (forall a. a -> Maybe a
Just Blinder
blinder) PSSParams hash ByteString ByteString
params PrivateKey
pk Digest hash
digest
verify :: HashAlgorithm hash
=> PSSParams hash ByteString ByteString
-> PublicKey
-> ByteString
-> ByteString
-> Bool
verify :: forall hash.
HashAlgorithm hash =>
PSSParams hash ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
verify PSSParams hash ByteString ByteString
params PublicKey
pk ByteString
m = forall hash.
HashAlgorithm hash =>
PSSParams hash ByteString ByteString
-> PublicKey -> Digest hash -> ByteString -> Bool
verifyDigest PSSParams hash ByteString ByteString
params PublicKey
pk Digest hash
mHash
where mHash :: Digest hash
mHash = forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith (forall hash seed output. PSSParams hash seed output -> hash
pssHash PSSParams hash ByteString ByteString
params) ByteString
m
verifyDigest :: HashAlgorithm hash
=> PSSParams hash ByteString ByteString
-> PublicKey
-> Digest hash
-> ByteString
-> Bool
verifyDigest :: forall hash.
HashAlgorithm hash =>
PSSParams hash ByteString ByteString
-> PublicKey -> Digest hash -> ByteString -> Bool
verifyDigest PSSParams hash ByteString ByteString
params PublicKey
pk Digest hash
digest ByteString
s
| ByteString -> Int
B.length ByteString
s forall a. Eq a => a -> a -> Bool
/= Int
k = Bool
False
| (Word8 -> Bool) -> ByteString -> Bool
B.any (forall a. Eq a => a -> a -> Bool
/= Word8
0) ByteString
pre = Bool
False
| HasCallStack => ByteString -> Word8
B.last ByteString
em forall a. Eq a => a -> a -> Bool
/= forall hash seed output. PSSParams hash seed output -> Word8
pssTrailerField PSSParams hash ByteString ByteString
params = Bool
False
| (Word8 -> Bool) -> ByteString -> Bool
B.any (forall a. Eq a => a -> a -> Bool
/= Word8
0) ByteString
ps0 = Bool
False
| ByteString
b1 forall a. Eq a => a -> a -> Bool
/= Word8 -> ByteString
B.singleton Word8
1 = Bool
False
| Bool
otherwise = forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
B.eq ByteString
h Digest hash
h'
where
hashLen :: Int
hashLen = forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall hash seed output. PSSParams hash seed output -> hash
pssHash PSSParams hash ByteString ByteString
params)
mHash :: ByteString
mHash = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Digest hash
digest
k :: Int
k = PublicKey -> Int
public_size PublicKey
pk
emLen :: Int
emLen = if Int -> Bool
emTruncate Int
pubBits then Int
k forall a. Num a => a -> a -> a
- Int
1 else Int
k
dbLen :: Int
dbLen = Int
emLen forall a. Num a => a -> a -> a
- Int
hashLen forall a. Num a => a -> a -> a
- Int
1
pubBits :: Int
pubBits = Integer -> Int
numBits (PublicKey -> Integer
public_n PublicKey
pk)
(ByteString
pre, ByteString
em) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
k forall a. Num a => a -> a -> a
- Int
emLen) (forall ba. ByteArray ba => PublicKey -> ba -> ba
ep PublicKey
pk ByteString
s)
maskedDB :: ByteString
maskedDB = Int -> ByteString -> ByteString
B.take Int
dbLen ByteString
em
h :: ByteString
h = Int -> ByteString -> ByteString
B.take Int
hashLen forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
maskedDB) ByteString
em
dbmask :: ByteString
dbmask = forall hash seed output.
PSSParams hash seed output -> MaskGenAlgorithm seed output
pssMaskGenAlg PSSParams hash ByteString ByteString
params ByteString
h Int
dbLen
db :: ByteString
db = [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
normalizeToKeySize Int
pubBits forall a b. (a -> b) -> a -> b
$ forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
B.zipWith forall a. Bits a => a -> a -> a
xor ByteString
maskedDB ByteString
dbmask
(ByteString
ps0,ByteString
z) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (forall a. Eq a => a -> a -> Bool
== Word8
1) ByteString
db
(ByteString
b1,ByteString
salt) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
1 ByteString
z
m' :: ByteString
m' = [ByteString] -> ByteString
B.concat [Int -> Word8 -> ByteString
B.replicate Int
8 Word8
0,ByteString
mHash,ByteString
salt]
h' :: Digest hash
h' = forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith (forall hash seed output. PSSParams hash seed output -> hash
pssHash PSSParams hash ByteString ByteString
params) ByteString
m'
emTruncate :: Int -> Bool
emTruncate :: Int -> Bool
emTruncate Int
bits = ((Int
bitsforall a. Num a => a -> a -> a
-Int
1) forall a. Bits a => a -> a -> a
.&. Int
0x7) forall a. Eq a => a -> a -> Bool
== Int
0
normalizeToKeySize :: Int -> [Word8] -> [Word8]
normalizeToKeySize :: Int -> [Word8] -> [Word8]
normalizeToKeySize Int
_ [] = []
normalizeToKeySize Int
bits (Word8
x:[Word8]
xs) = Word8
x forall a. Bits a => a -> a -> a
.&. Word8
mask forall a. a -> [a] -> [a]
: [Word8]
xs
where mask :: Word8
mask = if Int
sh forall a. Ord a => a -> a -> Bool
> Int
0 then Word8
0xff forall a. Bits a => a -> Int -> a
`shiftR` (Int
8forall a. Num a => a -> a -> a
-Int
sh) else Word8
0xff
sh :: Int
sh = (Int
bitsforall a. Num a => a -> a -> a
-Int
1) forall a. Bits a => a -> a -> a
.&. Int
0x7