diff --git a/cryptoids-types/cryptoids-types.cabal b/cryptoids-types/cryptoids-types.cabal index d0761dc..6553ee0 100644 --- a/cryptoids-types/cryptoids-types.cabal +++ b/cryptoids-types/cryptoids-types.cabal @@ -27,3 +27,4 @@ library , http-api-data >=0.3.7.1 && <0.4 hs-source-dirs: src default-language: Haskell2010 + ghc-options: -Wall -fno-warn-name-shadowing diff --git a/cryptoids/changes.md b/cryptoids/changes.md index 04578ea..7800016 100644 --- a/cryptoids/changes.md +++ b/cryptoids/changes.md @@ -1,3 +1,7 @@ +# 0.2.0.0 + - Rename 'Data.CryptoID.Poly' to 'Data.CryptoID.ByteString' + - Introduce 'Data.CryptoID.Poly' doing actual serialization + # 0.1.0.1 - Correct mistakes in the documentation diff --git a/cryptoids/cryptoids.cabal b/cryptoids/cryptoids.cabal index 77009d1..744868b 100644 --- a/cryptoids/cryptoids.cabal +++ b/cryptoids/cryptoids.cabal @@ -1,5 +1,5 @@ name: cryptoids -version: 0.1.0.1 +version: 0.2.0.0 synopsis: Reversable and secure encoding of object ids as a bytestring license: BSD3 license-file: LICENSE @@ -16,6 +16,7 @@ source-repository head library exposed-modules: Data.CryptoID.Poly + , Data.CryptoID.ByteString default-extensions: RankNTypes , DataKinds , GeneralizedNewtypeDeriving @@ -33,3 +34,4 @@ library , directory >=1.3.0.0 && <1.4 hs-source-dirs: src default-language: Haskell2010 + ghc-options: -Wall -fno-warn-name-shadowing diff --git a/cryptoids/src/Data/CryptoID/ByteString.hs b/cryptoids/src/Data/CryptoID/ByteString.hs new file mode 100644 index 0000000..0e00a23 --- /dev/null +++ b/cryptoids/src/Data/CryptoID/ByteString.hs @@ -0,0 +1,200 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +{-| +Description: Encryption of bytestrings using a type level nonce for determinism +License: BSD3 + +Given a strict 'ByteString' we compute a cryptographic hash of the associated +namespace (carried as a phantom type of kind 'Symbol'). +The payload is then encrypted using the symmetric cipher in CBC mode using the +hashed namespace as an initialization vector (IV). + +The probability of detecting a namespace mismatch is thus the density of valid +payloads within all 'ByteString's of the correct length. +-} +module Data.CryptoID.ByteString + ( CryptoID(..) + , CryptoIDKey + , genKey, readKeyFile + , encrypt + , decrypt + , CryptoIDError(..) + , CryptoCipher, CryptoHash + ) where + +import Data.CryptoID + +import Data.Binary +import Data.Binary.Put +import Data.Binary.Get + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as ByteString.Char + +import qualified Data.ByteString.Lazy as Lazy (ByteString) + +import Data.List (sortOn) +import Data.Ord (Down(..)) + +import Data.ByteArray (ByteArrayAccess) +import qualified Data.ByteArray as ByteArray + +import Data.Foldable (asum) +import Control.Monad.Catch (MonadThrow(..)) +import Control.Monad.IO.Class +import Control.Monad +import Control.Exception +import System.IO.Error + +import Data.Typeable +import GHC.TypeLits + +import Crypto.Cipher.Types +import Crypto.Cipher.Blowfish (Blowfish) +import Crypto.Hash (hash, Digest) +import Crypto.Hash.Algorithms (SHAKE128) +import Crypto.Error + +import Crypto.Random.Entropy + +import System.Directory +import System.FilePath + + +-- | The symmetric cipher 'BlockCipher' this module uses +type CryptoCipher = Blowfish +-- | The cryptographic 'HashAlgorithm' this module uses +-- +-- We expect the block size of 'CryptoCipher' to be exactly the size of the +-- 'Digest' generated by 'CryptoHash' (since a 'Digest' is used as an 'IV'). +-- +-- Violation of this expectation causes runtime errors. +type CryptoHash = SHAKE128 64 + + +-- | This newtype ensures only keys of the correct length can be created +-- +-- Use 'genKey' to securely generate keys. +-- +-- Use the 'Binary' instance to save and restore values of 'CryptoIDKey' across +-- executions. +newtype CryptoIDKey = CryptoIDKey { keyMaterial :: ByteString } + deriving (Typeable, ByteArrayAccess) + +-- | Does not actually show any key material +instance Show CryptoIDKey where + show = show . typeOf + +instance Binary CryptoIDKey where + put = putByteString . keyMaterial + get = CryptoIDKey <$> getKey (cipherKeySize cipher) + where + cipher :: CryptoCipher + cipher = undefined + + -- Try key sizes from large to small ('Get' commits to the first branch + -- that parses) + getKey (KeySizeFixed n) = getByteString n + getKey (KeySizeEnum ns) = asum [ getKey $ KeySizeFixed n | n <- sortOn Down ns ] + getKey (KeySizeRange min max) = getKey $ KeySizeEnum [min .. max] + + +-- | Error cases that can be encountered during 'encrypt' and 'decrypt' +data CryptoIDError + = AlgorithmError CryptoError + -- ^ One of the underlying cryptographic algorithms + -- ('CryptoHash' or 'CryptoCipher') failed. + | NamespaceHashIsWrongLength ByteString + -- ^ The length of the digest produced by 'CryptoHash' does + -- not match the block size of 'CryptoCipher'. + -- + -- The offending digest is included. + -- + -- This error should not occur and is included primarily + -- for sake of totality. + | CiphertextConversionFailed + -- ^ The produced 'ByteString' is the wrong length for conversion into a + -- ciphertext. + | DeserializationError (Lazy.ByteString, ByteOffset, String) + -- ^ The plaintext obtained by decrypting a ciphertext with the given + -- 'CryptoIDKey' in the context of the @namespace@ could not be + -- deserialized into a value of the expected @payload@-type. + -- + -- This is expected behaviour if the @namespace@ or @payload@-type does not + -- match the ones used during 'encrypt'ion or if the 'ciphertext' was + -- tempered with. + | InvalidNamespaceDetected + -- ^ We have determined that, allthough deserializion succeded, the + -- ciphertext was likely modified during transit or created using a + -- different namespace. + deriving (Show, Eq) + +instance Exception CryptoIDError + +-- | Securely generate a new key using system entropy +-- +-- When 'CryptoCipher' accepts keys of varying lengths this function generates a +-- key of the largest accepted size. +genKey :: MonadIO m => m CryptoIDKey +genKey = CryptoIDKey <$> liftIO (getEntropy keySize) + where + keySize' = cipherKeySize (undefined :: CryptoCipher) + + keySize + | KeySizeFixed n <- keySize' = n + | KeySizeEnum ns <- keySize' = maximum ns + | KeySizeRange _ max <- keySize' = max + +-- | Try to read a 'CryptoIDKey' from a file. +-- If the file does not exist, securely generate a key (using 'genKey') and +-- save it to the file. +readKeyFile :: MonadIO m => FilePath -> m CryptoIDKey +readKeyFile keyFile = liftIO $ decodeFile keyFile `catch` generateInstead + where + generateInstead e + | isDoesNotExistError e = do + createDirectoryIfMissing True $ takeDirectory keyFile + key <- genKey + encodeFile keyFile key + return key + | otherwise = throw e + + +-- | Use 'CryptoHash' to generate a 'Digest' of the Symbol passed as proxy type +namespace' :: forall proxy namespace m. + ( KnownSymbol namespace, MonadThrow m + ) => proxy namespace -> m (IV CryptoCipher) +namespace' p = case makeIV namespaceHash of + Nothing -> throwM . NamespaceHashIsWrongLength $ ByteArray.convert namespaceHash + Just iv -> return iv + where + namespaceHash :: Digest CryptoHash + namespaceHash = hash . ByteString.Char.pack $ symbolVal p + +-- | Wrap failure of one of the cryptographic algorithms as a 'CryptoIDError' +cryptoFailable :: MonadThrow m => CryptoFailable a -> m a +cryptoFailable = either (throwM . AlgorithmError) return . eitherCryptoError + +-- | Encrypt a serialized value +encrypt :: forall m namespace. + ( KnownSymbol namespace + , MonadThrow m + ) => CryptoIDKey -> ByteString -> m (CryptoID namespace ByteString) +encrypt (keyMaterial -> key) plaintext = do + cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher) + namespace <- namespace' (Proxy :: Proxy namespace) + when (ByteArray.length plaintext `mod` blockSize cipher /= 0) $ + throwM CiphertextConversionFailed + return . CryptoID $ cbcEncrypt cipher namespace plaintext + + +-- | Decrypt a serialized value +decrypt :: forall m namespace. + ( KnownSymbol namespace + , MonadThrow m + ) => CryptoIDKey -> CryptoID namespace ByteString -> m ByteString +decrypt (keyMaterial -> key) CryptoID{..} = do + cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher) + namespace <- namespace' (Proxy :: Proxy namespace) + return $ cbcDecrypt cipher namespace ciphertext + diff --git a/cryptoids/src/Data/CryptoID/Poly.hs b/cryptoids/src/Data/CryptoID/Poly.hs index 0d0f9ea..13c3848 100644 --- a/cryptoids/src/Data/CryptoID/Poly.hs +++ b/cryptoids/src/Data/CryptoID/Poly.hs @@ -4,13 +4,18 @@ Description: Encryption of bytestrings using a type level nonce for determinism License: BSD3 -Given a strict 'ByteString' we compute a cryptographic hash of the associated -namespace (carried as a phantom type of kind 'Symbol'). -The payload is then encrypted using the symmetric cipher in CBC mode using the -hashed namespace as an initialization vector (IV). +Given a value of an arbitrary serializable type (like 'Int') we perform +serialization and compute a cryptographic hash of the associated namespace +(carried as a phantom type of kind 'Symbol'). +The serializedpayload is then encrypted using the symmetric cipher in CBC mode +using the hashed namespace as an initialization vector (IV). -The probability of detecting a namespace mismatch is thus the density of valid -payloads within all 'ByteString's of the correct length. +Since the serialized payload is padded such that its length is an integer +multiple of the block size we can detect namespace mismatches by checking that +all bytes expected to have been inserted during padding are nil. + +The probability of detecting a namespace mismatch is thus \(1 - 2^{l \ +\text{mod} \ 64}\) where \(l\) is the length of the serialized payload in bits. -} module Data.CryptoID.Poly ( CryptoID(..) @@ -23,184 +28,46 @@ module Data.CryptoID.Poly ) where import Data.CryptoID +import Data.CryptoID.ByteString hiding (encrypt, decrypt) +import qualified Data.CryptoID.ByteString as ByteString (encrypt, decrypt) import Data.Binary -import Data.Binary.Put -import Data.Binary.Get import Data.ByteString (ByteString) -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Char8 as ByteString.Char +import qualified Data.ByteString.Lazy as Lazy.ByteString -import qualified Data.ByteString.Lazy as Lazy (ByteString) - -import Data.List (sortOn) -import Data.Ord (Down(..)) - -import Data.ByteArray (ByteArrayAccess) -import qualified Data.ByteArray as ByteArray - -import Data.Foldable (asum) -import Control.Monad.Catch (MonadThrow(..)) -import Control.Monad.IO.Class -import Control.Exception -import System.IO.Error - -import Data.Typeable import GHC.TypeLits -import Crypto.Cipher.Types -import Crypto.Cipher.Blowfish (Blowfish) -import Crypto.Hash (hash, Digest) -import Crypto.Hash.Algorithms (SHAKE128) -import Crypto.Error - -import Crypto.Random.Entropy - -import System.Directory -import System.FilePath - - --- | The symmetric cipher 'BlockCipher' this module uses -type CryptoCipher = Blowfish --- | The cryptographic 'HashAlgorithm' this module uses --- --- We expect the block size of 'CryptoCipher' to be exactly the size of the --- 'Digest' generated by 'CryptoHash' (since a 'Digest' is used as an 'IV'). --- --- Violation of this expectation causes runtime errors. -type CryptoHash = SHAKE128 64 +import Control.Monad.Catch (MonadThrow(..)) --- | This newtype ensures only keys of the correct length can be created --- --- Use 'genKey' to securely generate keys. --- --- Use the 'Binary' instance to save and restore values of 'CryptoIDKey' across --- executions. -newtype CryptoIDKey = CryptoIDKey { keyMaterial :: ByteString } - deriving (Typeable, ByteArrayAccess) - --- | Does not actually show any key material -instance Show CryptoIDKey where - show = show . typeOf - -instance Binary CryptoIDKey where - put = putByteString . keyMaterial - get = CryptoIDKey <$> getKey (cipherKeySize cipher) - where - cipher :: CryptoCipher - cipher = undefined - - -- Try key sizes from large to small ('Get' commits to the first branch - -- that parses) - getKey (KeySizeFixed n) = getByteString n - getKey (KeySizeEnum ns) = asum [ getKey $ KeySizeFixed n | n <- sortOn Down ns ] - getKey (KeySizeRange min max) = getKey $ KeySizeEnum [min .. max] - - --- | Error cases that can be encountered during 'encrypt' and 'decrypt' -data CryptoIDError - = AlgorithmError CryptoError - -- ^ One of the underlying cryptographic algorithms - -- ('CryptoHash' or 'CryptoCipher') failed. - | NamespaceHashIsWrongLength ByteString - -- ^ The length of the digest produced by 'CryptoHash' does - -- not match the block size of 'CryptoCipher'. - -- - -- The offending digest is included. - -- - -- This error should not occur and is included primarily - -- for sake of totality. - | CiphertextConversionFailed - -- ^ The produced 'ByteString' is the wrong length for conversion into a - -- ciphertext. - | DeserializationError (Lazy.ByteString, ByteOffset, String) - -- ^ The plaintext obtained by decrypting a ciphertext with the given - -- 'CryptoIDKey' in the context of the @namespace@ could not be - -- deserialized into a value of the expected @payload@-type. - -- - -- This is expected behaviour if the @namespace@ or @payload@-type does not - -- match the ones used during 'encrypt'ion or if the 'ciphertext' was - -- tempered with. - | InvalidNamespaceDetected - -- ^ We have determined that, allthough deserializion succeded, the - -- ciphertext was likely modified during transit or created using a - -- different namespace. - deriving (Show, Eq) - -instance Exception CryptoIDError - --- | Securely generate a new key using system entropy --- --- When 'CryptoCipher' accepts keys of varying lengths this function generates a --- key of the largest accepted size. -genKey :: MonadIO m => m CryptoIDKey -genKey = CryptoIDKey <$> liftIO (getEntropy keySize) - where - keySize' = cipherKeySize (undefined :: CryptoCipher) - - keySize - | KeySizeFixed n <- keySize' = n - | KeySizeEnum ns <- keySize' = maximum ns - | KeySizeRange _ max <- keySize' = max - --- | Try to read a 'CryptoIDKey' from a file. --- If the file does not exist, securely generate a key (using 'genKey') and --- save it to the file. -readKeyFile :: MonadIO m => FilePath -> m CryptoIDKey -readKeyFile keyFile = liftIO $ decodeFile keyFile `catch` generateInstead - where - generateInstead e - | isDoesNotExistError e = do - createDirectoryIfMissing True $ takeDirectory keyFile - key <- genKey - encodeFile keyFile key - return key - | otherwise = throw e +_ciphertext :: Functor m => (a -> m b) -> CryptoID n a -> m (CryptoID n b) +_ciphertext f (CryptoID x) = CryptoID <$> f x - --- | @pad err size src@ appends null bytes to @src@ until it has length that is --- a multiple of @size@. -pad :: ByteArrayAccess a => Int -> a -> ByteString -pad n (ByteArray.unpack -> src) = ByteString.pack $ src ++ replicate (l `mod` n) 0 - where - l = length src - --- | Use 'CryptoHash' to generate a 'Digest' of the Symbol passed as proxy type -namespace' :: forall proxy namespace m. - ( KnownSymbol namespace, MonadThrow m - ) => proxy namespace -> m (IV CryptoCipher) -namespace' p = case makeIV namespaceHash of - Nothing -> throwM . NamespaceHashIsWrongLength $ ByteArray.convert namespaceHash - Just iv -> return iv - where - namespaceHash :: Digest CryptoHash - namespaceHash = hash . ByteString.Char.pack $ symbolVal p - --- | Wrap failure of one of the cryptographic algorithms as a 'CryptoIDError' -cryptoFailable :: MonadThrow m => CryptoFailable a -> m a -cryptoFailable = either (throwM . AlgorithmError) return . eitherCryptoError - -- | Encrypt a serialized value -encrypt :: forall m namespace. +encrypt :: forall a m c namespace. ( KnownSymbol namespace , MonadThrow m - ) => CryptoIDKey -> ByteString -> m (CryptoID namespace ByteString) -encrypt (keyMaterial -> key) plaintext = do - cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher) - namespace <- namespace' (Proxy :: Proxy namespace) - return . CryptoID . cbcEncrypt cipher namespace $ pad (blockSize cipher) plaintext + , Binary a + ) => (ByteString -> m c) -> CryptoIDKey -> a -> m (CryptoID namespace c) +encrypt encode' key plaintext = do + cID <- ByteString.encrypt key . Lazy.ByteString.toStrict $ encode plaintext + _ciphertext encode' cID -- | Decrypt a serialized value -decrypt :: forall m namespace. +decrypt :: forall a m c namespace. ( KnownSymbol namespace , MonadThrow m - ) => CryptoIDKey -> CryptoID namespace ByteString -> m ByteString -decrypt (keyMaterial -> key) CryptoID{..} = do - cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher) - namespace <- namespace' (Proxy :: Proxy namespace) - return $ cbcDecrypt cipher namespace ciphertext + , Binary a + ) => (c -> m ByteString) -> CryptoIDKey -> CryptoID namespace c -> m a +decrypt decode key cID = do + cID' <- _ciphertext decode cID + plaintext <- Lazy.ByteString.fromStrict <$> ByteString.decrypt key cID' + case decodeOrFail plaintext of + Left err -> throwM $ DeserializationError err + Right (rem, _, res) + | Lazy.ByteString.all (== 0) rem -> return res + | otherwise -> throwM InvalidNamespaceDetected diff --git a/uuid-crypto/changes.md b/uuid-crypto/changes.md index 0da6699..6541beb 100644 --- a/uuid-crypto/changes.md +++ b/uuid-crypto/changes.md @@ -1,3 +1,6 @@ +# 1.1.1.0 + - Switch to using the new 'Data.CryptoID.Poly' + # 1.1.0.1 - Update version constraint on @cryptoids@ diff --git a/uuid-crypto/src/Data/UUID/Cryptographic.hs b/uuid-crypto/src/Data/UUID/Cryptographic.hs index b60008b..8c15def 100644 --- a/uuid-crypto/src/Data/UUID/Cryptographic.hs +++ b/uuid-crypto/src/Data/UUID/Cryptographic.hs @@ -31,14 +31,8 @@ import qualified Data.CryptoID.Poly as Poly (encrypt, decrypt) import Data.UUID (UUID, toByteString, fromByteString) import Data.Binary -import Data.ByteString (ByteString) -import qualified Data.ByteString as ByteString - import qualified Data.ByteString.Lazy as Lazy.ByteString -import Data.ByteArray (ByteArrayAccess) -import qualified Data.ByteArray as ByteArray - import Control.Monad.Catch import GHC.TypeLits @@ -47,20 +41,6 @@ import GHC.TypeLits type CryptoUUID (namespace :: Symbol) = CryptoID namespace UUID -_ciphertext :: Functor m => (a -> m b) -> CryptoID n a -> m (CryptoID n b) -_ciphertext f (CryptoID x) = CryptoID <$> f x - - --- | @pad err size src@ appends null bytes to @src@ until it has length @size@. --- --- If @src@ is already longer than @size@ @err@ is thrown instead. -pad :: (MonadThrow m, ByteArrayAccess a) => Int -> a -> m ByteString -pad n (ByteArray.unpack -> src) - | l > n = throwM CiphertextConversionFailed - | otherwise = return . ByteString.pack $ src ++ replicate (n - l) 0 - where - l = length src - -- | Encrypt an arbitrary serializable value -- -- We only expect to fail if the given value is not serialized in such a fashion @@ -73,12 +53,7 @@ encrypt :: forall a m namespace. , Binary a , MonadThrow m ) => CryptoIDKey -> a -> m (CryptoUUID namespace) -encrypt key val = do - plaintext <- pad 16 . Lazy.ByteString.toStrict $ encode val - - _ciphertext uuidConversion =<< Poly.encrypt key plaintext - where - uuidConversion = maybe (throwM CiphertextConversionFailed) return . fromByteString . Lazy.ByteString.fromStrict +encrypt = Poly.encrypt $ maybe (throwM CiphertextConversionFailed) return . fromByteString . Lazy.ByteString.fromStrict -- | Decrypt an arbitrary serializable value @@ -91,12 +66,9 @@ decrypt :: forall a m namespace. , Binary a , MonadThrow m ) => CryptoIDKey -> CryptoUUID namespace -> m a -decrypt key cId = do - cId' <- _ciphertext (return . Lazy.ByteString.toStrict . toByteString) cId - plaintext <- Lazy.ByteString.fromStrict <$> Poly.decrypt key cId' - - case decodeOrFail plaintext of - Left err -> throwM $ DeserializationError err - Right (rem, _, res) - | Lazy.ByteString.all (== 0) rem -> return res - | otherwise -> throwM InvalidNamespaceDetected +decrypt = Poly.decrypt $ check . decodeOrFail . toByteString + where + check (Left err) = throwM $ DeserializationError err + check (Right (rem, _, res)) + | Lazy.ByteString.all (== 0) rem = return res + | otherwise = throwM InvalidNamespaceDetected diff --git a/uuid-crypto/uuid-crypto.cabal b/uuid-crypto/uuid-crypto.cabal index 5dcabf3..8950b56 100644 --- a/uuid-crypto/uuid-crypto.cabal +++ b/uuid-crypto/uuid-crypto.cabal @@ -1,5 +1,5 @@ name: uuid-crypto -version: 1.1.0.1 +version: 1.1.1.0 synopsis: Reversable and secure encoding of object ids as uuids license: BSD3 license-file: LICENSE @@ -28,11 +28,9 @@ library other-extensions: ScopedTypeVariables build-depends: base >=4.9 && <4.11 , cryptoids-types ==0.0.0 - , cryptoids ==0.1.0.* + , cryptoids ==0.2.0.* , uuid >=1.3.13 && <1.4 - , cryptonite >=0.23 && <0.25 , binary >=0.8.3.0 && <0.9 - , memory >=0.14.6 && <0.15 , bytestring >=0.10.8.1 && <0.11 , exceptions >=0.8.3 && <0.9 hs-source-dirs: src