Data.CryptoID.Poly → Data.CryptoID.Bytestring & Data.CryptoID.Poly

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

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
 

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

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
+

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
+Given a value of an arbitrary serializable type (like 'Int') we perform
-namespace (carried as a phantom type of kind 'Symbol').
+serialization and compute a cryptographic hash of the associated namespace
-The payload is then encrypted using the symmetric cipher in CBC mode using the
+(carried as a phantom type of kind 'Symbol').
-hashed namespace as an initialization vector (IV).
+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
+Since the serialized payload is padded such that its length is an integer
-payloads within all 'ByteString's of the correct length.
+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.Lazy as Lazy.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.Exception
-import System.IO.Error
-
-import Data.Typeable
 import GHC.TypeLits
 
-import Crypto.Cipher.Types
+import Control.Monad.Catch (MonadThrow(..))
-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
+_ciphertext :: Functor m => (a -> m b) -> CryptoID n a -> m (CryptoID n b)
---
+_ciphertext f (CryptoID x) = CryptoID <$> f x
--- 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
 
   
-  
--- | @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)
+           , Binary a
-encrypt (keyMaterial -> key) plaintext = do
+           ) => (ByteString -> m c) -> CryptoIDKey -> a -> m (CryptoID namespace c)
-  cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher)
+encrypt encode' key plaintext = do
-  namespace <- namespace' (Proxy :: Proxy namespace)
+  cID <- ByteString.encrypt key . Lazy.ByteString.toStrict $ encode plaintext
-  return . CryptoID . cbcEncrypt cipher namespace $ pad (blockSize cipher) 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
+           , Binary a
-decrypt (keyMaterial -> key) CryptoID{..} = do
+           ) => (c -> m ByteString) -> CryptoIDKey -> CryptoID namespace c -> m a
-  cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher)
+decrypt decode key cID = do
-  namespace <- namespace' (Proxy :: Proxy namespace)
+  cID' <- _ciphertext decode cID
-  return $ cbcDecrypt cipher namespace ciphertext
+  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

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@
 

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
+encrypt = Poly.encrypt $ maybe (throwM CiphertextConversionFailed) return . fromByteString . Lazy.ByteString.fromStrict
-  plaintext <- pad 16 . Lazy.ByteString.toStrict $ encode val
-  
-  _ciphertext uuidConversion =<< Poly.encrypt key plaintext
-    where
-      uuidConversion = 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
+decrypt = Poly.decrypt $ check . decodeOrFail . toByteString
-  cId' <- _ciphertext (return . Lazy.ByteString.toStrict . toByteString) cId
+  where
-  plaintext <- Lazy.ByteString.fromStrict <$> Poly.decrypt key cId'
+    check (Left err) = throwM $ DeserializationError err
-
+    check (Right (rem, _, res))
-  case decodeOrFail plaintext of
+      | Lazy.ByteString.all (== 0) rem = return res
-    Left err -> throwM $ DeserializationError err
+      | otherwise = throwM InvalidNamespaceDetected
-    Right (rem, _, res)
-      | Lazy.ByteString.all (== 0) rem -> return res
-      | otherwise -> throwM InvalidNamespaceDetected

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