cropty (empty) → 0.1.0.0
raw patch · 7 files changed
+422/−0 lines, 7 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, cropty, cryptonite, hedgehog, unliftio
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- README.md +7/−0
- Setup.hs +2/−0
- cropty.cabal +40/−0
- src/Cropty.hs +288/−0
- test/Test.hs +60/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for cropty++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020 Samuel Schlesinger++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,7 @@+# Cropty++A little library for doing encryption using a combination of RSA and AEP, using the+[cryptonite](https://hackage.haskell.org/package/cryptonite) library for cryptography.++It is meant for use with very large files. I've tested it on a 6 Gigabyte file and it+works within seconds for all functions.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cropty.cabal view
@@ -0,0 +1,40 @@+cabal-version: 2.4++name: cropty+version: 0.1.0.0+synopsis: Encryption and decryption+description: Encryption and decryption.+homepage: https://github.com/SamuelSchlesinger/cropty+bug-reports: https://github.com/SamuelSchlesinger/cropty/issues+license: MIT+license-file: LICENSE+author: Samuel Schlesinger+maintainer: sgschlesinger@gmail.com+copyright: 2021 Samuel Schlesinger+category: Cryptography, Crypto+extra-source-files: CHANGELOG.md, README.md++source-repository head+ type: git + location: https://github.com/samuelschlesinger/cropty++library+ exposed-modules: Cropty+ build-depends:+ , base >=4.12 && < 5+ , bytestring >=0.10 && <1+ , cryptonite >=0.27+ , binary >=0.8+ hs-source-dirs: src+ default-language: Haskell2010++test-suite test-cropty+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Test.hs+ build-depends: base >= 4.12 && < 5,+ hedgehog >=1.0,+ unliftio >=0.2,+ cropty+ default-language: Haskell2010+ ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T"
+ src/Cropty.hs view
@@ -0,0 +1,288 @@+{- |+Name: Cropty+Description: A simplified interface to asymmetric and symmetric cryptography+License: MIT+Copyright: Samuel Schlesinger 2021 (c)+-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE LambdaCase #-}+module Cropty+ ( + -- * Asymmetric Encryption+ PrivateKey (PrivateKey, privateKey)+ , privateToPublic+ , PublicKey (PublicKey, publicKey)+ -- ** Efficient Encryption+ , Message (..)+ , encrypt+ , EncryptionException (..)+ , decrypt+ , DecryptionException (..)+ -- ** Digital Signatures+ , Signature (Signature, signatureBytes)+ , sign+ , verify+ -- ** Encrypt/Decrypt Small Strings+ , encryptSmall+ , decryptSmall+ -- ** Supported Key Sizes+ , KeySize (..)+ , keySizeInt+ , keySizeFromInt+ -- ** Key generation+ , generatePrivateKey+ , generatePrivateKeyWithPublicExponent+ -- * Symmetric Encryption+ , Key (Key, keyBytes)+ , encryptSym+ , SymEncryptionException (..)+ , decryptSym+ , SymDecryptionException (..)+ -- * Errors Re-Exported from Cryptonite+ , RSAError+ , CryptoError (..)+ ) where++import Data.ByteString (ByteString)+import GHC.Generics (Generic)+import Data.Binary (Binary(..))+import qualified Crypto.PubKey.RSA.Types (Error (..))+import Crypto.Error (CryptoError (..))+import Control.Exception (Exception, throwIO)+import qualified Crypto.Cipher.AES as AES+import qualified Crypto.Cipher.Types as Cipher+import qualified Crypto.Error as Error+import qualified Crypto.Hash.Algorithms as Hash+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.RSA.OAEP as RSA.OAEP+import qualified Crypto.PubKey.RSA.PSS as RSA.PSS+import qualified Crypto.Random as Random+import qualified Data.ByteString as ByteString++-- |+-- @import qualified Crypto.PubKey.RSA.Types as RSA (Error (..))@+type RSAError = Crypto.PubKey.RSA.Types.Error++-- | 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.+newtype PrivateKey = PrivateKey+ { privateKey :: RSA.PrivateKey }+ deriving (Show, Read, Eq)++instance Binary PrivateKey where+ put (PrivateKey p) = do+ put (PublicKey $ RSA.private_pub p)+ put (RSA.private_d p)+ put (RSA.private_p p)+ put (RSA.private_q p)+ put (RSA.private_dP p)+ put (RSA.private_dQ p)+ put (RSA.private_qinv p)+ get = PrivateKey <$>+ ( RSA.PrivateKey+ <$> (publicKey <$> get)+ <*> get+ <*> get+ <*> get+ <*> get+ <*> get+ <*> get+ )++instance Ord PrivateKey where+ compare (PrivateKey p) (PrivateKey p') = compare (PublicKey $ RSA.private_pub p) (PublicKey $ RSA.private_pub p')++-- | 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.+data PublicKey = PublicKey+ { publicKey :: RSA.PublicKey }+ deriving (Show, Read, Eq)++instance Binary PublicKey where+ put (PublicKey p) = do+ put (RSA.public_size p)+ put (RSA.public_n p)+ put (RSA.public_e p)+ get = PublicKey <$>+ ( RSA.PublicKey+ <$> get+ <*> get+ <*> get+ )++instance Ord PublicKey where+ compare (PublicKey p) (PublicKey p') =+ compare (RSA.public_size p) (RSA.public_size p')+ <> compare (RSA.public_n p) (RSA.public_n p')+ <> compare (RSA.public_e p) (RSA.public_e p')++-- | Get a 'PublicKey' which corresponds to the given 'PrivateKey'+privateToPublic :: PrivateKey -> PublicKey+privateToPublic = PublicKey . RSA.private_pub . privateKey++-- | The various supported key sizes for the underlying RSA implementation+data KeySize = KeySize256 | KeySize512 | KeySize1024 | KeySize2048 | KeySize4096+ deriving (Eq, Ord, Enum, Bounded)++-- | Get the size of the key in the form of an 'Int'+keySizeInt :: KeySize -> Int+keySizeInt k = 2 ^ (fromEnum k + 8)++-- | Get the size of a +keySizeFromInt :: Int -> Maybe KeySize+keySizeFromInt n+ | n == 256 = Just KeySize256+ | n == 512 = Just KeySize512+ | n == 1024 = Just KeySize1024+ | n == 2048 = Just KeySize2048+ | n == 4096 = Just KeySize4096 + | otherwise = Nothing++-- | Generate a new 'PrivateKey' of the given 'KeySize'+generatePrivateKey :: KeySize -> IO PrivateKey+generatePrivateKey = generatePrivateKeyWithPublicExponent 65537++-- | Generate a new 'PrivateKey' of the given 'KeySize', providing the RSA public exponent as well.+generatePrivateKeyWithPublicExponent :: Integer -> KeySize -> IO PrivateKey+generatePrivateKeyWithPublicExponent e n = (PrivateKey . snd) <$> RSA.generate (keySizeInt n) e++-- | 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.+encryptSmall :: PublicKey -> ByteString -> IO (Either RSAError ByteString)+encryptSmall (PublicKey pub) message =+ RSA.OAEP.encrypt (RSA.OAEP.defaultOAEPParams Hash.SHA512) pub message++-- | 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.+decryptSmall :: PrivateKey -> ByteString -> IO (Either RSAError ByteString)+decryptSmall (PrivateKey priv) message =+ RSA.OAEP.decryptSafer (RSA.OAEP.defaultOAEPParams Hash.SHA512) priv message++-- | A key for symmetric (AEP) encryption+newtype Key = Key { keyBytes :: ByteString }+ deriving (Eq, Ord, Show, Read, Generic, Binary)++-- | Generate a new 'Key'+generateKey :: IO Key+generateKey =+ Key <$> Random.getRandomBytes 32++data SymEncryptionException = SymEncryptionException'CryptoniteError CryptoError+ deriving Show++instance Exception SymEncryptionException++-- | Encrypt a 'ByteString' such that anyone else who has the 'Key' can+-- 'decryptSym' it later.+encryptSym :: Key -> ByteString -> Either SymEncryptionException ByteString+encryptSym key bs =+ case Cipher.cipherInit (keyBytes key) of+ Error.CryptoFailed e -> Left (SymEncryptionException'CryptoniteError e)+ Error.CryptoPassed (c :: AES.AES256) -> Right $ Cipher.ecbEncrypt c paddedMessage+ where+ paddingSize =+ 16 - (ByteString.length bs + 1) `mod` 16+ paddedMessage =+ ByteString.concat+ [ ByteString.singleton (fromIntegral paddingSize)+ , ByteString.replicate paddingSize 0+ , bs+ ]++data CroptyError =+ NotEncryptedByCropty+ deriving Show++instance Exception CroptyError++data SymDecryptionException = SymDecryptionException'CryptoniteError CryptoError | SymDecryptionException'CroptyError CroptyError+ deriving Show++instance Exception SymDecryptionException++-- | Decrypt a 'ByteString' which has been 'encryptSym'ed with the given 'Key'.+decryptSym :: Key -> ByteString -> Either SymDecryptionException ByteString+decryptSym key bs =+ case Cipher.cipherInit (keyBytes key) of+ Error.CryptoFailed e -> Left (SymDecryptionException'CryptoniteError e)+ Error.CryptoPassed (c :: AES.AES256) -> do+ let decryptedBytes = Cipher.ecbDecrypt c bs+ if ByteString.length decryptedBytes > 0 then+ let paddingSize = fromIntegral (ByteString.index decryptedBytes 0)+ in Right $ snd (ByteString.splitAt (paddingSize + 1) decryptedBytes)+ else Left $ SymDecryptionException'CroptyError NotEncryptedByCropty++-- | 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.+data Message = Message+ { encryptedKey :: ByteString+ , encryptedBytes :: ByteString+ } deriving (Show, Read, Generic, Binary)++-- | The sort of exception we might get during encryption.+data EncryptionException = EncryptionException RSAError+ deriving Show++instance Exception EncryptionException++-- | Encrypt a 'ByteString' for the given 'PublicKey', storing+-- the results into a 'Message'.+encrypt :: PublicKey -> ByteString -> IO Message+encrypt publicKey message = do+ key <- generateKey+ encryptSmall publicKey (keyBytes key) >>= \case+ Left rsaError -> throwIO $ EncryptionException rsaError+ Right encryptedKey -> Message encryptedKey <$> either throwIO pure (encryptSym key message) ++-- | The sort of exception we might get during decryption.+data DecryptionException = DecryptionException RSAError+ deriving Show++instance Exception DecryptionException++-- | Decrypt a 'Message' into a 'ByteString', the original message.+decrypt :: PrivateKey -> Message -> IO ByteString+decrypt privateKey Message{encryptedKey, encryptedBytes} = do+ decryptSmall privateKey encryptedKey >>= \case+ Left rsaError -> throwIO $ DecryptionException rsaError+ Right decryptedKey -> either throwIO pure (decryptSym (Key decryptedKey) encryptedBytes)++-- | The sort of exception we might get during signature.+data SignatureException = SignatureException RSAError+ deriving Show++instance Exception SignatureException++-- | 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.+newtype Signature = Signature+ { signatureBytes :: ByteString+ } deriving (Eq, Ord, Show, Read, Generic, Binary)++-- | Sign a message with your private key, producing a 'ByteString' that+-- others cannot fabricate for new messages.+sign :: PrivateKey -> ByteString -> IO Signature+sign (PrivateKey privateKey) bs =+ RSA.PSS.signSafer+ (RSA.PSS.defaultPSSParams Hash.SHA512)+ privateKey+ bs+ >>= either (throwIO . SignatureException) (pure . Signature)++-- | Verify the signature of a message.+verify :: PublicKey -> ByteString -> Signature -> Bool+verify (PublicKey pubKey) bs (Signature sig) =+ RSA.PSS.verify (RSA.PSS.defaultPSSParams Hash.SHA512) pubKey bs sig
+ test/Test.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE BlockArguments #-}+module Main where++import Cropty+import Control.Monad.IO.Class (liftIO)+import Hedgehog+import Hedgehog.Gen+import Hedgehog.Range+import Control.Monad (guard)++main :: IO ()+main = do+ keypairs <- sequence+ [ (\private -> (private, privateToPublic private)) <$> generatePrivateKey s+ | Just s <- keySizeFromInt <$> [256, 512]+ ]+ let+ nTests = 10+ roundTrip gen = withTests nTests $ property do+ (privateKey, publicKey) <- forAll (element keypairs)+ x <- forAll gen+ msg <- liftIO (encrypt publicKey x)+ y <- liftIO (decrypt privateKey msg)+ x === y+ signAndVerify gen = withTests nTests $ property do+ (privateKey, publicKey) <- forAll (element keypairs)+ x <- forAll gen+ sig <- liftIO (sign privateKey x)+ assert (verify publicKey x sig)+ guard =<< checkParallel (Group "Encryption/Decryption" [+ ("Encrypt/Decrypt UTF-8",+ roundTrip (utf8 (linearFrom 0 1000 10000) unicodeAll)+ )+ , ("Encrypt/Decrypt Bytes",+ roundTrip (bytes (linearFrom 0 1000 10000))+ )+ , ("Encrypt/Decrybt Trailing Zeros",+ roundTrip ((<>) <$> bytes (linearFrom 0 1000 10000) <*> pure "\0\0\0\0\0\0")+ )+ , ("Encrypt/Decrypt Leading Zeros",+ roundTrip ((<>) <$> pure "\0\0\0\0\0\0" <*> bytes (linearFrom 0 1000 10000))+ )+ ])+ guard =<< checkParallel (Group "Signing/Verification" [+ ("Sign/Verify UTF-8",+ signAndVerify (utf8 (linearFrom 0 1000 10000) unicodeAll)+ )+ , ("Sign/Verify Bytes",+ signAndVerify (bytes (linearFrom 0 1000 10000))+ )+ , ("Sign/Verify: Trailing Zeros",+ roundTrip ((<>) <$> bytes (linearFrom 0 1000 10000) <*> pure "\0\0\0\0\0\0")+ )+ , ("Sign/Verify: Leading Zeros",+ roundTrip ((<>) <$> pure "\0\0\0\0\0\0" <*> bytes (linearFrom 0 1000 10000))+ )+ ])+