Data.CryptoID.Poly → Data.CryptoID.Bytestring & Data.CryptoID.Poly
This commit is contained in:
Gregor Kleen
parent
1446fc6efb
commit
55f1382401
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
200
cryptoids/src/Data/CryptoID/ByteString.hs
Normal file
200
cryptoids/src/Data/CryptoID/ByteString.hs
Normal file
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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@
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user