License | BSD-style |
---|---|
Maintainer | Carlos Rodriguez-Vega <crodveg@yahoo.es> |
Stability | experimental |
Portability | unknown |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Rabin-Williams cryptosystem for public-key encryption and digital signature. See pages 323 - 324 in "Computational Number Theory and Modern Cryptography" by Song Y. Yan. Also inspired by https://github.com/vanilala/vncrypt/blob/master/vncrypt/vnrw_gmp.c.
Synopsis
- data PublicKey = PublicKey {
- public_size :: Int
- public_n :: Integer
- data PrivateKey = PrivateKey {}
- generate :: MonadRandom m => Int -> m (PublicKey, PrivateKey)
- encrypt :: (HashAlgorithm hash, MonadRandom m) => OAEPParams hash ByteString ByteString -> PublicKey -> ByteString -> m (Either Error ByteString)
- encryptWithSeed :: HashAlgorithm hash => ByteString -> OAEPParams hash ByteString ByteString -> PublicKey -> ByteString -> Either Error ByteString
- decrypt :: HashAlgorithm hash => OAEPParams hash ByteString ByteString -> PrivateKey -> ByteString -> Maybe ByteString
- sign :: HashAlgorithm hash => PrivateKey -> hash -> ByteString -> Either Error Integer
- verify :: HashAlgorithm hash => PublicKey -> hash -> ByteString -> Integer -> Bool
Documentation
Represent a Rabin-Williams public key.
PublicKey | |
|
Instances
Data PublicKey Source # | |
Defined in Crypto.PubKey.Rabin.RW gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PublicKey -> c PublicKey # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PublicKey # toConstr :: PublicKey -> Constr # dataTypeOf :: PublicKey -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c PublicKey) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PublicKey) # gmapT :: (forall b. Data b => b -> b) -> PublicKey -> PublicKey # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PublicKey -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PublicKey -> r # gmapQ :: (forall d. Data d => d -> u) -> PublicKey -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> PublicKey -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> PublicKey -> m PublicKey # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PublicKey -> m PublicKey # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PublicKey -> m PublicKey # | |
Read PublicKey Source # | |
Show PublicKey Source # | |
Eq PublicKey Source # | |
data PrivateKey Source #
Represent a Rabin-Williams private key.
Instances
generate :: MonadRandom m => Int -> m (PublicKey, PrivateKey) Source #
Generate a pair of (private, public) key of size in bytes. Prime p is congruent 3 mod 8 and prime q is congruent 7 mod 8.
:: (HashAlgorithm hash, MonadRandom m) | |
=> OAEPParams hash ByteString ByteString | OAEP padding parameters |
-> PublicKey | public key |
-> ByteString | plaintext |
-> m (Either Error ByteString) |
Encrypt plaintext using public key.
:: HashAlgorithm hash | |
=> ByteString | Seed |
-> OAEPParams hash ByteString ByteString | OAEP padding |
-> PublicKey | public key |
-> ByteString | plaintext |
-> Either Error ByteString |
Encrypt plaintext using public key an a predefined OAEP seed.
See algorithm 8.11 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al.
:: HashAlgorithm hash | |
=> OAEPParams hash ByteString ByteString | OAEP padding parameters |
-> PrivateKey | private key |
-> ByteString | ciphertext |
-> Maybe ByteString |
Decrypt ciphertext using private key.
:: HashAlgorithm hash | |
=> PrivateKey | private key |
-> hash | hash function |
-> ByteString | message to sign |
-> Either Error Integer |
Sign message using hash algorithm and private key.
:: HashAlgorithm hash | |
=> PublicKey | public key |
-> hash | hash function |
-> ByteString | message |
-> Integer | signature |
-> Bool |
Verify signature using hash algorithm and public key.