{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE MultiWayIf #-}
module Codec.Crypto.RSA.Pure(
RSAError(..)
, HashInfo(..)
, PrivateKey(..)
, PublicKey(..)
, generateKeyPair
, encrypt
, encryptOAEP
, encryptPKCS
, decrypt
, decryptOAEP
, decryptPKCS
, sign
, verify
, MGF
, generateMGF1
, rsaes_oaep_encrypt
, rsaes_oaep_decrypt
, rsaes_pkcs1_v1_5_encrypt
, rsaes_pkcs1_v1_5_decrypt
, rsassa_pkcs1_v1_5_sign
, rsassa_pkcs1_v1_5_verify
, hashSHA1
, hashSHA224, hashSHA256, hashSHA384, hashSHA512
, 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
/= :: RSAError -> RSAError -> Bool
$c/= :: RSAError -> RSAError -> Bool
== :: RSAError -> RSAError -> Bool
$c== :: 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
showList :: [RSAError] -> ShowS
$cshowList :: [RSAError] -> ShowS
show :: RSAError -> String
$cshow :: RSAError -> String
showsPrec :: Int -> RSAError -> ShowS
$cshowsPrec :: Int -> RSAError -> ShowS
Show, Typeable)
instance Exception RSAError
data HashInfo = HashInfo {
HashInfo -> ByteString
algorithmIdent :: ByteString
, HashInfo -> ByteString -> ByteString
hashFunction :: ByteString -> ByteString
}
instance Show SystemRandom where
show :: SystemRandom -> String
show _ = "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 pk :: 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) 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int64 -> Get ByteString
getLazyByteString 8
Integer
n <- ByteString -> Integer
os2ip (ByteString -> Integer) -> Get ByteString -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int64 -> Get ByteString
getLazyByteString Int64
len
PublicKey -> Get PublicKey
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 65537)
instance Binary PrivateKey where
put :: PrivateKey -> Put
put pk :: 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 (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 (m :: * -> *) a. Monad m => a -> m a
return (PublicKey
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> PrivateKey
PrivateKey PublicKey
pub Integer
d 0 0 0 0 0)
failOnError :: (Monad m, Show a) => Either a b -> m b
failOnError :: Either a b -> m b
failOnError (Left e :: 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) = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
generateKeyPair :: CryptoRandomGen g =>
g -> Int ->
Either RSAError (PublicKey, PrivateKey, g)
generateKeyPair :: g -> Int -> Either RSAError (PublicKey, PrivateKey, g)
generateKeyPair g :: g
g sizeBits :: 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` 8)
(p :: Integer
p, q :: Integer
q, g' :: 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
- 1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
e :: Integer
e = 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 0 0 0
(PublicKey, PrivateKey, g)
-> Either RSAError (PublicKey, PrivateKey, g)
forall (m :: * -> *) a. Monad m => a -> m a
return (PublicKey
publicKey, PrivateKey
privateKey, g
g')
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 :: PublicKey ->
ByteString ->
ByteString ->
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 :: CryptoRandomGen g =>
g -> PublicKey -> ByteString ->
Either RSAError (ByteString, g)
encrypt :: g -> PublicKey -> ByteString -> Either RSAError (ByteString, g)
encrypt g :: g
g k :: PublicKey
k m :: 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
encryptOAEP :: CryptoRandomGen g =>
g ->
(ByteString -> ByteString) ->
MGF ->
ByteString ->
PublicKey ->
ByteString ->
Either RSAError (ByteString, g)
encryptOAEP :: g
-> (ByteString -> ByteString)
-> MGF
-> ByteString
-> PublicKey
-> ByteString
-> Either RSAError (ByteString, g)
encryptOAEP g :: g
g hash :: ByteString -> ByteString
hash mgf :: MGF
mgf l :: ByteString
l k :: PublicKey
k m :: 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
- (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hashLength) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
(chunks' :: [ByteString]
chunks', g' :: 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 (\ x :: 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 (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))
encryptPKCS :: CryptoRandomGen g =>
g -> PublicKey -> ByteString ->
Either RSAError (ByteString, g)
encryptPKCS :: g -> PublicKey -> ByteString -> Either RSAError (ByteString, g)
encryptPKCS g :: g
g k :: PublicKey
k m :: ByteString
m =
do let chunks :: [ByteString]
chunks = PublicKey -> ByteString -> [ByteString]
forall k. RSAKey k => k -> ByteString -> [ByteString]
chunkBSForPKCS PublicKey
k ByteString
m
(chunks' :: [ByteString]
chunks', g' :: 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 (\ x :: 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 (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BS.concat [ByteString]
chunks', g
g')
mapM' :: CryptoRandomGen g =>
g -> [ByteString] ->
(g -> ByteString -> Either RSAError (ByteString, g)) ->
Either RSAError ([ByteString], g)
mapM' :: g
-> [ByteString]
-> (g -> ByteString -> Either RSAError (ByteString, g))
-> Either RSAError ([ByteString], g)
mapM' g :: g
g [] _ = ([ByteString], g) -> Either RSAError ([ByteString], g)
forall a b. b -> Either a b
Right ([], g
g)
mapM' g :: g
g (x :: ByteString
x:rest :: [ByteString]
rest) f :: g -> ByteString -> Either RSAError (ByteString, g)
f =
do (x' :: ByteString
x', g' :: g
g') <- g -> ByteString -> Either RSAError (ByteString, g)
f g
g ByteString
x
(rest' :: [ByteString]
rest', g'' :: 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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString
x'ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
rest', g
g'')
decrypt :: PrivateKey -> ByteString -> Either RSAError ByteString
decrypt :: PrivateKey -> ByteString -> Either RSAError ByteString
decrypt k :: PrivateKey
k m :: 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
decryptOAEP :: (ByteString -> ByteString) ->
MGF ->
ByteString ->
PrivateKey ->
ByteString ->
Either RSAError ByteString
decryptOAEP :: (ByteString -> ByteString)
-> MGF
-> ByteString
-> PrivateKey
-> ByteString
-> Either RSAError ByteString
decryptOAEP hash :: ByteString -> ByteString
hash mgf :: MGF
mgf l :: ByteString
l k :: PrivateKey
k m :: 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 (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BS.concat [ByteString]
chunks')
decryptPKCS :: PrivateKey -> ByteString -> Either RSAError ByteString
decryptPKCS :: PrivateKey -> ByteString -> Either RSAError ByteString
decryptPKCS k :: PrivateKey
k m :: 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 (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
BS.concat [ByteString]
chunks')
chunkBSForOAEP :: RSAKey k =>
k ->
(ByteString -> ByteString) ->
ByteString ->
[ByteString]
chunkBSForOAEP :: k -> (ByteString -> ByteString) -> ByteString -> [ByteString]
chunkBSForOAEP k :: k
k hash :: ByteString -> ByteString
hash bs :: 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
- (2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
hashLen) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- 2
hashLen :: Int64
hashLen = ByteString -> Int64
BS.length (ByteString -> ByteString
hash ByteString
BS.empty)
chunkBSForPKCS :: RSAKey k => k -> ByteString -> [ByteString]
chunkBSForPKCS :: k -> ByteString -> [ByteString]
chunkBSForPKCS k :: k
k bstr :: 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
- 11)
chunkify :: ByteString -> Int64 -> [ByteString]
chunkify :: ByteString -> Int64 -> [ByteString]
chunkify bs :: ByteString
bs size :: Int64
size
| ByteString -> Int64
BS.length ByteString
bs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = []
| Bool
otherwise = let (start :: ByteString
start, end :: 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
rsaes_oaep_encrypt :: CryptoRandomGen g =>
g ->
(ByteString->ByteString) ->
MGF ->
PublicKey ->
ByteString ->
ByteString ->
Either RSAError (ByteString, g)
rsaes_oaep_encrypt :: g
-> (ByteString -> ByteString)
-> MGF
-> PublicKey
-> ByteString
-> ByteString
-> Either RSAError (ByteString, g)
rsaes_oaep_encrypt g :: g
g hash :: ByteString -> ByteString
hash mgf :: MGF
mgf k :: PublicKey
k l :: ByteString
l m :: 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)
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
- (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hashLength) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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
RSAMessageTooLong
let lHash :: ByteString
lHash = ByteString -> ByteString
hash ByteString
l
let zeros :: ByteString
zeros = Word8 -> ByteString
BS.repeat 0
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
- (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hashLength) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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 1, ByteString
m]
(seed :: ByteString
seed, g' :: g
g') <- g -> Int -> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (ByteString, g)
randomBS g
g Int
hashLength
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
- 1))
let maskedDB :: ByteString
maskedDB = ByteString
db ByteString -> ByteString -> ByteString
`xorBS` ByteString
dbMask
ByteString
seedMask <- MGF
mgf ByteString
maskedDB (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hashLength)
let maskedSeed :: ByteString
maskedSeed = ByteString
seed ByteString -> ByteString -> ByteString
`xorBS` ByteString
seedMask
let em :: ByteString
em = [ByteString] -> ByteString
BS.concat [Word8 -> ByteString
BS.singleton 0, ByteString
maskedSeed, ByteString
maskedDB]
let m_i :: Integer
m_i = 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_i
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)
(ByteString, g) -> Either RSAError (ByteString, g)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
c, g
g')
rsaes_oaep_decrypt :: (ByteString->ByteString) ->
MGF ->
PrivateKey ->
ByteString ->
ByteString ->
Either RSAError ByteString
rsaes_oaep_decrypt :: (ByteString -> ByteString)
-> MGF
-> PrivateKey
-> ByteString
-> ByteString
-> Either RSAError ByteString
rsaes_oaep_decrypt hash :: ByteString -> ByteString
hash mgf :: MGF
mgf k :: PrivateKey
k l :: ByteString
l c :: 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
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
$
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
>= ((2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
hashLength) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ 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
let c_ip :: Integer
c_ip = ByteString -> Integer
os2ip ByteString
c
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
ByteString
em <- Integer -> Int -> Either RSAError ByteString
forall a. Integral a => a -> Int -> Either RSAError ByteString
i2osp Integer
m_ip Int
keySize
let lHash :: ByteString
lHash = ByteString -> ByteString
hash ByteString
l
let (y :: ByteString
y, seed_db :: ByteString
seed_db) = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt 1 ByteString
em
(maskedSeed :: ByteString
maskedSeed, maskedDB :: 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
let seed :: ByteString
seed = ByteString
maskedSeed ByteString -> ByteString -> ByteString
`xorBS` ByteString
seedMask
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
- 1)
let db :: ByteString
db = ByteString
maskedDB ByteString -> ByteString -> ByteString
`xorBS` ByteString
dbMask
let (lHash' :: ByteString
lHash', ps_o_m :: ByteString
ps_o_m) = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt Int64
hashLength ByteString
db
(ps :: ByteString
ps, o_m :: ByteString
o_m) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0) ByteString
ps_o_m
(o :: ByteString
o, m :: ByteString
m) = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt 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
== [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
== [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
== 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 (m :: * -> *) a. Monad m => a -> m a
return ByteString
m
rsaes_pkcs1_v1_5_encrypt :: CryptoRandomGen g =>
g ->
PublicKey ->
ByteString ->
Either RSAError (ByteString, g)
rsaes_pkcs1_v1_5_encrypt :: g -> PublicKey -> ByteString -> Either RSAError (ByteString, g)
rsaes_pkcs1_v1_5_encrypt g :: g
g k :: PublicKey
k m :: 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
- 11)) (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
RSAIncorrectMsgSize
(ps :: ByteString
ps, g' :: 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
- 3)
let em :: ByteString
em = [ByteString] -> ByteString
BS.concat [Word8 -> ByteString
BS.singleton 0, Word8 -> ByteString
BS.singleton 2, ByteString
ps, Word8 -> ByteString
BS.singleton 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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString
res, g
g')
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 k :: PrivateKey
k c :: 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
$
RSAError -> Either RSAError ()
forall a b. a -> Either a b
Left RSAError
RSAIncorrectMsgSize
let c_i :: Integer
c_i = ByteString -> Integer
os2ip ByteString
c
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
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)
let (zt :: ByteString
zt, ps_z_m :: ByteString
ps_z_m) = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt 2 ByteString
em
(ps :: ByteString
ps, z_m :: ByteString
z_m) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) ByteString
ps_z_m
(z :: ByteString
z, m :: ByteString
m) = Int64 -> ByteString -> (ByteString, ByteString)
BS.splitAt 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
/= [0,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
/= [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
< 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 (m :: * -> *) a. Monad m => a -> m a
return ByteString
m
rsassa_pkcs1_v1_5_sign :: HashInfo ->
PrivateKey ->
ByteString ->
Either RSAError ByteString
rsassa_pkcs1_v1_5_sign :: HashInfo -> PrivateKey -> ByteString -> Either RSAError ByteString
rsassa_pkcs1_v1_5_sign hi :: HashInfo
hi k :: PrivateKey
k m :: 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)
let m_i :: Integer
m_i = ByteString -> Integer
os2ip ByteString
em
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
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)
ByteString -> Either RSAError ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
sig
rsassa_pkcs1_v1_5_verify :: HashInfo ->
PublicKey ->
ByteString ->
ByteString ->
Either RSAError Bool
rsassa_pkcs1_v1_5_verify :: HashInfo
-> PublicKey -> ByteString -> ByteString -> Either RSAError Bool
rsassa_pkcs1_v1_5_verify hi :: HashInfo
hi k :: PublicKey
k m :: ByteString
m s :: 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
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
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)
ByteString
em' <- HashInfo -> ByteString -> Int -> Either RSAError ByteString
emsa_pkcs1_v1_5_encode HashInfo
hi ByteString
m (PublicKey -> Int
public_size PublicKey
k)
Bool -> Either RSAError Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
em ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
em')
type MGF = ByteString -> Int64 -> Either RSAError ByteString
generateMGF1 :: (ByteString -> ByteString) -> MGF
generateMGF1 :: (ByteString -> ByteString) -> MGF
generateMGF1 hash :: ByteString -> ByteString
hash mgfSeed :: ByteString
mgfSeed maskLen :: Int64
maskLen
| ByteString -> Int64
BS.length ByteString
mgfSeed Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> ((2 Int64 -> Integer -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ (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 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
- 1
loop :: MGF
loop t :: ByteString
t counter :: 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 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
+ 1)
i2osp :: Integral a => a -> Int -> Either RSAError ByteString
i2osp :: a -> Int -> Either RSAError ByteString
i2osp x :: a
x len :: 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
>=
(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) 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. (Num a, Integral b) => b -> Maybe (a, b)
digitize a
x)
digitize :: b -> Maybe (a, b)
digitize 0 = Maybe (a, b)
forall a. Maybe a
Nothing
digitize v :: b
v = let (q :: b
q, r :: b
r) = b -> b -> (b, b)
forall a. Integral a => a -> a -> (a, a)
divMod b
v 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 :: ByteString -> Integer
os2ip :: ByteString -> Integer
os2ip = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl (\ a :: Integer
a b :: Word8
b -> (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)) 0
rsa_ep :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_ep :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_ep n :: Integer
n _ m :: Integer
m | (Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 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 n :: Integer
n e :: Integer
e m :: 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)
rsa_dp :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_dp :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_dp n :: Integer
n _ c :: Integer
c | (Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 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 n :: Integer
n d :: Integer
d c :: 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)
rsa_sp1 :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_sp1 :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_sp1 n :: Integer
n _ m :: Integer
m | (Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 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 n :: Integer
n d :: Integer
d m :: 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)
rsa_vp1 :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_vp1 :: Integer -> Integer -> Integer -> Either RSAError Integer
rsa_vp1 n :: Integer
n _ s :: Integer
s | (Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 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 n :: Integer
n e :: Integer
e s :: 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_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 ident :: ByteString
ident hash :: ByteString -> ByteString
hash) m :: ByteString
m emLen :: 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
+ 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
- 3) 0xFF
em :: ByteString
em = [ByteString] -> ByteString
BS.concat [Word8 -> ByteString
BS.singleton 0x00,Word8 -> ByteString
BS.singleton 0x01,ByteString
ps,Word8 -> ByteString
BS.singleton 0x00,ByteString
t]
xorBS :: ByteString -> ByteString -> ByteString
xorBS :: ByteString -> ByteString -> ByteString
xorBS a :: ByteString
a b :: 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)
divCeil :: Integral a => a -> a -> a
divCeil :: a -> a -> a
divCeil a :: a
a b :: a
b = let (q :: a
q, r :: 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
/= 0 then (a
q a -> a -> a
forall a. Num a => a -> a -> a
+ 1) else a
q
generatePQ :: CryptoRandomGen g =>
g ->
Int ->
Either RSAError (Integer, Integer, g)
generatePQ :: g -> Int -> Either RSAError (Integer, Integer, g)
generatePQ g :: g
g len :: Int
len
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = RSAError -> Either RSAError (Integer, Integer, g)
forall a b. a -> Either a b
Left RSAError
RSAKeySizeTooSmall
| Bool
otherwise = do (baseP :: Integer
baseP, g' :: 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` 2)
(baseQ :: Integer
baseQ, g'' :: 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` 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 (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 (m :: * -> *) a. Monad m => a -> m a
return (Integer
baseP, Integer
baseQ, g
g'')
largeRandomPrime :: CryptoRandomGen g =>
g -> Int ->
Either RSAError (Integer, g)
largeRandomPrime :: g -> Int -> Either RSAError (Integer, g)
largeRandomPrime g :: g
g len :: Int
len =
do (h_t :: ByteString
h_t, g' :: g
g') <- g -> Int -> Either RSAError (ByteString, g)
forall g.
CryptoRandomGen g =>
g -> Int -> Either RSAError (ByteString, g)
randomBS g
g 2
let [startH :: Word8
startH, startT :: Word8
startT] = ByteString -> [Word8]
BS.unpack ByteString
h_t
(startMids :: ByteString
startMids, g'' :: 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
- 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
.|. 0xc0),
ByteString
startMids, Word8 -> ByteString
BS.singleton (Word8
startT Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 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)
randomBS :: CryptoRandomGen g => g -> Int -> Either RSAError (ByteString, g)
randomBS :: g -> Int -> Either RSAError (ByteString, g)
randomBS g :: g
g n :: 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 e :: GenError
e -> RSAError -> Either RSAError (ByteString, g)
forall a b. a -> Either a b
Left (GenError -> RSAError
RSAGenError GenError
e)
Right (bs :: ByteString
bs, g' :: g
g') -> (ByteString, g) -> Either RSAError (ByteString, g)
forall a b. b -> Either a b
Right ([ByteString] -> ByteString
BS.fromChunks [ByteString
bs], g
g')
randomNZBS :: CryptoRandomGen g => g -> Int -> Either RSAError (ByteString, g)
randomNZBS :: g -> Int -> Either RSAError (ByteString, g)
randomNZBS gen :: g
gen 0 = (ByteString, g) -> Either RSAError (ByteString, g)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
BS.empty, g
gen)
randomNZBS gen :: g
gen size :: Int
size =
do (bstr :: ByteString
bstr, gen' :: 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
/= 0) ByteString
bstr
(rest :: ByteString
rest, gen'' :: 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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString
nzbstr ByteString -> ByteString -> ByteString
`BS.append` ByteString
rest, g
gen'')
findNextPrime :: CryptoRandomGen g =>
g -> Integer ->
Either RSAError (Integer, g)
findNextPrime :: g -> Integer -> Either RSAError (Integer, g)
findNextPrime g :: g
g n :: 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
+ 1)
| Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` 65537 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 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
+ 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 e :: RSAError
e -> RSAError -> Either RSAError (Integer, g)
forall a b. a -> Either a b
Left RSAError
e
Right (True, g' :: g
g') -> (Integer, g) -> Either RSAError (Integer, g)
forall a b. b -> Either a b
Right (Integer
n, g
g')
Right (False, g' :: 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
+ 2)
isProbablyPrime :: CryptoRandomGen g =>
g ->
Integer ->
Either RSAError (Bool, g)
isProbablyPrime :: g -> Integer -> Either RSAError (Bool, g)
isProbablyPrime g :: g
g n :: Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 541 = (Bool, g) -> Either RSAError (Bool, g)
forall a b. b -> Either a b
Right (Integer
n Integer -> [Integer] -> 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 (\ x :: 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
== 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 100
small_primes :: [Integer]
small_primes :: [Integer]
small_primes = [
2, 3, 5, 7, 11, 13, 17, 19, 23, 29,
31, 37, 41, 43, 47, 53, 59, 61, 67, 71,
73, 79, 83, 89, 97, 101, 103, 107, 109, 113,
127, 131, 137, 139, 149, 151, 157, 163, 167, 173,
179, 181, 191, 193, 197, 199, 211, 223, 227, 229,
233, 239, 241, 251, 257, 263, 269, 271, 277, 281,
283, 293, 307, 311, 313, 317, 331, 337, 347, 349,
353, 359, 367, 373, 379, 383, 389, 397, 401, 409,
419, 421, 431, 433, 439, 443, 449, 457, 461, 463,
467, 479, 487, 491, 499, 503, 509, 521, 523, 541,
547, 557, 563, 569, 571, 577, 587, 593, 599, 601,
607, 613, 617, 619, 631, 641, 643, 647, 653, 659,
661, 673, 677, 683, 691, 701, 709, 719, 727, 733,
739, 743, 751, 757, 761, 769, 773, 787, 797, 809,
811, 821, 823, 827, 829, 839, 853, 857, 859, 863,
877, 881, 883, 887, 907, 911, 919, 929, 937, 941,
947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013,
1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069,
1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151,
1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223
]
millerRabin :: CryptoRandomGen g =>
g ->
Integer ->
Int ->
Either RSAError (Bool, g)
millerRabin :: g -> Integer -> Int -> Either RSAError (Bool, g)
millerRabin g :: g
g n :: Integer
n k :: Int
k
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = RSAError -> Either RSAError (Bool, g)
forall a b. a -> Either a b
Left (String -> RSAError
RSAError "Primality test on negative number or 0.")
| Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 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
== 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
== 3 = (Bool, g) -> Either RSAError (Bool, g)
forall a b. b -> Either a b
Right (Bool
True, g
g)
| Bool
otherwise =
let (s :: Integer
s, d :: Integer
d) = Integer -> Integer -> (Integer, Integer)
forall t t. (Bits t, Num t) => t -> t -> (t, t)
oddify 0 (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 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
- 2) 8 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 8
checkLoop :: CryptoRandomGen g =>
g -> Integer -> Integer -> Int ->
Either RSAError (Bool, g)
checkLoop :: g -> Integer -> Integer -> Int -> Either RSAError (Bool, g)
checkLoop g' :: g
g' _ _ 0 = (Bool, g) -> Either RSAError (Bool, g)
forall a b. b -> Either a b
Right (Bool
True, g
g')
checkLoop g' :: g
g' s :: Integer
s d :: Integer
d c :: 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 e :: GenError
e -> RSAError -> Either RSAError (Bool, g)
forall a b. a -> Either a b
Left (GenError -> RSAError
RSAGenError GenError
e)
Right (bstr :: ByteString
bstr, g'' :: 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
< 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
- 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
== 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
- 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
- 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
- 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
- 1)
checkWitnesses :: t
-> Integer
-> Integer
-> Integer
-> Int
-> t
-> Either RSAError (Bool, t)
checkWitnesses g'' :: t
g'' _ _ _ _ 0 = (Bool, t) -> Either RSAError (Bool, t)
forall a b. b -> Either a b
Right (Bool
False, t
g'')
checkWitnesses g'' :: t
g'' s :: Integer
s d :: Integer
d x :: Integer
x c1 :: Int
c1 c2 :: 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
1 -> (Bool, t) -> Either RSAError (Bool, t)
forall a b. b -> Either a b
Right (Bool
False, t
g'')
y :: 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
- 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
- 1)
_ -> 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
- 1)
oddify :: t -> t -> (t, t)
oddify s :: t
s x :: t
x | t -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit t
x 0 = (t
s, t
x)
| Bool
otherwise = t -> t -> (t, t)
oddify (t
s t -> t -> t
forall a. Num a => a -> a -> a
+ 1) (t
x t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` 1)
bitsize :: t -> Int -> Int
bitsize v :: t
v x :: Int
x | (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
+ 8)
modular_exponentiation :: Integer -> Integer -> Integer -> Integer
modular_exponentiation :: Integer -> Integer -> Integer -> Integer
modular_exponentiation x :: Integer
x y :: Integer
y m :: Integer
m = Integer -> Integer -> Integer -> Integer
forall t. (Num t, Bits t) => Integer -> t -> Integer -> Integer
m_e_loop Integer
x Integer
y 1
where
m_e_loop :: Integer -> t -> Integer -> Integer
m_e_loop _ 0 result :: Integer
result = Integer
result
m_e_loop b :: Integer
b e :: t
e result :: 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` 1
result' :: Integer
result' = if t -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit t
e 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
modular_inverse :: Integer ->
Integer ->
Integer
modular_inverse :: Integer -> Integer -> Integer
modular_inverse e :: Integer
e phi :: Integer
phi = Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
phi
where (_, x :: Integer
x, _) = Integer -> Integer -> (Integer, Integer, Integer)
extended_euclidean Integer
e Integer
phi
extended_euclidean :: Integer -> Integer -> (Integer, Integer, Integer)
extended_euclidean :: Integer -> Integer -> (Integer, Integer, Integer)
extended_euclidean a :: Integer
a b :: Integer
b | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (-Integer
d, -Integer
x, -Integer
y)
| Bool
otherwise = (Integer
d, Integer
x, Integer
y)
where
(d :: Integer
d, x :: Integer
x, y :: 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 0 b :: Integer
b = (Integer
b, 0, 1)
egcd a :: Integer
a b :: Integer
b = let (g :: Integer
g, y :: Integer
y, x :: 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 :: ByteString -> (ByteString -> ByteString) -> HashInfo
HashInfo {
algorithmIdent :: ByteString
algorithmIdent = [Word8] -> ByteString
BS.pack [0x30,0x21,0x30,0x09,0x06,0x05,0x2b,0x0e,0x03,
0x02,0x1a,0x05,0x00,0x04,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 :: ByteString -> (ByteString -> ByteString) -> HashInfo
HashInfo {
algorithmIdent :: ByteString
algorithmIdent = [Word8] -> ByteString
BS.pack [0x30,0x2d,0x30,0x0d,0x06,0x09,0x60,0x86,0x48,
0x01,0x65,0x03,0x04,0x02,0x04,0x05,0x00,0x04,
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 :: ByteString -> (ByteString -> ByteString) -> HashInfo
HashInfo {
algorithmIdent :: ByteString
algorithmIdent = [Word8] -> ByteString
BS.pack [0x30,0x31,0x30,0x0d,0x06,0x09,0x60,0x86,0x48,
0x01,0x65,0x03,0x04,0x02,0x01,0x05,0x00,0x04,
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 :: ByteString -> (ByteString -> ByteString) -> HashInfo
HashInfo {
algorithmIdent :: ByteString
algorithmIdent = [Word8] -> ByteString
BS.pack [0x30,0x41,0x30,0x0d,0x06,0x09,0x60,0x86,0x48,
0x01,0x65,0x03,0x04,0x02,0x02,0x05,0x00,0x04,
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 :: ByteString -> (ByteString -> ByteString) -> HashInfo
HashInfo {
algorithmIdent :: ByteString
algorithmIdent = [Word8] -> ByteString
BS.pack [0x30,0x51,0x30,0x0d,0x06,0x09,0x60,0x86,0x48,
0x01,0x65,0x03,0x04,0x02,0x03,0x05,0x00,0x04,
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
}