-- |
-- Module      : Crypto.PubKey.RSA.PKCS15
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good
--
module Crypto.PubKey.RSA.PKCS15
    (
    -- * Padding and unpadding
      pad
    , padSignature
    , unpad
    -- * Private key operations
    , decrypt
    , decryptSafer
    , sign
    , signSafer
    -- * Public key operations
    , encrypt
    , verify
    -- * Hash ASN1 description
    , HashAlgorithmASN1
    ) where

import           Crypto.Random.Types
import           Crypto.PubKey.Internal (and')
import           Crypto.PubKey.RSA.Types
import           Crypto.PubKey.RSA.Prim
import           Crypto.PubKey.RSA (generateBlinder)
import           Crypto.Hash

import           Data.ByteString (ByteString)
import           Data.Word

import           Crypto.Internal.ByteArray (ByteArray, Bytes)
import qualified Crypto.Internal.ByteArray as B

-- | A specialized class for hash algorithm that can product
-- a ASN1 wrapped description the algorithm plus the content
-- of the digest.
class HashAlgorithm hashAlg => HashAlgorithmASN1 hashAlg where
    -- | Convert a Digest into an ASN1 wrapped descriptive ByteArray
    hashDigestASN1 :: ByteArray out => Digest hashAlg -> out

-- http://uk.emc.com/emc-plus/rsa-labs/pkcs/files/h11300-wp-pkcs-1v2-2-rsa-cryptography-standard.pdf
-- EMSA-PKCS1-v1_5
instance HashAlgorithmASN1 MD2 where
    hashDigestASN1 :: Digest MD2 -> out
hashDigestASN1 = [Word8] -> Digest MD2 -> out
forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x02,0x05,0x00,0x04,0x10]
instance HashAlgorithmASN1 MD5 where
    hashDigestASN1 :: Digest MD5 -> out
hashDigestASN1 = [Word8] -> Digest MD5 -> out
forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [0x30,0x20,0x30,0x0c,0x06,0x08,0x2a,0x86,0x48,0x86,0xf7,0x0d,0x02,0x05,0x05,0x00,0x04,0x10]
instance HashAlgorithmASN1 SHA1 where
    hashDigestASN1 :: Digest SHA1 -> out
hashDigestASN1 = [Word8] -> Digest SHA1 -> out
forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [0x30,0x21,0x30,0x09,0x06,0x05,0x2b,0x0e,0x03,0x02,0x1a,0x05,0x00,0x04,0x14]
instance HashAlgorithmASN1 SHA224 where
    hashDigestASN1 :: Digest SHA224 -> out
hashDigestASN1 = [Word8] -> Digest SHA224 -> out
forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [0x30,0x2d,0x30,0x0d,0x06,0x09,0x60,0x86,0x48,0x01,0x65,0x03,0x04,0x02,0x04,0x05,0x00,0x04,0x1c]
instance HashAlgorithmASN1 SHA256 where
    hashDigestASN1 :: Digest SHA256 -> out
hashDigestASN1 = [Word8] -> Digest SHA256 -> out
forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [0x30,0x31,0x30,0x0d,0x06,0x09,0x60,0x86,0x48,0x01,0x65,0x03,0x04,0x02,0x01,0x05,0x00,0x04,0x20]
instance HashAlgorithmASN1 SHA384 where
    hashDigestASN1 :: Digest SHA384 -> out
hashDigestASN1 = [Word8] -> Digest SHA384 -> out
forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [0x30,0x41,0x30,0x0d,0x06,0x09,0x60,0x86,0x48,0x01,0x65,0x03,0x04,0x02,0x02,0x05,0x00,0x04,0x30]
instance HashAlgorithmASN1 SHA512 where
    hashDigestASN1 :: Digest SHA512 -> out
hashDigestASN1 = [Word8] -> Digest SHA512 -> out
forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [0x30,0x51,0x30,0x0d,0x06,0x09,0x60,0x86,0x48,0x01,0x65,0x03,0x04,0x02,0x03,0x05,0x00,0x04,0x40]
instance HashAlgorithmASN1 SHA512t_224 where
    hashDigestASN1 :: Digest SHA512t_224 -> out
hashDigestASN1 = [Word8] -> Digest SHA512t_224 -> out
forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [0x30,0x2d,0x30,0x0d,0x06,0x09,0x60,0x86,0x48,0x01,0x65,0x03,0x04,0x02,0x05,0x05,0x00,0x04,0x1c]
instance HashAlgorithmASN1 SHA512t_256 where
    hashDigestASN1 :: Digest SHA512t_256 -> out
hashDigestASN1 = [Word8] -> Digest SHA512t_256 -> out
forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [0x30,0x31,0x30,0x0d,0x06,0x09,0x60,0x86,0x48,0x01,0x65,0x03,0x04,0x02,0x06,0x05,0x00,0x04,0x20]
instance HashAlgorithmASN1 RIPEMD160 where
    hashDigestASN1 :: Digest RIPEMD160 -> out
hashDigestASN1 = [Word8] -> Digest RIPEMD160 -> out
forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [0x30,0x21,0x30,0x09,0x06,0x05,0x2b,0x24,0x03,0x02,0x01,0x05,0x00,0x04,0x14]

--
-- ** Hack **
--
-- this happens to not need a real ASN1 encoder, because
-- thanks to the digest being a specific size AND
-- that the digest data is the last bytes in the encoding,
-- this allows to just prepend the right prefix to the
-- computed digest, to make it in the expected and valid shape.
--
-- Otherwise the expected structure is in the following form:
--
--   Start Sequence
--     ,Start Sequence
--       ,OID oid
--       ,Null
--     ,End Sequence
--     ,OctetString digest
--   ,End Sequence
addDigestPrefix :: ByteArray out => [Word8] -> Digest hashAlg -> out
addDigestPrefix :: [Word8] -> Digest hashAlg -> out
addDigestPrefix prefix :: [Word8]
prefix digest :: Digest hashAlg
digest =
    [Word8] -> out
forall a. ByteArray a => [Word8] -> a
B.pack [Word8]
prefix out -> out -> out
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` Digest hashAlg -> out
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert Digest hashAlg
digest

-- | This produce a standard PKCS1.5 padding for encryption
pad :: (MonadRandom m, ByteArray message) => Int -> message -> m (Either Error message)
pad :: Int -> message -> m (Either Error message)
pad len :: Int
len m :: message
m
    | message -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length message
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- 11 = Either Error message -> m (Either Error message)
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> Either Error message
forall a b. a -> Either a b
Left Error
MessageTooLong)
    | Bool
otherwise             = do
        message
padding <- Int -> m message
forall bytearray (m :: * -> *).
(ByteArray bytearray, MonadRandom m) =>
Int -> m bytearray
getNonNullRandom (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- message -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length message
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3)
        Either Error message -> m (Either Error message)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error message -> m (Either Error message))
-> Either Error message -> m (Either Error message)
forall a b. (a -> b) -> a -> b
$ message -> Either Error message
forall a b. b -> Either a b
Right (message -> Either Error message)
-> message -> Either Error message
forall a b. (a -> b) -> a -> b
$ [message] -> message
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat [ [Word8] -> message
forall a. ByteArray a => [Word8] -> a
B.pack [0,2], message
padding, [Word8] -> message
forall a. ByteArray a => [Word8] -> a
B.pack [0], message
m ]

  where
    -- get random non-null bytes
    getNonNullRandom :: (ByteArray bytearray, MonadRandom m) => Int -> m bytearray
    getNonNullRandom :: Int -> m bytearray
getNonNullRandom n :: Int
n = do
        Bytes
bs0 <- Int -> m Bytes
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
n
        let bytes :: bytearray
bytes = [Word8] -> bytearray
forall a. ByteArray a => [Word8] -> a
B.pack ([Word8] -> bytearray) -> [Word8] -> bytearray
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Bytes -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
B.unpack (Bytes
bs0 :: Bytes)
            left :: Int
left  = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- bytearray -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bytearray
bytes
        if Int
left Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
            then bytearray -> m bytearray
forall (m :: * -> *) a. Monad m => a -> m a
return bytearray
bytes
            else do bytearray
bend <- Int -> m bytearray
forall bytearray (m :: * -> *).
(ByteArray bytearray, MonadRandom m) =>
Int -> m bytearray
getNonNullRandom Int
left
                    bytearray -> m bytearray
forall (m :: * -> *) a. Monad m => a -> m a
return (bytearray
bytes bytearray -> bytearray -> bytearray
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` bytearray
bend)

-- | Produce a standard PKCS1.5 padding for signature
padSignature :: ByteArray signature => Int -> signature -> Either Error signature
padSignature :: Int -> signature -> Either Error signature
padSignature klen :: Int
klen signature :: signature
signature
    | Int
klen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
siglen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 11 = Error -> Either Error signature
forall a b. a -> Either a b
Left Error
SignatureTooLong
    | Bool
otherwise          = signature -> Either Error signature
forall a b. b -> Either a b
Right ([Word8] -> signature
forall a. ByteArray a => [Word8] -> a
B.pack [Word8]
padding signature -> signature -> signature
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` signature
signature)
  where
        siglen :: Int
siglen    = signature -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length signature
signature
        padding :: [Word8]
padding   = 0 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: 1 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: (Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate (Int
klen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
siglen Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) 0xff [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [0])

-- | Try to remove a standard PKCS1.5 encryption padding.
unpad :: ByteArray bytearray => bytearray -> Either Error bytearray
unpad :: bytearray -> Either Error bytearray
unpad packed :: bytearray
packed
    | Bool
paddingSuccess = bytearray -> Either Error bytearray
forall a b. b -> Either a b
Right bytearray
m
    | Bool
otherwise      = Error -> Either Error bytearray
forall a b. a -> Either a b
Left Error
MessageNotRecognized
  where
        (zt :: bytearray
zt, ps0m :: bytearray
ps0m)   = Int -> bytearray -> (bytearray, bytearray)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt 2 bytearray
packed
        (ps :: bytearray
ps, zm :: bytearray
zm)     = (Word8 -> Bool) -> bytearray -> (bytearray, bytearray)
forall bs. ByteArray bs => (Word8 -> Bool) -> bs -> (bs, bs)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) bytearray
ps0m
        (z :: bytearray
z, m :: bytearray
m)       = Int -> bytearray -> (bytearray, bytearray)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt 1 bytearray
zm
        paddingSuccess :: Bool
paddingSuccess = [Bool] -> Bool
and' [ bytearray
zt bytearray -> Bytes -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`B.constEq` ([Word8] -> Bytes
forall a. ByteArray a => [Word8] -> a
B.pack [0,2] :: Bytes)
                              , bytearray
z bytearray -> bytearray -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> bytearray
forall ba. ByteArray ba => Int -> ba
B.zero 1
                              , bytearray -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length bytearray
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 8
                              ]

-- | decrypt message using the private key.
--
-- When the decryption is not in a context where an attacker could gain
-- information from the timing of the operation, the blinder can be set to None.
--
-- If unsure always set a blinder or use decryptSafer
--
-- The message is returned un-padded.
decrypt :: Maybe Blinder -- ^ optional blinder
        -> PrivateKey    -- ^ RSA private key
        -> ByteString    -- ^ cipher text
        -> Either Error ByteString
decrypt :: Maybe Blinder
-> PrivateKey -> ByteString -> Either Error ByteString
decrypt blinder :: Maybe Blinder
blinder pk :: PrivateKey
pk c :: ByteString
c
    | ByteString -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ByteString
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (PrivateKey -> Int
private_size PrivateKey
pk) = Error -> Either Error ByteString
forall a b. a -> Either a b
Left Error
MessageSizeIncorrect
    | Bool
otherwise                       = ByteString -> Either Error ByteString
forall bytearray.
ByteArray bytearray =>
bytearray -> Either Error bytearray
unpad (ByteString -> Either Error ByteString)
-> ByteString -> Either Error ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Blinder -> PrivateKey -> ByteString -> ByteString
forall ba. ByteArray ba => Maybe Blinder -> PrivateKey -> ba -> ba
dp Maybe Blinder
blinder PrivateKey
pk ByteString
c

-- | decrypt message using the private key and by automatically generating a blinder.
decryptSafer :: MonadRandom m
             => PrivateKey -- ^ RSA private key
             -> ByteString -- ^ cipher text
             -> m (Either Error ByteString)
decryptSafer :: PrivateKey -> ByteString -> m (Either Error ByteString)
decryptSafer pk :: PrivateKey
pk b :: ByteString
b = do
    Blinder
blinder <- Integer -> m Blinder
forall (m :: * -> *). MonadRandom m => Integer -> m Blinder
generateBlinder (PrivateKey -> Integer
private_n PrivateKey
pk)
    Either Error ByteString -> m (Either Error ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Blinder
-> PrivateKey -> ByteString -> Either Error ByteString
decrypt (Blinder -> Maybe Blinder
forall a. a -> Maybe a
Just Blinder
blinder) PrivateKey
pk ByteString
b)

-- | encrypt a bytestring using the public key.
--
-- The message needs to be smaller than the key size - 11.
-- The message should not be padded.
encrypt :: MonadRandom m => PublicKey -> ByteString -> m (Either Error ByteString)
encrypt :: PublicKey -> ByteString -> m (Either Error ByteString)
encrypt pk :: PublicKey
pk m :: ByteString
m = do
    Either Error ByteString
r <- Int -> ByteString -> m (Either Error ByteString)
forall (m :: * -> *) message.
(MonadRandom m, ByteArray message) =>
Int -> message -> m (Either Error message)
pad (PublicKey -> Int
public_size PublicKey
pk) ByteString
m
    case Either Error ByteString
r of
        Left err :: Error
err -> Either Error ByteString -> m (Either Error ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error ByteString -> m (Either Error ByteString))
-> Either Error ByteString -> m (Either Error ByteString)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error ByteString
forall a b. a -> Either a b
Left Error
err
        Right em :: ByteString
em -> Either Error ByteString -> m (Either Error ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error ByteString -> m (Either Error ByteString))
-> Either Error ByteString -> m (Either Error ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Error ByteString
forall a b. b -> Either a b
Right (PublicKey -> ByteString -> ByteString
forall ba. ByteArray ba => PublicKey -> ba -> ba
ep PublicKey
pk ByteString
em)

-- | sign message using private key, a hash and its ASN1 description
--
-- When the signature is not in a context where an attacker could gain
-- information from the timing of the operation, the blinder can be set to None.
--
-- If unsure always set a blinder or use signSafer
sign :: HashAlgorithmASN1 hashAlg
     => Maybe Blinder -- ^ optional blinder
     -> Maybe hashAlg -- ^ hash algorithm
     -> PrivateKey    -- ^ private key
     -> ByteString    -- ^ message to sign
     -> Either Error ByteString
sign :: Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
sign blinder :: Maybe Blinder
blinder hashDescr :: Maybe hashAlg
hashDescr pk :: PrivateKey
pk m :: ByteString
m = Maybe Blinder -> PrivateKey -> ByteString -> ByteString
forall ba. ByteArray ba => Maybe Blinder -> PrivateKey -> ba -> ba
dp Maybe Blinder
blinder PrivateKey
pk (ByteString -> ByteString)
-> Either Error ByteString -> Either Error ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe hashAlg -> Int -> ByteString -> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> Int -> ByteString -> Either Error ByteString
makeSignature Maybe hashAlg
hashDescr (PrivateKey -> Int
private_size PrivateKey
pk) ByteString
m

-- | sign message using the private key and by automatically generating a blinder.
signSafer :: (HashAlgorithmASN1 hashAlg, MonadRandom m)
          => Maybe hashAlg -- ^ Hash algorithm
          -> PrivateKey    -- ^ private key
          -> ByteString    -- ^ message to sign
          -> m (Either Error ByteString)
signSafer :: Maybe hashAlg
-> PrivateKey -> ByteString -> m (Either Error ByteString)
signSafer hashAlg :: Maybe hashAlg
hashAlg pk :: PrivateKey
pk m :: ByteString
m = do
    Blinder
blinder <- Integer -> m Blinder
forall (m :: * -> *). MonadRandom m => Integer -> m Blinder
generateBlinder (PrivateKey -> Integer
private_n PrivateKey
pk)
    Either Error ByteString -> m (Either Error ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
sign (Blinder -> Maybe Blinder
forall a. a -> Maybe a
Just Blinder
blinder) Maybe hashAlg
hashAlg PrivateKey
pk ByteString
m)

-- | verify message with the signed message
verify :: HashAlgorithmASN1 hashAlg
       => Maybe hashAlg
       -> PublicKey
       -> ByteString
       -> ByteString
       -> Bool
verify :: Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
verify hashAlg :: Maybe hashAlg
hashAlg pk :: PublicKey
pk m :: ByteString
m sm :: ByteString
sm =
    case Maybe hashAlg -> Int -> ByteString -> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> Int -> ByteString -> Either Error ByteString
makeSignature Maybe hashAlg
hashAlg (PublicKey -> Int
public_size PublicKey
pk) ByteString
m of
        Left _  -> Bool
False
        Right s :: ByteString
s -> ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== (PublicKey -> ByteString -> ByteString
forall ba. ByteArray ba => PublicKey -> ba -> ba
ep PublicKey
pk ByteString
sm)

-- | make signature digest, used in 'sign' and 'verify'
makeSignature :: HashAlgorithmASN1 hashAlg
              => Maybe hashAlg -- ^ optional hashing algorithm
              -> Int
              -> ByteString
              -> Either Error ByteString
makeSignature :: Maybe hashAlg -> Int -> ByteString -> Either Error ByteString
makeSignature Nothing        klen :: Int
klen m :: ByteString
m = Int -> ByteString -> Either Error ByteString
forall signature.
ByteArray signature =>
Int -> signature -> Either Error signature
padSignature Int
klen ByteString
m
makeSignature (Just hashAlg :: hashAlg
hashAlg) klen :: Int
klen m :: ByteString
m = Int -> ByteString -> Either Error ByteString
forall signature.
ByteArray signature =>
Int -> signature -> Either Error signature
padSignature Int
klen (Digest hashAlg -> ByteString
forall hashAlg out.
(HashAlgorithmASN1 hashAlg, ByteArray out) =>
Digest hashAlg -> out
hashDigestASN1 (Digest hashAlg -> ByteString) -> Digest hashAlg -> ByteString
forall a b. (a -> b) -> a -> b
$ hashAlg -> ByteString -> Digest hashAlg
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hashAlg
hashAlg ByteString
m)