-- |
-- 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 :: forall out. ByteArray out => Digest MD2 -> out
hashDigestASN1 = forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8
0x30,Word8
0x20,Word8
0x30,Word8
0x0c,Word8
0x06,Word8
0x08,Word8
0x2a,Word8
0x86,Word8
0x48,Word8
0x86,Word8
0xf7,Word8
0x0d,Word8
0x02,Word8
0x02,Word8
0x05,Word8
0x00,Word8
0x04,Word8
0x10]
instance HashAlgorithmASN1 MD5 where
    hashDigestASN1 :: forall out. ByteArray out => Digest MD5 -> out
hashDigestASN1 = forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8
0x30,Word8
0x20,Word8
0x30,Word8
0x0c,Word8
0x06,Word8
0x08,Word8
0x2a,Word8
0x86,Word8
0x48,Word8
0x86,Word8
0xf7,Word8
0x0d,Word8
0x02,Word8
0x05,Word8
0x05,Word8
0x00,Word8
0x04,Word8
0x10]
instance HashAlgorithmASN1 SHA1 where
    hashDigestASN1 :: forall out. ByteArray out => Digest SHA1 -> out
hashDigestASN1 = forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8
0x30,Word8
0x21,Word8
0x30,Word8
0x09,Word8
0x06,Word8
0x05,Word8
0x2b,Word8
0x0e,Word8
0x03,Word8
0x02,Word8
0x1a,Word8
0x05,Word8
0x00,Word8
0x04,Word8
0x14]
instance HashAlgorithmASN1 SHA224 where
    hashDigestASN1 :: forall out. ByteArray out => Digest SHA224 -> out
hashDigestASN1 = forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8
0x30,Word8
0x2d,Word8
0x30,Word8
0x0d,Word8
0x06,Word8
0x09,Word8
0x60,Word8
0x86,Word8
0x48,Word8
0x01,Word8
0x65,Word8
0x03,Word8
0x04,Word8
0x02,Word8
0x04,Word8
0x05,Word8
0x00,Word8
0x04,Word8
0x1c]
instance HashAlgorithmASN1 SHA256 where
    hashDigestASN1 :: forall out. ByteArray out => Digest SHA256 -> out
hashDigestASN1 = forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8
0x30,Word8
0x31,Word8
0x30,Word8
0x0d,Word8
0x06,Word8
0x09,Word8
0x60,Word8
0x86,Word8
0x48,Word8
0x01,Word8
0x65,Word8
0x03,Word8
0x04,Word8
0x02,Word8
0x01,Word8
0x05,Word8
0x00,Word8
0x04,Word8
0x20]
instance HashAlgorithmASN1 SHA384 where
    hashDigestASN1 :: forall out. ByteArray out => Digest SHA384 -> out
hashDigestASN1 = forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8
0x30,Word8
0x41,Word8
0x30,Word8
0x0d,Word8
0x06,Word8
0x09,Word8
0x60,Word8
0x86,Word8
0x48,Word8
0x01,Word8
0x65,Word8
0x03,Word8
0x04,Word8
0x02,Word8
0x02,Word8
0x05,Word8
0x00,Word8
0x04,Word8
0x30]
instance HashAlgorithmASN1 SHA512 where
    hashDigestASN1 :: forall out. ByteArray out => Digest SHA512 -> out
hashDigestASN1 = forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8
0x30,Word8
0x51,Word8
0x30,Word8
0x0d,Word8
0x06,Word8
0x09,Word8
0x60,Word8
0x86,Word8
0x48,Word8
0x01,Word8
0x65,Word8
0x03,Word8
0x04,Word8
0x02,Word8
0x03,Word8
0x05,Word8
0x00,Word8
0x04,Word8
0x40]
instance HashAlgorithmASN1 SHA512t_224 where
    hashDigestASN1 :: forall out. ByteArray out => Digest SHA512t_224 -> out
hashDigestASN1 = forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8
0x30,Word8
0x2d,Word8
0x30,Word8
0x0d,Word8
0x06,Word8
0x09,Word8
0x60,Word8
0x86,Word8
0x48,Word8
0x01,Word8
0x65,Word8
0x03,Word8
0x04,Word8
0x02,Word8
0x05,Word8
0x05,Word8
0x00,Word8
0x04,Word8
0x1c]
instance HashAlgorithmASN1 SHA512t_256 where
    hashDigestASN1 :: forall out. ByteArray out => Digest SHA512t_256 -> out
hashDigestASN1 = forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8
0x30,Word8
0x31,Word8
0x30,Word8
0x0d,Word8
0x06,Word8
0x09,Word8
0x60,Word8
0x86,Word8
0x48,Word8
0x01,Word8
0x65,Word8
0x03,Word8
0x04,Word8
0x02,Word8
0x06,Word8
0x05,Word8
0x00,Word8
0x04,Word8
0x20]
instance HashAlgorithmASN1 RIPEMD160 where
    hashDigestASN1 :: forall out. ByteArray out => Digest RIPEMD160 -> out
hashDigestASN1 = forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8
0x30,Word8
0x21,Word8
0x30,Word8
0x09,Word8
0x06,Word8
0x05,Word8
0x2b,Word8
0x24,Word8
0x03,Word8
0x02,Word8
0x01,Word8
0x05,Word8
0x00,Word8
0x04,Word8
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 :: forall out hashAlg.
ByteArray out =>
[Word8] -> Digest hashAlg -> out
addDigestPrefix [Word8]
prefix Digest hashAlg
digest =
    forall a. ByteArray a => [Word8] -> a
B.pack [Word8]
prefix forall bs. ByteArray bs => bs -> bs -> bs
`B.append` 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 :: forall (m :: * -> *) message.
(MonadRandom m, ByteArray message) =>
Int -> message -> m (Either Error message)
pad Int
len message
m
    | forall ba. ByteArrayAccess ba => ba -> Int
B.length message
m forall a. Ord a => a -> a -> Bool
> Int
len forall a. Num a => a -> a -> a
- Int
11 = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left Error
MessageTooLong)
    | Bool
otherwise             = do
        message
padding <- forall bytearray (m :: * -> *).
(ByteArray bytearray, MonadRandom m) =>
Int -> m bytearray
getNonNullRandom (Int
len forall a. Num a => a -> a -> a
- forall ba. ByteArrayAccess ba => ba -> Int
B.length message
m forall a. Num a => a -> a -> a
- Int
3)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
B.concat [ forall a. ByteArray a => [Word8] -> a
B.pack [Word8
0,Word8
2], message
padding, forall a. ByteArray a => [Word8] -> a
B.pack [Word8
0], message
m ]

  where
    -- get random non-null bytes
    getNonNullRandom :: (ByteArray bytearray, MonadRandom m) => Int -> m bytearray
    getNonNullRandom :: forall bytearray (m :: * -> *).
(ByteArray bytearray, MonadRandom m) =>
Int -> m bytearray
getNonNullRandom Int
n = do
        Bytes
bs0 <- forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
n
        let bytes :: bytearray
bytes = forall a. ByteArray a => [Word8] -> a
B.pack forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Word8
0) forall a b. (a -> b) -> a -> b
$ forall a. ByteArrayAccess a => a -> [Word8]
B.unpack (Bytes
bs0 :: Bytes)
            left :: Int
left  = Int
n forall a. Num a => a -> a -> a
- forall ba. ByteArrayAccess ba => ba -> Int
B.length bytearray
bytes
        if Int
left forall a. Eq a => a -> a -> Bool
== Int
0
            then forall (m :: * -> *) a. Monad m => a -> m a
return bytearray
bytes
            else do bytearray
bend <- forall bytearray (m :: * -> *).
(ByteArray bytearray, MonadRandom m) =>
Int -> m bytearray
getNonNullRandom Int
left
                    forall (m :: * -> *) a. Monad m => a -> m a
return (bytearray
bytes 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 :: forall signature.
ByteArray signature =>
Int -> signature -> Either Error signature
padSignature Int
klen signature
signature
    | Int
klen forall a. Ord a => a -> a -> Bool
< Int
siglen forall a. Num a => a -> a -> a
+ Int
11 = forall a b. a -> Either a b
Left Error
SignatureTooLong
    | Bool
otherwise          = forall a b. b -> Either a b
Right (forall a. ByteArray a => [Word8] -> a
B.pack [Word8]
padding forall bs. ByteArray bs => bs -> bs -> bs
`B.append` signature
signature)
  where
        siglen :: Int
siglen    = forall ba. ByteArrayAccess ba => ba -> Int
B.length signature
signature
        padding :: [Word8]
padding   = Word8
0 forall a. a -> [a] -> [a]
: Word8
1 forall a. a -> [a] -> [a]
: (forall a. Int -> a -> [a]
replicate (Int
klen forall a. Num a => a -> a -> a
- Int
siglen forall a. Num a => a -> a -> a
- Int
3) Word8
0xff forall a. [a] -> [a] -> [a]
++ [Word8
0])

-- | Try to remove a standard PKCS1.5 encryption padding.
unpad :: ByteArray bytearray => bytearray -> Either Error bytearray
unpad :: forall bytearray.
ByteArray bytearray =>
bytearray -> Either Error bytearray
unpad bytearray
packed
    | Bool
paddingSuccess = forall a b. b -> Either a b
Right bytearray
m
    | Bool
otherwise      = forall a b. a -> Either a b
Left Error
MessageNotRecognized
  where
        (bytearray
zt, bytearray
ps0m)   = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
2 bytearray
packed
        (bytearray
ps, bytearray
zm)     = forall bs. ByteArray bs => (Word8 -> Bool) -> bs -> (bs, bs)
B.span (forall a. Eq a => a -> a -> Bool
/= Word8
0) bytearray
ps0m
        (bytearray
z, bytearray
m)       = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
1 bytearray
zm
        paddingSuccess :: Bool
paddingSuccess = [Bool] -> Bool
and' [ bytearray
zt forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`B.constEq` (forall a. ByteArray a => [Word8] -> a
B.pack [Word8
0,Word8
2] :: Bytes)
                              , bytearray
z forall a. Eq a => a -> a -> Bool
== forall ba. ByteArray ba => Int -> ba
B.zero Int
1
                              , forall ba. ByteArrayAccess ba => ba -> Int
B.length bytearray
ps forall a. Ord a => a -> a -> Bool
>= Int
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 Maybe Blinder
blinder PrivateKey
pk ByteString
c
    | forall ba. ByteArrayAccess ba => ba -> Int
B.length ByteString
c forall a. Eq a => a -> a -> Bool
/= (PrivateKey -> Int
private_size PrivateKey
pk) = forall a b. a -> Either a b
Left Error
MessageSizeIncorrect
    | Bool
otherwise                       = forall bytearray.
ByteArray bytearray =>
bytearray -> Either Error bytearray
unpad forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *).
MonadRandom m =>
PrivateKey -> ByteString -> m (Either Error ByteString)
decryptSafer PrivateKey
pk ByteString
b = do
    Blinder
blinder <- forall (m :: * -> *). MonadRandom m => Integer -> m Blinder
generateBlinder (PrivateKey -> Integer
private_n PrivateKey
pk)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Blinder
-> PrivateKey -> ByteString -> Either Error ByteString
decrypt (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 :: forall (m :: * -> *).
MonadRandom m =>
PublicKey -> ByteString -> m (Either Error ByteString)
encrypt PublicKey
pk ByteString
m = do
    Either Error ByteString
r <- 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 Error
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Error
err
        Right ByteString
em -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (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 :: forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
sign Maybe Blinder
blinder Maybe hashAlg
hashDescr PrivateKey
pk ByteString
m = forall ba. ByteArray ba => Maybe Blinder -> PrivateKey -> ba -> ba
dp Maybe Blinder
blinder PrivateKey
pk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` 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 :: forall hashAlg (m :: * -> *).
(HashAlgorithmASN1 hashAlg, MonadRandom m) =>
Maybe hashAlg
-> PrivateKey -> ByteString -> m (Either Error ByteString)
signSafer Maybe hashAlg
hashAlg PrivateKey
pk ByteString
m = do
    Blinder
blinder <- forall (m :: * -> *). MonadRandom m => Integer -> m Blinder
generateBlinder (PrivateKey -> Integer
private_n PrivateKey
pk)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
sign (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 :: forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
verify Maybe hashAlg
hashAlg PublicKey
pk ByteString
m ByteString
sm =
    case 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 Error
_  -> Bool
False
        Right ByteString
s -> ByteString
s forall a. Eq a => a -> a -> Bool
== (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 :: forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> Int -> ByteString -> Either Error ByteString
makeSignature Maybe hashAlg
Nothing        Int
klen ByteString
m = forall signature.
ByteArray signature =>
Int -> signature -> Either Error signature
padSignature Int
klen ByteString
m
makeSignature (Just hashAlg
hashAlg) Int
klen ByteString
m = forall signature.
ByteArray signature =>
Int -> signature -> Either Error signature
padSignature Int
klen (forall hashAlg out.
(HashAlgorithmASN1 hashAlg, ByteArray out) =>
Digest hashAlg -> out
hashDigestASN1 forall a b. (a -> b) -> a -> b
$ forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith hashAlg
hashAlg ByteString
m)