cropty-0.3.1.0: Encryption and decryption
CopyrightSamuel Schlesinger 2021 (c)
LicenseMIT
Safe HaskellNone
LanguageHaskell2010

Cropty

Description

 
Synopsis

Asymmetric Encryption

newtype PrivateKey Source #

A secret identity which one should be very careful about storing and sharing. If others get it, they will be able to read messages intended for you.

Constructors

PrivateKey 

Instances

Instances details
Eq PrivateKey Source # 
Instance details

Defined in Cropty

Ord PrivateKey Source # 
Instance details

Defined in Cropty

Read PrivateKey Source # 
Instance details

Defined in Cropty

Show PrivateKey Source # 
Instance details

Defined in Cropty

Binary PrivateKey Source # 
Instance details

Defined in Cropty

privateToPublic :: PrivateKey -> PublicKey Source #

Get a PublicKey which corresponds to the given PrivateKey

data PublicKey Source #

A public identity which corresponds to your secret one, allowing you to tell other people how to encrypt things for you. If you sign something with the PrivateKey associated with this public one, someone will be able to verify it was you with your public key.

Constructors

PublicKey 

Fields

Instances

Instances details
Eq PublicKey Source # 
Instance details

Defined in Cropty

Ord PublicKey Source # 
Instance details

Defined in Cropty

Read PublicKey Source # 
Instance details

Defined in Cropty

Show PublicKey Source # 
Instance details

Defined in Cropty

Binary PublicKey Source # 
Instance details

Defined in Cropty

Efficient Encryption

data Message Source #

An message encrypted for a specific PublicKey. Contains an encryptSmalled AEP key which only the owner of the corresponding PrivateKey can unlock, and a symmetrically encrypted message for them to decrypt once they decryptSmall their AEP key.

Instances

Instances details
Read Message Source # 
Instance details

Defined in Cropty

Show Message Source # 
Instance details

Defined in Cropty

Generic Message Source # 
Instance details

Defined in Cropty

Associated Types

type Rep Message :: Type -> Type #

Methods

from :: Message -> Rep Message x #

to :: Rep Message x -> Message #

Binary Message Source # 
Instance details

Defined in Cropty

Methods

put :: Message -> Put #

get :: Get Message #

putList :: [Message] -> Put #

type Rep Message Source # 
Instance details

Defined in Cropty

type Rep Message = D1 ('MetaData "Message" "Cropty" "cropty-0.3.1.0-Kj3nrqpcf3M6FZNfZi8ZJC" 'False) (C1 ('MetaCons "Message" 'PrefixI 'True) (S1 ('MetaSel ('Just "encryptedKey") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString) :*: S1 ('MetaSel ('Just "encryptedBytes") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

encrypt :: PublicKey -> ByteString -> IO Message Source #

Encrypt a ByteString for the given PublicKey, storing the results into a Message.

decrypt :: PrivateKey -> Message -> IO ByteString Source #

Decrypt a Message into a ByteString, the original message.

Digital Signatures

newtype Signature Source #

The result of signing a ByteString. View this as a digital improvement on the written signature: if you sign something with your PrivateKey, anyone with your PublicKey can verify that signature's legitimacy.

Constructors

Signature 

Instances

Instances details
Eq Signature Source # 
Instance details

Defined in Cropty

Ord Signature Source # 
Instance details

Defined in Cropty

Read Signature Source # 
Instance details

Defined in Cropty

Show Signature Source # 
Instance details

Defined in Cropty

Generic Signature Source # 
Instance details

Defined in Cropty

Associated Types

type Rep Signature :: Type -> Type #

Binary Signature Source # 
Instance details

Defined in Cropty

type Rep Signature Source # 
Instance details

Defined in Cropty

type Rep Signature = D1 ('MetaData "Signature" "Cropty" "cropty-0.3.1.0-Kj3nrqpcf3M6FZNfZi8ZJC" 'True) (C1 ('MetaCons "Signature" 'PrefixI 'True) (S1 ('MetaSel ('Just "signatureBytes") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

sign :: PrivateKey -> ByteString -> IO Signature Source #

Sign a message with your private key, producing a ByteString that others cannot fabricate for new messages.

verify :: PublicKey -> ByteString -> Signature -> Bool Source #

Verify the signature of a message.

data Signed a Source #

A convenient type in which to wrap signed things.

Instances

Instances details
Eq (Signed a) Source # 
Instance details

Defined in Cropty

Methods

(==) :: Signed a -> Signed a -> Bool #

(/=) :: Signed a -> Signed a -> Bool #

Ord (Signed a) Source # 
Instance details

Defined in Cropty

Methods

compare :: Signed a -> Signed a -> Ordering #

(<) :: Signed a -> Signed a -> Bool #

(<=) :: Signed a -> Signed a -> Bool #

(>) :: Signed a -> Signed a -> Bool #

(>=) :: Signed a -> Signed a -> Bool #

max :: Signed a -> Signed a -> Signed a #

min :: Signed a -> Signed a -> Signed a #

Read a => Read (Signed a) Source # 
Instance details

Defined in Cropty

Show a => Show (Signed a) Source # 
Instance details

Defined in Cropty

Methods

showsPrec :: Int -> Signed a -> ShowS #

show :: Signed a -> String #

showList :: [Signed a] -> ShowS #

Generic (Signed a) Source # 
Instance details

Defined in Cropty

Associated Types

type Rep (Signed a) :: Type -> Type #

Methods

from :: Signed a -> Rep (Signed a) x #

to :: Rep (Signed a) x -> Signed a #

Binary a => Binary (Signed a) Source # 
Instance details

Defined in Cropty

Methods

put :: Signed a -> Put #

get :: Get (Signed a) #

putList :: [Signed a] -> Put #

type Rep (Signed a) Source # 
Instance details

Defined in Cropty

type Rep (Signed a) = D1 ('MetaData "Signed" "Cropty" "cropty-0.3.1.0-Kj3nrqpcf3M6FZNfZi8ZJC" 'False) (C1 ('MetaCons "Signed" 'PrefixI 'True) ((S1 ('MetaSel ('Just "signed") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Just "signedEncoded") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)) :*: (S1 ('MetaSel ('Just "signature") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Signature) :*: S1 ('MetaSel ('Just "signedBy") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PublicKey))))

signed :: Signed a -> a Source #

mkSigned :: Binary a => PrivateKey -> a -> IO (Signed a) Source #

Create a Signed piece of data.

verifySigned :: Signed a -> Bool Source #

Verify a Signed piece of data.

Encrypt/Decrypt Small Strings

encryptSmall :: PublicKey -> ByteString -> IO (Either RSAError ByteString) Source #

Encrypt a ByteString of length less than or equal to the KeySize. Skips the symmetric encryption step. For the most part, this should be avoided, but there is no reason not to expose it.

decryptSmall :: PrivateKey -> ByteString -> IO (Either RSAError ByteString) Source #

Decrypt a ByteString of length less than or equal to the KeySize. Skips the symmetric encryption step. For the most part, this should be avoided, but there is no reason not to expose it.

Supported Key Sizes

data KeySize Source #

The various supported key sizes for the underlying RSA implementation

Instances

Instances details
Bounded KeySize Source # 
Instance details

Defined in Cropty

Enum KeySize Source # 
Instance details

Defined in Cropty

Eq KeySize Source # 
Instance details

Defined in Cropty

Methods

(==) :: KeySize -> KeySize -> Bool #

(/=) :: KeySize -> KeySize -> Bool #

Ord KeySize Source # 
Instance details

Defined in Cropty

keySizeInt :: KeySize -> Int Source #

Get the size of the key in the form of an Int

keySizeFromInt :: Int -> Maybe KeySize Source #

Get the size of a

Key generation

generatePrivateKeyWithPublicExponent :: Integer -> KeySize -> IO PrivateKey Source #

Generate a new PrivateKey of the given KeySize, providing the RSA public exponent as well.

Symmetric Encryption

newtype Key Source #

A key for symmetric (AEP) encryption

Constructors

Key 

Fields

Instances

Instances details
Eq Key Source # 
Instance details

Defined in Cropty

Methods

(==) :: Key -> Key -> Bool #

(/=) :: Key -> Key -> Bool #

Ord Key Source # 
Instance details

Defined in Cropty

Methods

compare :: Key -> Key -> Ordering #

(<) :: Key -> Key -> Bool #

(<=) :: Key -> Key -> Bool #

(>) :: Key -> Key -> Bool #

(>=) :: Key -> Key -> Bool #

max :: Key -> Key -> Key #

min :: Key -> Key -> Key #

Read Key Source # 
Instance details

Defined in Cropty

Show Key Source # 
Instance details

Defined in Cropty

Methods

showsPrec :: Int -> Key -> ShowS #

show :: Key -> String #

showList :: [Key] -> ShowS #

Generic Key Source # 
Instance details

Defined in Cropty

Associated Types

type Rep Key :: Type -> Type #

Methods

from :: Key -> Rep Key x #

to :: Rep Key x -> Key #

Binary Key Source # 
Instance details

Defined in Cropty

Methods

put :: Key -> Put #

get :: Get Key #

putList :: [Key] -> Put #

type Rep Key Source # 
Instance details

Defined in Cropty

type Rep Key = D1 ('MetaData "Key" "Cropty" "cropty-0.3.1.0-Kj3nrqpcf3M6FZNfZi8ZJC" 'True) (C1 ('MetaCons "Key" 'PrefixI 'True) (S1 ('MetaSel ('Just "keyBytes") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

generateKey :: IO Key Source #

Generate a new Key. It must have 32 bytes, because we are using AES256, and there are 8 bits in a byte. In other words: 32 * 8 = 256.

encryptSym :: Key -> ByteString -> Either SymEncryptionException ByteString Source #

Encrypt a ByteString such that anyone else who has the Key can decryptSym it later.

decryptSym :: Key -> ByteString -> Either SymDecryptionException ByteString Source #

Decrypt a ByteString which has been encryptSymed with the given Key.

Errors Re-Exported from Cryptonite

type RSAError = Error Source #

import qualified Crypto.PubKey.RSA.Types as RSA (Error (..))

data CryptoError #

Enumeration of all possible errors that can be found in this library

Instances

Instances details
Enum CryptoError 
Instance details

Defined in Crypto.Error.Types

Eq CryptoError 
Instance details

Defined in Crypto.Error.Types

Data CryptoError 
Instance details

Defined in Crypto.Error.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> CryptoError -> c CryptoError #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c CryptoError #

toConstr :: CryptoError -> Constr #

dataTypeOf :: CryptoError -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c CryptoError) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CryptoError) #

gmapT :: (forall b. Data b => b -> b) -> CryptoError -> CryptoError #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> CryptoError -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> CryptoError -> r #

gmapQ :: (forall d. Data d => d -> u) -> CryptoError -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> CryptoError -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> CryptoError -> m CryptoError #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> CryptoError -> m CryptoError #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> CryptoError -> m CryptoError #

Show CryptoError 
Instance details

Defined in Crypto.Error.Types

Exception CryptoError 
Instance details

Defined in Crypto.Error.Types