Copyright | Samuel Schlesinger 2021 (c) |
---|---|
License | MIT |
Safe Haskell | None |
Language | Haskell2010 |
Cropty
Description
Synopsis
- newtype PrivateKey = PrivateKey {}
- privateToPublic :: PrivateKey -> PublicKey
- data PublicKey = PublicKey {}
- data Message = Message {}
- encrypt :: PublicKey -> ByteString -> IO Message
- data EncryptionException = EncryptionException RSAError
- decrypt :: PrivateKey -> Message -> IO ByteString
- data DecryptionException = DecryptionException RSAError
- newtype Signature = Signature {}
- sign :: PrivateKey -> ByteString -> IO Signature
- verify :: PublicKey -> ByteString -> Signature -> Bool
- data Signed a
- signed :: Signed a -> a
- signedBy :: Signed a -> PublicKey
- signature :: Signed a -> Signature
- signedEncoded :: Signed a -> ByteString
- mkSigned :: Binary a => PrivateKey -> a -> IO (Signed a)
- verifySigned :: Signed a -> Bool
- encryptSmall :: PublicKey -> ByteString -> IO (Either RSAError ByteString)
- decryptSmall :: PrivateKey -> ByteString -> IO (Either RSAError ByteString)
- data KeySize
- keySizeInt :: KeySize -> Int
- keySizeFromInt :: Int -> Maybe KeySize
- generatePrivateKey :: KeySize -> IO PrivateKey
- generatePrivateKeyWithPublicExponent :: Integer -> KeySize -> IO PrivateKey
- newtype Key = Key {}
- generateKey :: IO Key
- encryptSym :: Key -> ByteString -> Either SymEncryptionException ByteString
- data SymEncryptionException = SymEncryptionException'CryptoniteError CryptoError
- decryptSym :: Key -> ByteString -> Either SymDecryptionException ByteString
- data SymDecryptionException
- type RSAError = Error
- data CryptoError
- = CryptoError_KeySizeInvalid
- | CryptoError_IvSizeInvalid
- | CryptoError_SeedSizeInvalid
- | CryptoError_AEADModeNotSupported
- | CryptoError_SecretKeySizeInvalid
- | CryptoError_SecretKeyStructureInvalid
- | CryptoError_PublicKeySizeInvalid
- | CryptoError_SharedSecretSizeInvalid
- | CryptoError_EcScalarOutOfBounds
- | CryptoError_PointSizeInvalid
- | CryptoError_PointFormatInvalid
- | CryptoError_PointFormatUnsupported
- | CryptoError_PointCoordinatesInvalid
- | CryptoError_ScalarMultiplicationInvalid
- | CryptoError_MacKeyInvalid
- | CryptoError_AuthenticationTagSizeInvalid
- | CryptoError_PrimeSizeInvalid
- | CryptoError_SaltTooSmall
- | CryptoError_OutputLengthTooSmall
- | CryptoError_OutputLengthTooBig
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 | |
Fields |
Instances
Eq PrivateKey Source # | |
Defined in Cropty | |
Ord PrivateKey Source # | |
Defined in Cropty Methods compare :: PrivateKey -> PrivateKey -> Ordering # (<) :: PrivateKey -> PrivateKey -> Bool # (<=) :: PrivateKey -> PrivateKey -> Bool # (>) :: PrivateKey -> PrivateKey -> Bool # (>=) :: PrivateKey -> PrivateKey -> Bool # max :: PrivateKey -> PrivateKey -> PrivateKey # min :: PrivateKey -> PrivateKey -> PrivateKey # | |
Read PrivateKey Source # | |
Defined in Cropty Methods readsPrec :: Int -> ReadS PrivateKey # readList :: ReadS [PrivateKey] # readPrec :: ReadPrec PrivateKey # readListPrec :: ReadPrec [PrivateKey] # | |
Show PrivateKey Source # | |
Defined in Cropty Methods showsPrec :: Int -> PrivateKey -> ShowS # show :: PrivateKey -> String # showList :: [PrivateKey] -> ShowS # | |
Binary PrivateKey Source # | |
Defined in Cropty |
privateToPublic :: PrivateKey -> PublicKey Source #
Get a PublicKey
which corresponds to the given PrivateKey
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.
Instances
Eq PublicKey Source # | |
Ord PublicKey Source # | |
Read PublicKey Source # | |
Show PublicKey Source # | |
Binary PublicKey Source # | |
Efficient Encryption
An message encrypt
ed for a specific PublicKey
. Contains
an encryptSmall
ed 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.
Constructors
Message | |
Fields |
Instances
Read Message Source # | |
Show Message Source # | |
Generic Message Source # | |
Binary Message Source # | |
type Rep Message Source # | |
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
.
data EncryptionException Source #
The sort of exception we might get during encryption.
Constructors
EncryptionException RSAError |
Instances
Show EncryptionException Source # | |
Defined in Cropty Methods showsPrec :: Int -> EncryptionException -> ShowS # show :: EncryptionException -> String # showList :: [EncryptionException] -> ShowS # | |
Exception EncryptionException Source # | |
Defined in Cropty Methods toException :: EncryptionException -> SomeException # fromException :: SomeException -> Maybe EncryptionException # |
decrypt :: PrivateKey -> Message -> IO ByteString Source #
Decrypt a Message
into a ByteString
, the original message.
data DecryptionException Source #
The sort of exception we might get during decryption.
Constructors
DecryptionException RSAError |
Instances
Show DecryptionException Source # | |
Defined in Cropty Methods showsPrec :: Int -> DecryptionException -> ShowS # show :: DecryptionException -> String # showList :: [DecryptionException] -> ShowS # | |
Exception DecryptionException Source # | |
Defined in Cropty Methods toException :: DecryptionException -> SomeException # fromException :: SomeException -> Maybe DecryptionException # |
Digital Signatures
The result of sign
ing 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 | |
Fields |
Instances
Eq Signature Source # | |
Ord Signature Source # | |
Read Signature Source # | |
Show Signature Source # | |
Generic Signature Source # | |
Binary Signature Source # | |
type Rep Signature Source # | |
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.
A convenient type in which to wrap signed things.
Instances
Eq (Signed a) Source # | |
Ord (Signed a) Source # | |
Defined in Cropty | |
Read a => Read (Signed a) Source # | |
Show a => Show (Signed a) Source # | |
Generic (Signed a) Source # | |
Binary a => Binary (Signed a) Source # | |
type Rep (Signed a) Source # | |
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)))) |
signedEncoded :: Signed a -> ByteString Source #
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
The various supported key sizes for the underlying RSA implementation
Constructors
KeySize256 | |
KeySize512 | |
KeySize1024 | |
KeySize2048 | |
KeySize4096 |
Instances
Bounded KeySize Source # | |
Enum KeySize Source # | |
Eq KeySize Source # | |
Ord KeySize Source # | |
Key generation
generatePrivateKey :: KeySize -> IO PrivateKey Source #
Generate a new PrivateKey
of the given KeySize
generatePrivateKeyWithPublicExponent :: Integer -> KeySize -> IO PrivateKey Source #
Generate a new PrivateKey
of the given KeySize
, providing the RSA public exponent as well.
Symmetric Encryption
A key for symmetric (AEP) encryption
Constructors
Key | |
Fields |
Instances
Eq Key Source # | |
Ord Key Source # | |
Read Key Source # | |
Show Key Source # | |
Generic Key Source # | |
Binary Key Source # | |
type Rep Key Source # | |
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.
data SymEncryptionException Source #
Constructors
SymEncryptionException'CryptoniteError CryptoError |
Instances
Show SymEncryptionException Source # | |
Defined in Cropty Methods showsPrec :: Int -> SymEncryptionException -> ShowS # show :: SymEncryptionException -> String # showList :: [SymEncryptionException] -> ShowS # | |
Exception SymEncryptionException Source # | |
Defined in Cropty |
decryptSym :: Key -> ByteString -> Either SymDecryptionException ByteString Source #
Decrypt a ByteString
which has been encryptSym
ed with the given Key
.
data SymDecryptionException Source #
Constructors
SymDecryptionException'CryptoniteError CryptoError | |
SymDecryptionException'CroptyError CroptyError |
Instances
Show SymDecryptionException Source # | |
Defined in Cropty Methods showsPrec :: Int -> SymDecryptionException -> ShowS # show :: SymDecryptionException -> String # showList :: [SymDecryptionException] -> ShowS # | |
Exception SymDecryptionException Source # | |
Defined in Cropty |
Errors Re-Exported from Cryptonite
data CryptoError #
Enumeration of all possible errors that can be found in this library
Constructors