{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE MultiWayIf         #-}
module Codec.Crypto.RSA.Pure(
         RSAError(..)
       , HashInfo(..)
       -- * Keys and key generation
       , PrivateKey(..)
       , PublicKey(..)
       , generateKeyPair
       -- * High-level encryption and signature functions
       , encrypt
       , encryptOAEP
       , encryptPKCS
       , decrypt
       , decryptOAEP
       , decryptPKCS
       , sign
       , verify
       -- * Core routines for OAEP
       , MGF
       , generateMGF1
       , rsaes_oaep_encrypt
       , rsaes_oaep_decrypt
       -- * Core PSS routines
       -- $pss
       -- * Core PKCS1 (v1.5) Routines
       , rsaes_pkcs1_v1_5_encrypt
       , rsaes_pkcs1_v1_5_decrypt
       , rsassa_pkcs1_v1_5_sign
       , rsassa_pkcs1_v1_5_verify
       -- * Hashing algorithm declarations for use in RSA functions
       , hashSHA1
       , hashSHA224, hashSHA256, hashSHA384, hashSHA512
       -- * Other mathematical functions that are handy for implementing
       -- other RSA primitives.
       , largeRandomPrime
       , generatePQ
       , chunkify
       , os2ip, i2osp
       , rsa_dp, rsa_ep
       , rsa_vp1, rsa_sp1
       , modular_inverse
       , modular_exponentiation
       , randomBS, randomNZBS
       )
 where


import Control.Exception
import Control.Monad
import Crypto.Random
import Crypto.Types.PubKey.RSA
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.Bits
import Data.ByteString.Lazy(ByteString)
import qualified Data.ByteString.Lazy as BS
import Data.Digest.Pure.SHA
import Data.Int
import Data.Typeable

data RSAError = RSAError String
              | RSAKeySizeTooSmall
              | RSAIntegerTooLargeToPack
              | RSAMessageRepOutOfRange
              | RSACipherRepOutOfRange
              | RSAMessageTooShort
              | RSAMessageTooLong
              | RSAMaskTooLong
              | RSAIncorrectSigSize
              | RSAIncorrectMsgSize
              | RSADecryptionError
              | RSAGenError GenError
 deriving (RSAError -> RSAError -> Bool
(RSAError -> RSAError -> Bool)
-> (RSAError -> RSAError -> Bool) -> Eq RSAError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RSAError -> RSAError -> Bool
== :: RSAError -> RSAError -> Bool
$c/= :: RSAError -> RSAError -> Bool
/= :: RSAError -> RSAError -> Bool
Eq, Int -> RSAError -> ShowS
[RSAError] -> ShowS
RSAError -> String
(Int -> RSAError -> ShowS)
-> (RSAError -> String) -> ([RSAError] -> ShowS) -> Show RSAError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RSAError -> ShowS
showsPrec :: Int -> RSAError -> ShowS
$cshow :: RSAError -> String
show :: RSAError -> String
$cshowList :: [RSAError] -> ShowS
showList :: [RSAError] -> ShowS
Show, Typeable)

instance Exception RSAError

data HashInfo = HashInfo {
    HashInfo -> ByteString
algorithmIdent :: ByteString -- ^The ASN.1 DER encoding of the hash function
                                 -- identifier.
  , HashInfo -> ByteString -> ByteString
hashFunction   :: ByteString -> ByteString -- ^The hash function
  }

instance Show SystemRandom where
  show :: SystemRandom -> String
show SystemRandom
_ = String
"SystemRandom"

class RSAKey a where
  genKeySize :: a -> Int

instance RSAKey PublicKey where
  genKeySize :: PublicKey -> Int
genKeySize = PublicKey -> Int
public_size

instance RSAKey PrivateKey where
  genKeySize :: PrivateKey -> Int
genKeySize = PrivateKey -> Int
private_size

instance Binary PublicKey where
  put :: PublicKey -> Put
put PublicKey
pk = do ByteString
sizeBS <- Either RSAError ByteString -> PutM ByteString
forall (m :: * -> *) a b. (Monad m, Show a) => Either a b -> m b
failOnError (Int -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp (PublicKey -> Int
public_size PublicKey
pk) Int
8)
              ByteString
nBS <- Either RSAError ByteString -> PutM ByteString
forall (m :: * -> *) a b. (Monad m, Show a) => Either a b -> m b
failOnError (Integer -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp (PublicKey -> Integer
public_n PublicKey
pk) (PublicKey -> Int
public_size PublicKey
pk))
              ByteString -> Put
putLazyByteString ByteString
sizeBS
              ByteString -> Put
putLazyByteString ByteString
nBS
  get :: Get PublicKey
get    = do Int64
len <- (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64)
-> (ByteString -> Integer) -> ByteString -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
os2ip) (ByteString -> Int64) -> Get ByteString -> Get Int64
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int64 -> Get ByteString
getLazyByteString Int64
8
              Integer
n   <- ByteString -> Integer
os2ip (ByteString -> Integer) -> Get ByteString -> Get Integer
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int64 -> Get ByteString
getLazyByteString Int64
len
              PublicKey -> Get PublicKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Integer -> Integer -> PublicKey
PublicKey (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len) Integer
n Integer
65537)

instance Binary PrivateKey where
  put :: PrivateKey -> Put
put PrivateKey
pk = do PublicKey -> Put
forall t. Binary t => t -> Put
put (PrivateKey -> PublicKey
private_pub PrivateKey
pk)
              ByteString
dBS <- Either RSAError ByteString -> PutM ByteString
forall (m :: * -> *) a b. (Monad m, Show a) => Either a b -> m b
failOnError (Integer -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp (PrivateKey -> Integer
private_d PrivateKey
pk) (PublicKey -> Int
public_size (PrivateKey -> PublicKey
private_pub PrivateKey
pk)))
              ByteString -> Put
putLazyByteString ByteString
dBS
  get :: Get PrivateKey
get    = do PublicKey
pub <- Get PublicKey
forall t. Binary t => Get t
get
              Integer
d   <- ByteString -> Integer
os2ip (ByteString -> Integer) -> Get ByteString -> Get Integer
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int64 -> Get ByteString
getLazyByteString (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PublicKey -> Int
public_size PublicKey
pub))
              PrivateKey -> Get PrivateKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (PublicKey
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> PrivateKey
PrivateKey PublicKey
pub Integer
d Integer
0 Integer
0 Integer
0 Integer
0 Integer
0)

failOnError :: (Monad m, Show a) => Either a b -> m b
failOnError :: forall (m :: * -> *) a b. (Monad m, Show a) => Either a b -> m b
failOnError (Left a
e)  = String -> m b
forall a. HasCallStack => String -> a
error (a -> String
forall a. Show a => a -> String
show a
e)
failOnError (Right b
b) = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

-- ----------------------------------------------------------------------------

-- |Randomly generate a key pair of the given modules length (in bits) to use
-- in any of the following functions. Use of a good random number generator is
-- of considerable importance when using this function. The input
-- CryptoRandomGen should never be used again for any other purpose; either
-- use the output'd generator or throw it all away.
generateKeyPair :: CryptoRandomGen g =>
                   g -> Int ->
                   Either RSAError (PublicKey, PrivateKey, g)
generateKeyPair :: forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (PublicKey, PrivateKey, g)
generateKeyPair g
g Int
sizeBits = do
  let keyLength :: Int
keyLength = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
sizeBits Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
  (Integer
p, Integer
q, g
g') <- g -> Int -> Either RSAError (Integer, Integer, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (Integer, Integer, g)
generatePQ g
g Int
keyLength
  let n :: Integer
n          = Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
q
      phi :: Integer
phi        = (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
      e :: Integer
e          = Integer
65537
      d :: Integer
d          = Integer -> Integer -> Integer
modular_inverse Integer
e Integer
phi
  let publicKey :: PublicKey
publicKey  = Int -> Integer -> Integer -> PublicKey
PublicKey Int
keyLength Integer
n Integer
e
      privateKey :: PrivateKey
privateKey = PublicKey
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> PrivateKey
PrivateKey PublicKey
publicKey Integer
d Integer
p Integer
q Integer
0 Integer
0 Integer
0
  (PublicKey, PrivateKey, g)
-> Either RSAError (PublicKey, PrivateKey, g)
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return (PublicKey
publicKey, PrivateKey
privateKey, g
g')

-- ----------------------------------------------------------------------------

-- |Compute a signature for the given ByteString, using the SHA256 algorithm
-- in the computation. This is currently defined as rsassa_pkcs1_v1_5_sign
-- hashSHA256. If you want to use a different function, simply use the PKCS
-- function, below; it will accept arbitrarily-length messages.
sign :: PrivateKey -> ByteString -> Either RSAError ByteString
sign :: PrivateKey -> ByteString -> Either RSAError ByteString
sign = HashInfo -> PrivateKey -> ByteString -> Either RSAError ByteString
rsassa_pkcs1_v1_5_sign HashInfo
hashSHA256

-- |Verify a signature for the given ByteString, using the SHA25 algorithm in
-- the computation. Again, if you'd like to use a different algorithm, use the
-- rsassa_pkcs1_v1_5_verify function.
verify :: PublicKey {- ^The key of the signer -} ->
          ByteString {- ^The message -} ->
          ByteString {- ^The purported signature -} ->
          Either RSAError Bool
verify :: PublicKey -> ByteString -> ByteString -> Either RSAError Bool
verify = HashInfo
-> PublicKey -> ByteString -> ByteString -> Either RSAError Bool
rsassa_pkcs1_v1_5_verify HashInfo
hashSHA256

-- ----------------------------------------------------------------------------

-- |Encrypt an arbitrarily-sized message given the public key and reasonable
-- options. This is equivalent to calling encryptOAEP with SHA-256 as the
-- hash function, MGF1(SHA-256) as the mask generation function, and no label.
-- NOTE: This hash choice means that your key size must be 1024 bits or larger.
encrypt :: CryptoRandomGen g =>
           g -> PublicKey -> ByteString ->
           Either RSAError (ByteString, g)
encrypt :: forall g.
CryptoRandomGen g =>
g -> PublicKey -> ByteString -> Either RSAError (ByteString, g)
encrypt g
g PublicKey
k ByteString
m = g
-> (ByteString -> ByteString)
-> MGF
-> ByteString
-> PublicKey
-> ByteString
-> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g
-> (ByteString -> ByteString)
-> MGF
-> ByteString
-> PublicKey
-> ByteString
-> Either RSAError (ByteString, g)
encryptOAEP g
g ByteString -> ByteString
sha256' ((ByteString -> ByteString) -> MGF
generateMGF1 ByteString -> ByteString
sha256') ByteString
BS.empty PublicKey
k ByteString
m
 where sha256' :: ByteString -> ByteString
sha256' = Digest SHA256State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest (Digest SHA256State -> ByteString)
-> (ByteString -> Digest SHA256State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha256

-- |Encrypt an arbitrarily-sized message using OAEP encoding. This is the
-- encouraged encoding for doing RSA encryption. Note that your key size
-- must be greater than (2 * hash length + 2) * 8. (For example, the
-- 'encrypt' convenience function uses a 256 bit / 32 byte hash function.
-- Thus, its key must be greater than (2 * 32 + 2) * 8 = 528 bits long,
-- and we suggest 1024 as a lower bound.)
encryptOAEP :: CryptoRandomGen g =>
               g ->
               (ByteString -> ByteString) {- ^The hash function to use -} ->
               MGF {- ^The mask generation function to use -} ->
               ByteString {- ^An optional label to include -} ->
               PublicKey {- ^The public key to encrypt with -} ->
               ByteString {- ^The message to encrypt -} ->
               Either RSAError (ByteString, g)
encryptOAEP :: forall g.
CryptoRandomGen g =>
g
-> (ByteString -> ByteString)
-> MGF
-> ByteString
-> PublicKey
-> ByteString
-> Either RSAError (ByteString, g)
encryptOAEP g
g ByteString -> ByteString
hash MGF
mgf ByteString
l PublicKey
k ByteString
m =
  do Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Int
keySize Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hashLength) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$ RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSAKeySizeTooSmall
     let chunks :: [ByteString]
chunks = PublicKey
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall k.
RSAKey k =>
k -> (ByteString -> ByteString) -> ByteString -> [ByteString]
chunkBSForOAEP PublicKey
k ByteString -> ByteString
hash ByteString
m
     ([ByteString]
chunks', g
g') <- g
-> [ByteString]
-> (g -> ByteString -> Either RSAError (ByteString, g))
-> Either RSAError ([ByteString], g)
forall g.
CryptoRandomGen g =>
g
-> [ByteString]
-> (g -> ByteString -> Either RSAError (ByteString, g))
-> Either RSAError ([ByteString], g)
mapM' g
g [ByteString]
chunks (\ g
x -> g
-> (ByteString -> ByteString)
-> MGF
-> PublicKey
-> ByteString
-> ByteString
-> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g
-> (ByteString -> ByteString)
-> MGF
-> PublicKey
-> ByteString
-> ByteString
-> Either RSAError (ByteString, g)
rsaes_oaep_encrypt g
x ByteString -> ByteString
hash MGF
mgf PublicKey
k ByteString
l)
     (ByteString, g) -> Either RSAError (ByteString, g)
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BS.concat [ByteString]
chunks', g
g')
 where
  keySize :: Int
keySize = PublicKey -> Int
public_size PublicKey
k
  hashLength :: Int
hashLength = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BS.length (ByteString -> ByteString
hash ByteString
BS.empty))

-- |Encrypt an arbitrarily-sized message using PKCS1 v1.5 encoding. This
-- encoding is deprecated, and should only be used when interacting with
-- legacy software that cannot be modified.
encryptPKCS :: CryptoRandomGen g =>
               g -> PublicKey -> ByteString ->
               Either RSAError (ByteString, g)
encryptPKCS :: forall g.
CryptoRandomGen g =>
g -> PublicKey -> ByteString -> Either RSAError (ByteString, g)
encryptPKCS g
g PublicKey
k ByteString
m =
  do let chunks :: [ByteString]
chunks = PublicKey -> ByteString -> [ByteString]
forall k. RSAKey k => k -> ByteString -> [ByteString]
chunkBSForPKCS PublicKey
k ByteString
m
     ([ByteString]
chunks', g
g') <- g
-> [ByteString]
-> (g -> ByteString -> Either RSAError (ByteString, g))
-> Either RSAError ([ByteString], g)
forall g.
CryptoRandomGen g =>
g
-> [ByteString]
-> (g -> ByteString -> Either RSAError (ByteString, g))
-> Either RSAError ([ByteString], g)
mapM' g
g [ByteString]
chunks (\ g
x -> g -> PublicKey -> ByteString -> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> PublicKey -> ByteString -> Either RSAError (ByteString, g)
rsaes_pkcs1_v1_5_encrypt g
x PublicKey
k)
     (ByteString, g) -> Either RSAError (ByteString, g)
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BS.concat [ByteString]
chunks', g
g')

-- this is just handy
mapM' :: CryptoRandomGen g =>
         g -> [ByteString] ->
         (g -> ByteString -> Either RSAError (ByteString, g)) ->
         Either RSAError ([ByteString], g)
mapM' :: forall g.
CryptoRandomGen g =>
g
-> [ByteString]
-> (g -> ByteString -> Either RSAError (ByteString, g))
-> Either RSAError ([ByteString], g)
mapM' g
g []       g -> ByteString -> Either RSAError (ByteString, g)
_ = ([ByteString], g) -> Either RSAError ([ByteString], g)
forall a b. b -> Either a b
Right ([], g
g)
mapM' g
g (ByteString
x:[ByteString]
rest) g -> ByteString -> Either RSAError (ByteString, g)
f =
  do (ByteString
x', g
g')     <- g -> ByteString -> Either RSAError (ByteString, g)
f g
g ByteString
x
     ([ByteString]
rest', g
g'') <- g
-> [ByteString]
-> (g -> ByteString -> Either RSAError (ByteString, g))
-> Either RSAError ([ByteString], g)
forall g.
CryptoRandomGen g =>
g
-> [ByteString]
-> (g -> ByteString -> Either RSAError (ByteString, g))
-> Either RSAError ([ByteString], g)
mapM' g
g' [ByteString]
rest g -> ByteString -> Either RSAError (ByteString, g)
f
     ([ByteString], g) -> Either RSAError ([ByteString], g)
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
x'ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
rest', g
g'')

-- ----------------------------------------------------------------------------

-- |Decrypt an arbitrarily-sized message given the public key and reasonable
-- options. This is equivalent to calling encryptOAEP with SHA-256 as the
-- hash function, MGF1(SHA-256) as the mask generation function, and no label.
decrypt :: PrivateKey -> ByteString -> Either RSAError ByteString
decrypt :: PrivateKey -> ByteString -> Either RSAError ByteString
decrypt PrivateKey
k ByteString
m = (ByteString -> ByteString)
-> MGF
-> ByteString
-> PrivateKey
-> ByteString
-> Either RSAError ByteString
decryptOAEP ByteString -> ByteString
sha256' ((ByteString -> ByteString) -> MGF
generateMGF1 ByteString -> ByteString
sha256') ByteString
BS.empty PrivateKey
k ByteString
m
 where sha256' :: ByteString -> ByteString
sha256' = Digest SHA256State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest (Digest SHA256State -> ByteString)
-> (ByteString -> Digest SHA256State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha256

-- |Decrypt an arbitrarily-sized message using OAEP encoding. This is the
-- encouraged encoding for doing RSA encryption.
decryptOAEP :: (ByteString -> ByteString) {- ^The hash function to use -} ->
               MGF {- ^The mask generation function to use -} ->
               ByteString {- ^An optional label to include -} ->
               PrivateKey {- ^The public key to encrypt with -} ->
               ByteString {- ^The message to decrypt -} ->
               Either RSAError ByteString
decryptOAEP :: (ByteString -> ByteString)
-> MGF
-> ByteString
-> PrivateKey
-> ByteString
-> Either RSAError ByteString
decryptOAEP ByteString -> ByteString
hash MGF
mgf ByteString
l PrivateKey
k ByteString
m =
  do let chunks :: [ByteString]
chunks = ByteString -> Int64 -> [ByteString]
chunkify ByteString
m (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PrivateKey -> Int
private_size PrivateKey
k))
     [ByteString]
chunks' <- [ByteString]
-> (ByteString -> Either RSAError ByteString)
-> Either RSAError [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ByteString]
chunks ((ByteString -> ByteString)
-> MGF
-> PrivateKey
-> ByteString
-> ByteString
-> Either RSAError ByteString
rsaes_oaep_decrypt ByteString -> ByteString
hash MGF
mgf PrivateKey
k ByteString
l)
     ByteString -> Either RSAError ByteString
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BS.concat [ByteString]
chunks')

-- |Decrypt an arbitrarily-sized message using PKCS1 v1.5 encoding. This
-- encoding is deprecated, and should only be used when interacting with
-- legacy software that cannot be modified.
decryptPKCS :: PrivateKey -> ByteString -> Either RSAError ByteString
decryptPKCS :: PrivateKey -> ByteString -> Either RSAError ByteString
decryptPKCS PrivateKey
k ByteString
m =
  do let chunks :: [ByteString]
chunks = ByteString -> Int64 -> [ByteString]
chunkify ByteString
m (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PrivateKey -> Int
private_size PrivateKey
k))
     [ByteString]
chunks' <- [ByteString]
-> (ByteString -> Either RSAError ByteString)
-> Either RSAError [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ByteString]
chunks (PrivateKey -> ByteString -> Either RSAError ByteString
rsaes_pkcs1_v1_5_decrypt PrivateKey
k)
     ByteString -> Either RSAError ByteString
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BS.concat [ByteString]
chunks')

-- ----------------------------------------------------------------------------

-- |Chunk an aribitrarily-sized message into a series of chunks that can be
-- encrypted by an OAEP encryption / decryption function.
chunkBSForOAEP :: RSAKey k =>
                  k {- ^The key being used -} ->
                  (ByteString -> ByteString) {- ^The hash function in use -} ->
                  ByteString {- ^The ByteString to chunk -} ->
                  [ByteString]
chunkBSForOAEP :: forall k.
RSAKey k =>
k -> (ByteString -> ByteString) -> ByteString -> [ByteString]
chunkBSForOAEP k
k ByteString -> ByteString
hash ByteString
bs = ByteString -> Int64 -> [ByteString]
chunkify ByteString
bs Int64
chunkSize
 where
  chunkSize :: Int64
chunkSize = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (k -> Int
forall a. RSAKey a => a -> Int
genKeySize k
k) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- (Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
hashLen) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
2
  hashLen :: Int64
hashLen   = ByteString -> Int64
BS.length (ByteString -> ByteString
hash ByteString
BS.empty)

-- |Chunk an arbitrarily-sized message into a series of chunks that can be
-- encrypted by a PKCS1 1.5 encryption / decryption function.
chunkBSForPKCS :: RSAKey k => k -> ByteString -> [ByteString]
chunkBSForPKCS :: forall k. RSAKey k => k -> ByteString -> [ByteString]
chunkBSForPKCS k
k ByteString
bstr = ByteString -> Int64 -> [ByteString]
chunkify ByteString
bstr (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (k -> Int
forall a. RSAKey a => a -> Int
genKeySize k
k) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
11)

chunkify :: ByteString -> Int64 -> [ByteString]
chunkify :: ByteString -> Int64 -> [ByteString]
chunkify ByteString
bs Int64
size
  | ByteString -> Int64
BS.length ByteString
bs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = []
  | Bool
otherwise         = let (ByteString
start, ByteString
end) = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt Int64
size ByteString
bs
                        in ByteString
start ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> Int64 -> [ByteString]
chunkify ByteString
end Int64
size

-- ----------------------------------------------------------------------------

-- |The generalized implementation of RSAES-OAEP-ENCRYPT. Using the default
-- instantiontion of this, provided by the 'encrypt' function, is a pretty
-- good plan if this makes no sense to you, as it is instantiated with
-- reasonable defaults.
--
-- The message to be encrypted may not be longer then (k - 2*hLen - 2),
-- where k is the length of the RSA modulus in bytes and hLen is the length
-- of a hash in bytes. Passing in a larger message will generate an error,
-- represented by the Left constructor. Note that this means that OAEP
-- encryption cannot be used with keys smaller than 512 bits.
--
-- I have not put in a check for the length of the label, because I don't
-- expect you to use more than 2^32 bytes. So don't make me regret that, eh?
--
rsaes_oaep_encrypt :: CryptoRandomGen g =>
                      g ->
                      (ByteString->ByteString) {-^The hash function to use-} ->
                      MGF {- ^An appropriate mask genereation function -} ->
                      PublicKey {- ^The recipient's public key -} ->
                      ByteString {- ^A label to associate with the message
                                    (feel free to use BS.empty) -} ->
                      ByteString {- ^The message to encrypt -} ->
                      Either RSAError (ByteString, g)
rsaes_oaep_encrypt :: forall g.
CryptoRandomGen g =>
g
-> (ByteString -> ByteString)
-> MGF
-> PublicKey
-> ByteString
-> ByteString
-> Either RSAError (ByteString, g)
rsaes_oaep_encrypt g
g ByteString -> ByteString
hash MGF
mgf PublicKey
k ByteString
l ByteString
m =
  do let hashLength :: Int
hashLength = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BS.length (ByteString -> ByteString
hash ByteString
BS.empty))
         keySize :: Int
keySize    = PublicKey -> Int
public_size PublicKey
k
         msgLength :: Int
msgLength  = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BS.length ByteString
m)
     -- WARNING: Step 1a is missing
     Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
msgLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
keySize Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hashLength) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)) (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$            -- Step 1b
       RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSAMessageTooLong
     let lHash :: ByteString
lHash = ByteString -> ByteString
hash ByteString
l                                               -- Step 2a
     let zeros :: ByteString
zeros = Word8 -> ByteString
BS.repeat Word8
0                                          -- Step 2b
         numZeros :: Int
numZeros = Int
keySize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
msgLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hashLength) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
         ps :: ByteString
ps = Int64 -> ByteString -> ByteString
BS.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numZeros) ByteString
zeros
     let db :: ByteString
db = [ByteString] -> ByteString
BS.concat [ByteString
lHash, ByteString
ps, Word8 -> ByteString
BS.singleton Word8
1, ByteString
m]                -- Step 2c
     (ByteString
seed, g
g') <- g -> Int -> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (ByteString, g)
randomBS g
g Int
hashLength                              -- Step 2d
     ByteString
dbMask <- MGF
mgf ByteString
seed (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
keySize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hashLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))     -- Step 2e
     let maskedDB :: ByteString
maskedDB = ByteString
db ByteString -> ByteString -> ByteString
`xorBS` ByteString
dbMask                                 -- Step 2f
     ByteString
seedMask <- MGF
mgf ByteString
maskedDB (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hashLength)               -- Step 2g
     let maskedSeed :: ByteString
maskedSeed = ByteString
seed ByteString -> ByteString -> ByteString
`xorBS` ByteString
seedMask                           -- Step 2h
     let em :: ByteString
em = [ByteString] -> ByteString
BS.concat [Word8 -> ByteString
BS.singleton Word8
0, ByteString
maskedSeed, ByteString
maskedDB]        -- Step 2i
     let m_i :: Integer
m_i = ByteString -> Integer
os2ip ByteString
em                                               -- Step 3a
     Integer
c_i <- Integer -> Integer -> Integer -> Either RSAError Integer
rsa_ep (PublicKey -> Integer
public_n PublicKey
k) (PublicKey -> Integer
public_e PublicKey
k) Integer
m_i                      -- Step 3b
     ByteString
c <- Integer -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp Integer
c_i (PublicKey -> Int
public_size PublicKey
k)                                   -- Step 3c
     (ByteString, g) -> Either RSAError (ByteString, g)
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
c, g
g')

-- |The generalized implementation of RSAES-OAEP-DECRYPT. Again, 'decrypt'
-- initializes this with a pretty good set of defaults if you don't understand
-- what all of the arguments involve.
--
-- The ciphertext message passed to this function must be k bytes long, where
-- k is the size of the modulus in bytes. If it is not, this function will
-- generate an error, represented by the Left constructor.
--
-- Futher, k (the length of the ciphertext in bytes) must be greater than or
-- equal to (2 * hLen + 2), where hLen is the length of the output of the
-- hash function in bytes. If this equation does not hold, a (different)
-- error will be generated.
--
-- Finally, there are any number of internal situations that may generate
-- an error indicating that decryption failed.
--
rsaes_oaep_decrypt :: (ByteString->ByteString) {-^The hash function to use-} ->
                      MGF {- ^A mask generation function -} ->
                      PrivateKey {- ^The private key to use -} ->
                      ByteString {- ^An optional label whose
                                     association with the message
                                     should be verified. -} ->
                      ByteString {- ^The ciphertext to decrypt -} ->
                      Either RSAError ByteString
rsaes_oaep_decrypt :: (ByteString -> ByteString)
-> MGF
-> PrivateKey
-> ByteString
-> ByteString
-> Either RSAError ByteString
rsaes_oaep_decrypt ByteString -> ByteString
hash MGF
mgf PrivateKey
k ByteString
l ByteString
c =
  do let hashLength :: Int64
hashLength = ByteString -> Int64
BS.length (ByteString -> ByteString
hash ByteString
BS.empty)
         keySize :: Int
keySize    = PrivateKey -> Int
private_size PrivateKey
k
     -- WARNING: Step 1a is missing!
     Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int64
BS.length ByteString
c Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keySize) (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$                -- Step 1b
       RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSADecryptionError
     Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keySize Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= ((Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
hashLength) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
2)) (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$     -- Step 1c
       RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSADecryptionError
     let c_ip :: Integer
c_ip = ByteString -> Integer
os2ip ByteString
c                                            -- Step 2a
     Integer
m_ip <- Integer -> Integer -> Integer -> Either RSAError Integer
rsa_dp (PrivateKey -> Integer
private_n PrivateKey
k) (PrivateKey -> Integer
private_d PrivateKey
k) Integer
c_ip               -- Step 2b
     ByteString
em <- Integer -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp Integer
m_ip Int
keySize                                      -- Step 2c
     let lHash :: ByteString
lHash = ByteString -> ByteString
hash ByteString
l                                            -- Step 3a
     let (ByteString
y, ByteString
seed_db) = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt Int64
1 ByteString
em                            -- Step 3b
         (ByteString
maskedSeed, ByteString
maskedDB) = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
hashLength) ByteString
seed_db
     ByteString
seedMask <- MGF
mgf ByteString
maskedDB Int64
hashLength                           -- Step 3c
     let seed :: ByteString
seed     = ByteString
maskedSeed ByteString -> ByteString -> ByteString
`xorBS` ByteString
seedMask                    -- Step 3d
     ByteString
dbMask <- MGF
mgf ByteString
seed (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keySize Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
hashLength Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)    -- Step 3e
     let db :: ByteString
db       = ByteString
maskedDB ByteString -> ByteString -> ByteString
`xorBS` ByteString
dbMask                        -- Step 3f
     let (ByteString
lHash', ByteString
ps_o_m) = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt Int64
hashLength ByteString
db               -- Step 3g
         (ByteString
ps, ByteString
o_m)        = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
ps_o_m
         (ByteString
o, ByteString
m)           = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt Int64
1 ByteString
o_m
     Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> [Word8]
BS.unpack ByteString
o [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
== [Word8
1]) (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$ RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSADecryptionError
     Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
lHash' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
lHash)    (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$ RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSADecryptionError
     Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> [Word8]
BS.unpack ByteString
y [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
== [Word8
0]) (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$ RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSADecryptionError
     Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Word8 -> Bool) -> ByteString -> Bool
BS.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
ps)   (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$ RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSADecryptionError
     ByteString -> Either RSAError ByteString
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
m

-- ----------------------------------------------------------------------------

-- |Implements RSAES-PKCS1-v1.5-Encrypt, for completeness and backward
-- compatibility. Also because I've already written everything else, so why not?
--
-- This encryption / padding mechanism has several known attacks, which are
-- described in the literature. So unless you absolutely need to use this
-- for some historical reason, you should avoid it.
--
-- The message to be encrypted must be less then or equal to (k - 11) bytes
-- long, where k is the length of the key modulus in bytes.
--
-- Because this function uses an unknown amount of randomly-generated data,
-- it takes an instance of RandomGen rather than taking a random number as
-- input, and returns the resultant generator as output. You should take care
-- that you (a) do not reuse the input generator, thus losing important
-- randomness, and (b) choose a decent instance of RandomGen for passing to
-- this function.
rsaes_pkcs1_v1_5_encrypt :: CryptoRandomGen g =>
                            g ->
                            PublicKey ->
                            ByteString ->
                            Either RSAError (ByteString, g)
rsaes_pkcs1_v1_5_encrypt :: forall g.
CryptoRandomGen g =>
g -> PublicKey -> ByteString -> Either RSAError (ByteString, g)
rsaes_pkcs1_v1_5_encrypt g
g PublicKey
k ByteString
m =
  do Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BS.length ByteString
m) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (PublicKey -> Int
public_size PublicKey
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
11)) (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$ -- Step 1
       RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSAIncorrectMsgSize
     (ByteString
ps, g
g') <- g -> Int -> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (ByteString, g)
randomNZBS g
g (PublicKey -> Int
public_size PublicKey
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BS.length ByteString
m) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)
     let em :: ByteString
em = [ByteString] -> ByteString
BS.concat [Word8 -> ByteString
BS.singleton Word8
0, Word8 -> ByteString
BS.singleton Word8
2, ByteString
ps, Word8 -> ByteString
BS.singleton Word8
0, ByteString
m]
     let m' :: Integer
m' = ByteString -> Integer
os2ip ByteString
em
     Integer
c_i <- Integer -> Integer -> Integer -> Either RSAError Integer
rsa_ep (PublicKey -> Integer
public_n PublicKey
k) (PublicKey -> Integer
public_e PublicKey
k) Integer
m'
     ByteString
res <- Integer -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp Integer
c_i (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PublicKey -> Int
public_size PublicKey
k))
     (ByteString, g) -> Either RSAError (ByteString, g)
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
res, g
g')

-- |Implements RSAES-PKCS1-v1.5-Decrypt, for completeness and possible backward
-- compatibility. Please see the notes for rsaes_pkcs_v1_5_encrypt regarding
-- use of this function in new applications without backwards compatibility
-- requirements.
--
-- The ciphertext message passed to this function must be of length k, where
-- k is the length of the key modulus in bytes.
rsaes_pkcs1_v1_5_decrypt :: PrivateKey -> ByteString ->
                            Either RSAError ByteString
rsaes_pkcs1_v1_5_decrypt :: PrivateKey -> ByteString -> Either RSAError ByteString
rsaes_pkcs1_v1_5_decrypt PrivateKey
k ByteString
c =
  do Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BS.length ByteString
c) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== PrivateKey -> Int
private_size PrivateKey
k) (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$    -- Step 1
       RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSAIncorrectMsgSize
     let c_i :: Integer
c_i = ByteString -> Integer
os2ip ByteString
c                                          -- Step 2a
     Integer
m_i  <- Integer -> Integer -> Integer -> Either RSAError Integer
rsa_dp (PrivateKey -> Integer
private_n PrivateKey
k) (PrivateKey -> Integer
private_d PrivateKey
k) Integer
c_i             -- Step 2b
     ByteString
em   <- Integer -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp Integer
m_i (PrivateKey -> Int
private_size PrivateKey
k)                         -- Step 2c
     let (ByteString
zt, ByteString
ps_z_m) = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt Int64
2 ByteString
em                         -- Step 3...
         (ByteString
ps, ByteString
z_m)    = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) ByteString
ps_z_m
         (ByteString
z, ByteString
m)       = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt Int64
1 ByteString
z_m
     Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> [Word8]
BS.unpack ByteString
zt [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8
0,Word8
2]) (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$ RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSADecryptionError
     Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> [Word8]
BS.unpack ByteString
z  [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8
0])   (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$ RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSADecryptionError
     Bool -> Either RSAError () -> Either RSAError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int64
BS.length ByteString
ps Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<  Int64
8 )    (Either RSAError () -> Either RSAError ())
-> Either RSAError () -> Either RSAError ()
forall a b. (a -> b) -> a -> b
$ RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSADecryptionError
     ByteString -> Either RSAError ByteString
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
m

-- ----------------------------------------------------------------------------

-- $pss
-- |RSASSA-PSS-Sign, RSASSA-PSS-Verify, and the related functions are not
-- included because they are covered by U.S. Patent 7036014, and it's not clear
-- what the restrictions on implementation are. Sorry.

-- ----------------------------------------------------------------------------

-- |Generate a signature for the given message using the given private key,
-- using the RSASSA-PKCS1-v1.5-Sign algorithm. Note that in researching the
-- requirements for this project, several independent sources suggested not
-- using the same key across sign/validate and encrypt/decrypt contexts. You've
-- been warned.
--
-- The output of this function is the signature only, not the message and
-- the signature.
--
-- SIZE CONSTRAINT: The size of the public key (in bytes) must be greater
-- than or equal to the length of the hash identifier plus the length of
-- a hash plus 1. Thus, for example, you cannot use a 256 bit RSA key with
-- MD5: 32 (the size of a 256-bit RSA key in bytes) is less than 18 (the
-- size of MD5's identier) + 16 (the size of an MD5 hash in bytes) + 1,
-- or 35.
--
-- Thus,
--   * for SHA1 and SHA256, use 512+ bit keys
--   * for SHA384 and SHA512, use 1024+ bit keys
--
rsassa_pkcs1_v1_5_sign :: HashInfo {- ^The hash function to use -} ->
                          PrivateKey {- ^The private key to sign with -} ->
                          ByteString {- ^The message to sign -} ->
                          Either RSAError ByteString -- ^ The signature
rsassa_pkcs1_v1_5_sign :: HashInfo -> PrivateKey -> ByteString -> Either RSAError ByteString
rsassa_pkcs1_v1_5_sign HashInfo
hi PrivateKey
k ByteString
m =
  do ByteString
em  <- HashInfo -> ByteString -> Int -> Either RSAError ByteString
emsa_pkcs1_v1_5_encode HashInfo
hi ByteString
m (PrivateKey -> Int
private_size PrivateKey
k) -- Step 1
     let m_i :: Integer
m_i = ByteString -> Integer
os2ip ByteString
em                                  -- Step 2a
     Integer
s   <- Integer -> Integer -> Integer -> Either RSAError Integer
rsa_sp1 (PrivateKey -> Integer
private_n PrivateKey
k) (PrivateKey -> Integer
private_d PrivateKey
k) Integer
m_i      -- Step 2b
     ByteString
sig <- Integer -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp Integer
s (PrivateKey -> Int
private_size PrivateKey
k)                     -- Step 2c
     ByteString -> Either RSAError ByteString
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
sig

-- |Validate a signature for the given message using the given public key. The
-- signature must be exactly k bytes long, where k is the size of the RSA
-- modulus IN BYTES.
rsassa_pkcs1_v1_5_verify :: HashInfo {- ^The hash function to use -} ->
                            PublicKey {-^The public key to validate against-} ->
                            ByteString {- ^The message that was signed -} ->
                            ByteString {- ^The purported signature -} ->
                            Either RSAError Bool
rsassa_pkcs1_v1_5_verify :: HashInfo
-> PublicKey -> ByteString -> ByteString -> Either RSAError Bool
rsassa_pkcs1_v1_5_verify HashInfo
hi PublicKey
k ByteString
m ByteString
s
  | ByteString -> Int64
BS.length ByteString
s Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PublicKey -> Int
public_size PublicKey
k)  = RSAError -> Either RSAError Bool
forall a b. a -> Either a b
Left RSAError
RSAIncorrectSigSize
  | Bool
otherwise                                    =
      do let s_i :: Integer
s_i = ByteString -> Integer
os2ip ByteString
s                                  -- Step 2a
         Integer
m_i <- Integer -> Integer -> Integer -> Either RSAError Integer
rsa_vp1 (PublicKey -> Integer
public_n PublicKey
k) (PublicKey -> Integer
public_e PublicKey
k) Integer
s_i       -- Step 2b
         ByteString
em  <- Integer -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp Integer
m_i (PublicKey -> Int
public_size PublicKey
k)                   -- Step 2c
         ByteString
em' <- HashInfo -> ByteString -> Int -> Either RSAError ByteString
emsa_pkcs1_v1_5_encode HashInfo
hi ByteString
m (PublicKey -> Int
public_size PublicKey
k) -- Step 3
         Bool -> Either RSAError Bool
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
em ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
em')

-- ----------------------------------------------------------------------------

-- |A 'mask generation function'. The input is a bytestring, and the output
-- is a hash of the given length. Unless you know what you're doing, you
-- should probably use a MGF1 formulation created with generate_MGF1.
type MGF = ByteString -> Int64 -> Either RSAError ByteString

-- |Generate a mask generation function for the rsaes_oaep_*. As
-- suggested by the name, the generated function is an instance of the MGF1
-- function. The arguments are the underlying hash function to use and the
-- size of a hash in bytes.
--
-- The bytestring passed to the generated function cannot be longer than
-- 2^32 * hLen, where hLen is the passed length of the hash.
generateMGF1 :: (ByteString -> ByteString) -> MGF
generateMGF1 :: (ByteString -> ByteString) -> MGF
generateMGF1 ByteString -> ByteString
hash ByteString
mgfSeed Int64
maskLen
  | ByteString -> Int64
BS.length ByteString
mgfSeed Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> ((Int64
2 Int64 -> Integer -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
32::Integer)) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
hLen) = RSAError -> Either RSAError ByteString
forall a b. a -> Either a b
Left RSAError
RSAMaskTooLong
  | Bool
otherwise                                        = MGF
loop ByteString
BS.empty Int64
0
 where
  hLen :: Int64
hLen       = ByteString -> Int64
BS.length (ByteString -> ByteString
hash ByteString
BS.empty)
  endCounter :: Int64
endCounter = (Int64
maskLen Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divCeil` Int64
hLen) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1
  loop :: MGF
loop ByteString
t Int64
counter
    | Int64
counter Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
endCounter = ByteString -> Either RSAError ByteString
forall a b. b -> Either a b
Right (Int64 -> ByteString -> ByteString
BS.take Int64
maskLen ByteString
t)
    | Bool
otherwise            = do ByteString
c <- Int64 -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp Int64
counter Int
4
                                let bs :: ByteString
bs = ByteString
mgfSeed ByteString -> ByteString -> ByteString
`BS.append` ByteString
c
                                    t' :: ByteString
t' = ByteString
t ByteString -> ByteString -> ByteString
`BS.append` ByteString -> ByteString
hash ByteString
bs
                                MGF
loop ByteString
t' (Int64
counter Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1)

-- ----------------------------------------------------------------------------

-- "i2osp converts a nonnegative integer to an octet string of a specified
-- length" -- RFC 3447
i2osp :: Integral a => a -> Int -> Either RSAError ByteString
i2osp :: forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp a
x Int
len | Bool
isTooLarge = RSAError -> Either RSAError ByteString
forall a b. a -> Either a b
Left RSAError
RSAIntegerTooLargeToPack
            | Bool
otherwise  = ByteString -> Either RSAError ByteString
forall a b. b -> Either a b
Right (ByteString
padding ByteString -> ByteString -> ByteString
`BS.append` ByteString
digits)
 where
  isTooLarge :: Bool
isTooLarge  = (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Integer) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>=
                (Integer
256 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len :: Integer))
  padding :: ByteString
padding     = Int64 -> Word8 -> ByteString
BS.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- ByteString -> Int64
BS.length ByteString
digits) Word8
0
  digits :: ByteString
digits      = ByteString -> ByteString
BS.reverse ((a -> Maybe (Word8, a)) -> a -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
BS.unfoldr a -> Maybe (Word8, a)
forall {b} {a}. (Integral b, Num a) => b -> Maybe (a, b)
digitize a
x)
  digitize :: b -> Maybe (a, b)
digitize b
0  = Maybe (a, b)
forall a. Maybe a
Nothing
  digitize b
v  = let (b
q, b
r) = b -> b -> (b, b)
forall a. Integral a => a -> a -> (a, a)
divMod b
v b
256
                in (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
r, b
q)

-- "os2ip converts an octet string to a nonnegative integer" - RFC 3447
os2ip :: ByteString -> Integer
os2ip :: ByteString -> Integer
os2ip = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl (\ Integer
a Word8
b -> (Integer
256 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
a) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b)) Integer
0

-- the RSA encryption function
rsa_ep :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_ep :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_ep Integer
n Integer
_ Integer
m | (Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) Bool -> Bool -> Bool
|| (Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
n) = RSAError -> Either RSAError Integer
forall a b. a -> Either a b
Left RSAError
RSAMessageRepOutOfRange
rsa_ep Integer
n Integer
e Integer
m                       = Integer -> Either RSAError Integer
forall a b. b -> Either a b
Right (Integer -> Integer -> Integer -> Integer
modular_exponentiation Integer
m Integer
e Integer
n)

-- the RSA decryption function
rsa_dp :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_dp :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_dp Integer
n Integer
_ Integer
c | (Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) Bool -> Bool -> Bool
|| (Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
n) = RSAError -> Either RSAError Integer
forall a b. a -> Either a b
Left RSAError
RSACipherRepOutOfRange
rsa_dp Integer
n Integer
d Integer
c                       = Integer -> Either RSAError Integer
forall a b. b -> Either a b
Right (Integer -> Integer -> Integer -> Integer
modular_exponentiation Integer
c Integer
d Integer
n)

-- the RSA signature generation function
rsa_sp1 :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_sp1 :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_sp1 Integer
n Integer
_ Integer
m | (Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) Bool -> Bool -> Bool
|| (Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
n) = RSAError -> Either RSAError Integer
forall a b. a -> Either a b
Left RSAError
RSAMessageRepOutOfRange
rsa_sp1 Integer
n Integer
d Integer
m                       = Integer -> Either RSAError Integer
forall a b. b -> Either a b
Right (Integer -> Integer -> Integer -> Integer
modular_exponentiation Integer
m Integer
d Integer
n)

-- the RSA signature verification function
rsa_vp1 :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_vp1 :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_vp1 Integer
n Integer
_ Integer
s | (Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) Bool -> Bool -> Bool
|| (Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
n) = RSAError -> Either RSAError Integer
forall a b. a -> Either a b
Left RSAError
RSACipherRepOutOfRange
rsa_vp1 Integer
n Integer
e Integer
s                       = Integer -> Either RSAError Integer
forall a b. b -> Either a b
Right (Integer -> Integer -> Integer -> Integer
modular_exponentiation Integer
s Integer
e Integer
n)

-- EMSA PKCS1 1.5 encoding
emsa_pkcs1_v1_5_encode :: HashInfo -> ByteString -> Int ->
                          Either RSAError ByteString
emsa_pkcs1_v1_5_encode :: HashInfo -> ByteString -> Int -> Either RSAError ByteString
emsa_pkcs1_v1_5_encode (HashInfo ByteString
ident ByteString -> ByteString
hash) ByteString
m Int
emLen
  | Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
emLen Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< (Int64
tLen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) = RSAError -> Either RSAError ByteString
forall a b. a -> Either a b
Left RSAError
RSAMessageTooShort
  | Bool
otherwise                       = ByteString -> Either RSAError ByteString
forall a b. b -> Either a b
Right ByteString
em
 where
  h :: ByteString
h = ByteString -> ByteString
hash ByteString
m
  t :: ByteString
t = ByteString
ident ByteString -> ByteString -> ByteString
`BS.append` ByteString
h
  tLen :: Int64
tLen = ByteString -> Int64
BS.length ByteString
t
  ps :: ByteString
ps = Int64 -> Word8 -> ByteString
BS.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
emLen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
tLen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
3) Word8
0xFF
  em :: ByteString
em = [ByteString] -> ByteString
BS.concat [Word8 -> ByteString
BS.singleton Word8
0x00,Word8 -> ByteString
BS.singleton Word8
0x01,ByteString
ps,Word8 -> ByteString
BS.singleton Word8
0x00,ByteString
t]

-- ----------------------------------------------------------------------------

-- Perform pair-wise xor of all the bytes in a bytestring
xorBS :: ByteString -> ByteString -> ByteString
xorBS :: ByteString -> ByteString -> ByteString
xorBS ByteString
a ByteString
b = [Word8] -> ByteString
BS.pack ((Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> [Word8]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
BS.zipWith Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor ByteString
a ByteString
b)

-- Divide a by b, rounding towards positive infinity
divCeil :: Integral a => a -> a -> a
divCeil :: forall a. Integral a => a -> a -> a
divCeil a
a a
b = let (a
q, a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
a a
b
              in if a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 then (a
q a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) else a
q

-- Generate p and q. This is not necessarily the best way to do this, but it
-- appears to work.
generatePQ :: CryptoRandomGen g =>
              g ->
              Int ->
              Either RSAError (Integer, Integer, g)
generatePQ :: forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (Integer, Integer, g)
generatePQ g
g Int
len
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2   = RSAError -> Either RSAError (Integer, Integer, g)
forall a b. a -> Either a b
Left RSAError
RSAKeySizeTooSmall
  | Bool
otherwise = do (Integer
baseP, g
g')  <- g -> Int -> Either RSAError (Integer, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (Integer, g)
largeRandomPrime g
g  (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
                   (Integer
baseQ, g
g'') <- g -> Int -> Either RSAError (Integer, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (Integer, g)
largeRandomPrime g
g' (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2))
                   case () of
                     () | Integer
baseP Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
baseQ -> g -> Int -> Either RSAError (Integer, Integer, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (Integer, Integer, g)
generatePQ g
g'' Int
len
                        | Integer
baseP Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<  Integer
baseQ -> (Integer, Integer, g) -> Either RSAError (Integer, Integer, g)
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
baseQ, Integer
baseP, g
g'')
                        | Bool
otherwise      -> (Integer, Integer, g) -> Either RSAError (Integer, Integer, g)
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
baseP, Integer
baseQ, g
g'')

-- |Generate a large random prime of a given length in bytes.
largeRandomPrime :: CryptoRandomGen g =>
                    g -> Int ->
                    Either RSAError (Integer, g)
largeRandomPrime :: forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (Integer, g)
largeRandomPrime g
g Int
len =
  do (ByteString
h_t, g
g')            <- g -> Int -> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (ByteString, g)
randomBS g
g Int
2
     let [Word8
startH, Word8
startT]  = ByteString -> [Word8]
BS.unpack ByteString
h_t
     (ByteString
startMids, g
g'')     <- g -> Int -> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (ByteString, g)
randomBS g
g' (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
     let bstr :: ByteString
bstr              = [ByteString] -> ByteString
BS.concat [Word8 -> ByteString
BS.singleton (Word8
startH Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0xc0),
                                        ByteString
startMids, Word8 -> ByteString
BS.singleton (Word8
startT Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
1)]
     g -> Integer -> Either RSAError (Integer, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Either RSAError (Integer, g)
findNextPrime g
g'' (ByteString -> Integer
os2ip ByteString
bstr)

-- |Generate a random ByteString of the given length
randomBS :: CryptoRandomGen g => g -> Int -> Either RSAError (ByteString, g)
randomBS :: forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (ByteString, g)
randomBS g
g Int
n =
  case Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
n g
g of
    Left GenError
e -> RSAError -> Either RSAError (ByteString, g)
forall a b. a -> Either a b
Left (GenError -> RSAError
RSAGenError GenError
e)
    Right (ByteString
bs, g
g') -> (ByteString, g) -> Either RSAError (ByteString, g)
forall a b. b -> Either a b
Right ([ByteString] -> ByteString
BS.fromChunks [ByteString
bs], g
g')

-- |Create a random bytestring of non-zero bytes of the given length.
randomNZBS :: CryptoRandomGen g => g -> Int -> Either RSAError (ByteString, g)
randomNZBS :: forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (ByteString, g)
randomNZBS g
gen Int
0    = (ByteString, g) -> Either RSAError (ByteString, g)
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
BS.empty, g
gen)
randomNZBS g
gen Int
size =
  do (ByteString
bstr, g
gen') <- g -> Int -> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (ByteString, g)
randomBS g
gen Int
size
     let nzbstr :: ByteString
nzbstr = (Word8 -> Bool) -> ByteString -> ByteString
BS.filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) ByteString
bstr
     (ByteString
rest, g
gen'') <- g -> Int -> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (ByteString, g)
randomNZBS g
gen' (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BS.length ByteString
nzbstr))
     (ByteString, g) -> Either RSAError (ByteString, g)
forall a. a -> Either RSAError a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
nzbstr ByteString -> ByteString -> ByteString
`BS.append` ByteString
rest, g
gen'')

-- |Given a number, probabalistically find the first prime number that occurs
-- after it.
findNextPrime :: CryptoRandomGen g =>
                 g -> Integer ->
                 Either RSAError (Integer, g)
findNextPrime :: forall g.
CryptoRandomGen g =>
g -> Integer -> Either RSAError (Integer, g)
findNextPrime g
g Integer
n
  | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
n             = g -> Integer -> Either RSAError (Integer, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Either RSAError (Integer, g)
findNextPrime g
g (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
  | Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
65537 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = g -> Integer -> Either RSAError (Integer, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Either RSAError (Integer, g)
findNextPrime g
g (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2)
  | Bool
otherwise          = case g -> Integer -> Either RSAError (Bool, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Either RSAError (Bool, g)
isProbablyPrime g
g Integer
n of
                           Left RSAError
e            -> RSAError -> Either RSAError (Integer, g)
forall a b. a -> Either a b
Left RSAError
e
                           Right (Bool
True,  g
g') -> (Integer, g) -> Either RSAError (Integer, g)
forall a b. b -> Either a b
Right (Integer
n, g
g')
                           Right (Bool
False, g
g') -> g -> Integer -> Either RSAError (Integer, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Either RSAError (Integer, g)
findNextPrime g
g' (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2)

-- |Probabilistically test whether or not a given number is prime by first
-- checking some obvious factors and then defaulting to the Miller-Rabin
-- test. Should save time for numbers that are trivially composite.
isProbablyPrime :: CryptoRandomGen g =>
                   g {- ^a good random number generator -} ->
                   Integer {- ^the number to test -} ->
                   Either RSAError (Bool, g)
isProbablyPrime :: forall g.
CryptoRandomGen g =>
g -> Integer -> Either RSAError (Bool, g)
isProbablyPrime g
g Integer
n
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
541                                  = (Bool, g) -> Either RSAError (Bool, g)
forall a b. b -> Either a b
Right (Integer
n Integer -> [Integer] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Integer]
small_primes, g
g)
  | (Integer -> Bool) -> [Integer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ Integer
x -> Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) [Integer]
small_primes = (Bool, g) -> Either RSAError (Bool, g)
forall a b. b -> Either a b
Right (Bool
False, g
g)
  | Bool
otherwise                                = g -> Integer -> Int -> Either RSAError (Bool, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Int -> Either RSAError (Bool, g)
millerRabin g
g Integer
n Int
100

-- the first 200 prime numbers
small_primes :: [Integer]
small_primes :: [Integer]
small_primes = [
      Integer
2,     Integer
3,     Integer
5,     Integer
7,    Integer
11,    Integer
13,    Integer
17,    Integer
19,    Integer
23,    Integer
29,
     Integer
31,    Integer
37,    Integer
41,    Integer
43,    Integer
47,    Integer
53,    Integer
59,    Integer
61,    Integer
67,    Integer
71,
     Integer
73,    Integer
79,    Integer
83,    Integer
89,    Integer
97,   Integer
101,   Integer
103,   Integer
107,   Integer
109,   Integer
113,
    Integer
127,   Integer
131,   Integer
137,   Integer
139,   Integer
149,   Integer
151,   Integer
157,   Integer
163,   Integer
167,   Integer
173,
    Integer
179,   Integer
181,   Integer
191,   Integer
193,   Integer
197,   Integer
199,   Integer
211,   Integer
223,   Integer
227,   Integer
229,
    Integer
233,   Integer
239,   Integer
241,   Integer
251,   Integer
257,   Integer
263,   Integer
269,   Integer
271,   Integer
277,   Integer
281,
    Integer
283,   Integer
293,   Integer
307,   Integer
311,   Integer
313,   Integer
317,   Integer
331,   Integer
337,   Integer
347,   Integer
349,
    Integer
353,   Integer
359,   Integer
367,   Integer
373,   Integer
379,   Integer
383,   Integer
389,   Integer
397,   Integer
401,   Integer
409,
    Integer
419,   Integer
421,   Integer
431,   Integer
433,   Integer
439,   Integer
443,   Integer
449,   Integer
457,   Integer
461,   Integer
463,
    Integer
467,   Integer
479,   Integer
487,   Integer
491,   Integer
499,   Integer
503,   Integer
509,   Integer
521,   Integer
523,   Integer
541,
    Integer
547,   Integer
557,   Integer
563,   Integer
569,   Integer
571,   Integer
577,   Integer
587,   Integer
593,   Integer
599,   Integer
601,
    Integer
607,   Integer
613,   Integer
617,   Integer
619,   Integer
631,   Integer
641,   Integer
643,   Integer
647,   Integer
653,   Integer
659,
    Integer
661,   Integer
673,   Integer
677,   Integer
683,   Integer
691,   Integer
701,   Integer
709,   Integer
719,   Integer
727,   Integer
733,
    Integer
739,   Integer
743,   Integer
751,   Integer
757,   Integer
761,   Integer
769,   Integer
773,   Integer
787,   Integer
797,   Integer
809,
    Integer
811,   Integer
821,   Integer
823,   Integer
827,   Integer
829,   Integer
839,   Integer
853,   Integer
857,   Integer
859,   Integer
863,
    Integer
877,   Integer
881,   Integer
883,   Integer
887,   Integer
907,   Integer
911,   Integer
919,   Integer
929,   Integer
937,   Integer
941,
    Integer
947,   Integer
953,   Integer
967,   Integer
971,   Integer
977,   Integer
983,   Integer
991,   Integer
997,  Integer
1009,  Integer
1013,
   Integer
1019,  Integer
1021,  Integer
1031,  Integer
1033,  Integer
1039,  Integer
1049,  Integer
1051,  Integer
1061,  Integer
1063,  Integer
1069,
   Integer
1087,  Integer
1091,  Integer
1093,  Integer
1097,  Integer
1103,  Integer
1109,  Integer
1117,  Integer
1123,  Integer
1129,  Integer
1151,
   Integer
1153,  Integer
1163,  Integer
1171,  Integer
1181,  Integer
1187,  Integer
1193,  Integer
1201,  Integer
1213,  Integer
1217,  Integer
1223
  ]

-- |Probabilistically test whether or not a given number is prime using
-- the Miller-Rabin test.
millerRabin :: CryptoRandomGen g =>
               g {- ^a good random number generator -} ->
               Integer {- ^the number to test -} ->
               Int {- ^the accuracy of the test -} ->
               Either RSAError (Bool, g)
millerRabin :: forall g.
CryptoRandomGen g =>
g -> Integer -> Int -> Either RSAError (Bool, g)
millerRabin g
g Integer
n Int
k
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0    = RSAError -> Either RSAError (Bool, g)
forall a b. a -> Either a b
Left (String -> RSAError
RSAError String
"Primality test on negative number or 0.")
  | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1    = (Bool, g) -> Either RSAError (Bool, g)
forall a b. b -> Either a b
Right (Bool
False, g
g)
  | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2    = (Bool, g) -> Either RSAError (Bool, g)
forall a b. b -> Either a b
Right (Bool
True, g
g)
  | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3    = (Bool, g) -> Either RSAError (Bool, g)
forall a b. b -> Either a b
Right (Bool
True, g
g)
  | Bool
otherwise =
     -- write (n-1) as 2^s*d with d odd by factoring powers of 2 from n-1
     let (Integer
s, Integer
d) = Integer -> Integer -> (Integer, Integer)
forall {t} {t}. (Bits t, Num t) => t -> t -> (t, t)
oddify Integer
0 (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
     in g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
checkLoop g
g Integer
s Integer
d Int
k
 where
  generateSize :: Int
generateSize = Integer -> Int -> Int
forall {t}. (Ord t, Bits t, Num t) => t -> Int -> Int
bitsize (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2) Int
8 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
  -- k times, pick a random integer in [2, n-2] and see if you can find
  -- a witness suggesting that it's not prime.
  checkLoop :: CryptoRandomGen g =>
               g -> Integer -> Integer -> Int ->
               Either RSAError (Bool, g)
  checkLoop :: forall g.
CryptoRandomGen g =>
g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
checkLoop g
g' Integer
_ Integer
_ Int
0 = (Bool, g) -> Either RSAError (Bool, g)
forall a b. b -> Either a b
Right (Bool
True, g
g')
  checkLoop g
g' Integer
s Integer
d Int
c =
    case Int -> g -> Either GenError (ByteString, g)
forall g.
CryptoRandomGen g =>
Int -> g -> Either GenError (ByteString, g)
genBytes Int
generateSize g
g' of
      Left GenError
e -> RSAError -> Either RSAError (Bool, g)
forall a b. a -> Either a b
Left (GenError -> RSAError
RSAGenError GenError
e)
      Right (ByteString
bstr, g
g'') ->
        let a :: Integer
a = ByteString -> Integer
os2ip (ByteString -> ByteString
BS.fromStrict ByteString
bstr)
            x :: Integer
x = Integer -> Integer -> Integer -> Integer
modular_exponentiation Integer
a Integer
d Integer
n
        in if | (Integer
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2)       -> g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
checkLoop g
g'' Integer
s Integer
d Int
c
              | (Integer
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2)) -> g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
checkLoop g
g'' Integer
s Integer
d Int
c
              | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1        -> g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
checkLoop g
g'' Integer
s Integer
d (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
              | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)  -> g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
forall g.
CryptoRandomGen g =>
g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
checkLoop g
g'' Integer
s Integer
d (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
              | Bool
otherwise     -> g
-> Integer
-> Integer
-> Integer
-> Int
-> Integer
-> Either RSAError (Bool, g)
forall {t} {t}.
(Eq t, Num t, CryptoRandomGen t) =>
t
-> Integer
-> Integer
-> Integer
-> Int
-> t
-> Either RSAError (Bool, t)
checkWitnesses g
g'' Integer
s Integer
d Integer
x Int
c (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
  -- s times, where n-1 = 2^s*d, check to see if the given number is a
  -- witness of something not being prime.
  checkWitnesses :: t
-> Integer
-> Integer
-> Integer
-> Int
-> t
-> Either RSAError (Bool, t)
checkWitnesses t
g'' Integer
_ Integer
_ Integer
_ Int
_  t
0  = (Bool, t) -> Either RSAError (Bool, t)
forall a b. b -> Either a b
Right (Bool
False, t
g'')
  checkWitnesses t
g'' Integer
s Integer
d Integer
x Int
c1 t
c2 =
    case (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n of
       Integer
1                -> (Bool, t) -> Either RSAError (Bool, t)
forall a b. b -> Either a b
Right (Bool
False, t
g'')
       Integer
y | Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) -> t -> Integer -> Integer -> Int -> Either RSAError (Bool, t)
forall g.
CryptoRandomGen g =>
g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
checkLoop t
g'' Integer
s Integer
d (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
       Integer
_                -> t
-> Integer
-> Integer
-> Integer
-> Int
-> t
-> Either RSAError (Bool, t)
checkWitnesses t
g'' Integer
s Integer
d Integer
x Int
c1 (t
c2 t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
  -- given n, compute s and d such that 2^s*d = n.
  oddify :: t -> t -> (t, t)
oddify t
s t
x | t -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit t
x Int
0 = (t
s, t
x)
             | Bool
otherwise   = t -> t -> (t, t)
oddify (t
s t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (t
x t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
  -- given n, compute the number of bits required to hold it.
  bitsize :: t -> Int -> Int
bitsize t
v Int
x | (t
1 t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
x) t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
v = Int
x
              | Bool
otherwise          = t -> Int -> Int
bitsize t
v (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8)

-- |Computes a^b mod c using a moderately good algorithm.
modular_exponentiation :: Integer -> Integer -> Integer -> Integer
modular_exponentiation :: Integer -> Integer -> Integer -> Integer
modular_exponentiation Integer
x Integer
y Integer
m = Integer -> Integer -> Integer -> Integer
forall {t}. (Num t, Bits t) => Integer -> t -> Integer -> Integer
m_e_loop Integer
x Integer
y Integer
1
 where
  m_e_loop :: Integer -> t -> Integer -> Integer
m_e_loop Integer
_ t
0 Integer
result = Integer
result
  m_e_loop Integer
b t
e Integer
result = Integer -> t -> Integer -> Integer
m_e_loop Integer
b' t
e' Integer
result'
   where
    b' :: Integer
b'      = (Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m
    e' :: t
e'      = t
e t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
    result' :: Integer
result' = if t -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit t
e Int
0 then (Integer
result Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m else Integer
result

-- |Compute the modular inverse (d = e^-1 mod phi) via the extended euclidean
-- algorithm.
modular_inverse :: Integer {- ^e -} ->
                   Integer  {- ^phi -} ->
                   Integer
modular_inverse :: Integer -> Integer -> Integer
modular_inverse Integer
e Integer
phi = Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
phi
 where (Integer
_, Integer
x, Integer
_) = Integer -> Integer -> (Integer, Integer, Integer)
extended_euclidean Integer
e Integer
phi

-- Compute the extended euclidean algorithm
extended_euclidean :: Integer -> Integer -> (Integer, Integer, Integer)
extended_euclidean :: Integer -> Integer -> (Integer, Integer, Integer)
extended_euclidean Integer
a Integer
b | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     = (-Integer
d, -Integer
x, -Integer
y)
                       | Bool
otherwise = (Integer
d, Integer
x, Integer
y)
 where
  (Integer
d, Integer
x, Integer
y) = Integer -> Integer -> (Integer, Integer, Integer)
egcd Integer
a Integer
b

egcd :: Integer -> Integer -> (Integer, Integer, Integer)
egcd :: Integer -> Integer -> (Integer, Integer, Integer)
egcd Integer
0 Integer
b = (Integer
b, Integer
0, Integer
1)
egcd Integer
a Integer
b = let (Integer
g, Integer
y, Integer
x) = Integer -> Integer -> (Integer, Integer, Integer)
egcd (Integer
b Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
a) Integer
a
           in (Integer
g, Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- ((Integer
b Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
a) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y), Integer
y)

-- ----------------------------------------------------------------------------

hashSHA1 :: HashInfo
hashSHA1 :: HashInfo
hashSHA1 = HashInfo {
   algorithmIdent :: ByteString
algorithmIdent = [Word8] -> ByteString
BS.pack [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]
 , hashFunction :: ByteString -> ByteString
hashFunction   = Digest SHA1State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest (Digest SHA1State -> ByteString)
-> (ByteString -> Digest SHA1State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
sha1
 }

hashSHA224 :: HashInfo
hashSHA224 :: HashInfo
hashSHA224 = HashInfo {
   algorithmIdent :: ByteString
algorithmIdent = [Word8] -> ByteString
BS.pack [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]
 , hashFunction :: ByteString -> ByteString
hashFunction   = Digest SHA256State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest (Digest SHA256State -> ByteString)
-> (ByteString -> Digest SHA256State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha224
 }

hashSHA256 :: HashInfo
hashSHA256 :: HashInfo
hashSHA256 = HashInfo {
   algorithmIdent :: ByteString
algorithmIdent = [Word8] -> ByteString
BS.pack [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]
 , hashFunction :: ByteString -> ByteString
hashFunction   = Digest SHA256State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest (Digest SHA256State -> ByteString)
-> (ByteString -> Digest SHA256State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha256
 }

hashSHA384 :: HashInfo
hashSHA384 :: HashInfo
hashSHA384 = HashInfo {
   algorithmIdent :: ByteString
algorithmIdent = [Word8] -> ByteString
BS.pack [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]
 , hashFunction :: ByteString -> ByteString
hashFunction   = Digest SHA512State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest (Digest SHA512State -> ByteString)
-> (ByteString -> Digest SHA512State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA512State
sha384
 }

hashSHA512 :: HashInfo
hashSHA512 :: HashInfo
hashSHA512 = HashInfo {
   algorithmIdent :: ByteString
algorithmIdent  = [Word8] -> ByteString
BS.pack [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]
 , hashFunction :: ByteString -> ByteString
hashFunction   = Digest SHA512State -> ByteString
forall t. Digest t -> ByteString
bytestringDigest (Digest SHA512State -> ByteString)
-> (ByteString -> Digest SHA512State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA512State
sha512
 }