diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for cropty + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cropty.cabal b/cropty.cabal new file mode 100644 --- /dev/null +++ b/cropty.cabal @@ -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" diff --git a/src/Cropty.hs b/src/Cropty.hs new file mode 100644 --- /dev/null +++ b/src/Cropty.hs @@ -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 diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -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)) + ) + ]) +