diff --git a/cryptoids/changes.md b/cryptoids/changes.md index 8efc3c4..e74fd28 100644 --- a/cryptoids/changes.md +++ b/cryptoids/changes.md @@ -1,3 +1,7 @@ +# 0.1.0 + - Switch to using 'MonadThrow' instead of 'MonadError' + - Introduce 'readKeyFile' + # 0.0.0 First published version diff --git a/cryptoids/cryptoids.cabal b/cryptoids/cryptoids.cabal index dac240a..f443551 100644 --- a/cryptoids/cryptoids.cabal +++ b/cryptoids/cryptoids.cabal @@ -1,5 +1,5 @@ name: cryptoids -version: 0.0.0 +version: 0.1.0 synopsis: Reversable and secure encoding of object ids as a bytestring license: BSD3 license-file: LICENSE @@ -28,6 +28,8 @@ library , bytestring >=0.10.8.1 && <0.11 , binary >=0.8.3.0 && <0.9 , memory >=0.14.6 && <0.15 - , mtl >=2.2.1 && <2.3 + , exceptions >=0.8.3 && <0.9 + , filepath >=1.4.1.1 && <1.5 + , directory >=1.3.0.0 && <1.4 hs-source-dirs: src default-language: Haskell2010 diff --git a/cryptoids/src/Data/CryptoID/Poly.hs b/cryptoids/src/Data/CryptoID/Poly.hs index 40d9112..1925c84 100644 --- a/cryptoids/src/Data/CryptoID/Poly.hs +++ b/cryptoids/src/Data/CryptoID/Poly.hs @@ -16,7 +16,7 @@ where \(l\) is the length of the serialized payload. module Data.CryptoID.Poly ( CryptoID(..) , CryptoIDKey - , genKey + , genKey, readKeyFile , encrypt , decrypt , CryptoIDError(..) @@ -42,8 +42,10 @@ import Data.ByteArray (ByteArrayAccess) import qualified Data.ByteArray as ByteArray import Data.Foldable (asum) -import Control.Monad.Except +import Control.Monad.Catch (MonadThrow(..)) +import Control.Monad.IO.Class import Control.Exception +import System.IO.Error import Data.Typeable import GHC.TypeLits @@ -56,6 +58,9 @@ import Crypto.Error import Crypto.Random.Entropy +import System.Directory +import System.FilePath + -- | The symmetric cipher 'BlockCipher' this module uses type CryptoCipher = Blowfish @@ -92,7 +97,7 @@ instance Binary CryptoIDKey where -- that parses) getKey (KeySizeFixed n) = getByteString n getKey (KeySizeEnum ns) = asum [ getKey $ KeySizeFixed n | n <- sortOn Down ns ] - getKey (KeySizeRange min max) = getKey $ KeySizeEnum [max .. min] + getKey (KeySizeRange min max) = getKey $ KeySizeEnum [min .. max] -- | Error cases that can be encountered during 'encrypt' and 'decrypt' @@ -140,6 +145,21 @@ genKey = CryptoIDKey <$> liftIO (getEntropy 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 @@ -151,23 +171,23 @@ pad n (ByteArray.unpack -> src) = ByteString.pack $ src ++ replicate (l `mod` n) -- | Use 'CryptoHash' to generate a 'Digest' of the Symbol passed as proxy type namespace' :: forall proxy namespace m. - ( KnownSymbol namespace, MonadError CryptoIDError m + ( KnownSymbol namespace, MonadThrow m ) => proxy namespace -> m (IV CryptoCipher) namespace' p = case makeIV namespaceHash of - Nothing -> throwError . NamespaceHashIsWrongLength $ ByteArray.convert namespaceHash + 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 :: MonadError CryptoIDError m => CryptoFailable a -> m a -cryptoFailable = either (throwError . AlgorithmError) return . eitherCryptoError +cryptoFailable :: MonadThrow m => CryptoFailable a -> m a +cryptoFailable = either (throwM . AlgorithmError) return . eitherCryptoError -- | Encrypt an arbitrary serializable value encrypt :: forall m namespace. ( KnownSymbol namespace - , MonadError CryptoIDError m + , MonadThrow m ) => CryptoIDKey -> ByteString -> m (CryptoID namespace ByteString) encrypt (keyMaterial -> key) plaintext = do cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher) @@ -178,7 +198,7 @@ encrypt (keyMaterial -> key) plaintext = do -- | Decrypt an arbitrary serializable value decrypt :: forall m namespace. ( KnownSymbol namespace - , MonadError CryptoIDError m + , MonadThrow m ) => CryptoIDKey -> CryptoID namespace ByteString -> m ByteString decrypt (keyMaterial -> key) CryptoID{..} = do cipher <- cryptoFailable (cipherInit key :: CryptoFailable CryptoCipher) diff --git a/uuid-crypto/changes.md b/uuid-crypto/changes.md index fabf879..f9fc18a 100644 --- a/uuid-crypto/changes.md +++ b/uuid-crypto/changes.md @@ -1,3 +1,6 @@ +# 1.1.0 + - Switch to using 'MonadThrow' instead of 'MonadError' + # 1.0.0 First published version diff --git a/uuid-crypto/src/Data/UUID/Cryptographic.hs b/uuid-crypto/src/Data/UUID/Cryptographic.hs index 5376143..b60008b 100644 --- a/uuid-crypto/src/Data/UUID/Cryptographic.hs +++ b/uuid-crypto/src/Data/UUID/Cryptographic.hs @@ -39,7 +39,7 @@ import qualified Data.ByteString.Lazy as Lazy.ByteString import Data.ByteArray (ByteArrayAccess) import qualified Data.ByteArray as ByteArray -import Control.Monad.Except +import Control.Monad.Catch import GHC.TypeLits @@ -54,9 +54,9 @@ _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 :: (MonadError CryptoIDError m, ByteArrayAccess a) => Int -> a -> m ByteString +pad :: (MonadThrow m, ByteArrayAccess a) => Int -> a -> m ByteString pad n (ByteArray.unpack -> src) - | l > n = throwError CiphertextConversionFailed + | l > n = throwM CiphertextConversionFailed | otherwise = return . ByteString.pack $ src ++ replicate (n - l) 0 where l = length src @@ -71,14 +71,14 @@ pad n (ByteArray.unpack -> src) encrypt :: forall a m namespace. ( KnownSymbol namespace , Binary a - , MonadError CryptoIDError m + , 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 (throwError CiphertextConversionFailed) return . fromByteString . Lazy.ByteString.fromStrict + uuidConversion = maybe (throwM CiphertextConversionFailed) return . fromByteString . Lazy.ByteString.fromStrict -- | Decrypt an arbitrary serializable value @@ -89,14 +89,14 @@ encrypt key val = do decrypt :: forall a m namespace. ( KnownSymbol namespace , Binary a - , MonadError CryptoIDError m + , 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 -> throwError $ DeserializationError err + Left err -> throwM $ DeserializationError err Right (rem, _, res) | Lazy.ByteString.all (== 0) rem -> return res - | otherwise -> throwError InvalidNamespaceDetected + | otherwise -> throwM InvalidNamespaceDetected diff --git a/uuid-crypto/uuid-crypto.cabal b/uuid-crypto/uuid-crypto.cabal index 07ed069..080ce7b 100644 --- a/uuid-crypto/uuid-crypto.cabal +++ b/uuid-crypto/uuid-crypto.cabal @@ -1,5 +1,5 @@ name: uuid-crypto -version: 1.0.0 +version: 1.1.0 synopsis: Reversable and secure encoding of object ids as uuids license: BSD3 license-file: LICENSE @@ -28,13 +28,13 @@ library other-extensions: ScopedTypeVariables build-depends: base >=4.9 && <4.11 , cryptoids-types ==0.0.0 - , cryptoids ==0.0.0 + , cryptoids ==0.1.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 - , mtl >=2.2.1 && <2.3 + , exceptions >=0.8.3 && <0.9 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -fno-warn-name-shadowing