Compare commits

..

No commits in common. "1d3f4843377664f1679f2a18ca3160a0d02b8b1b" and "509158793d2f60144d768feaeec49a40540bae8f" have entirely different histories.

4 changed files with 15 additions and 14 deletions

View File

@ -106,7 +106,7 @@ instance Binary CryptoIDKey where
-- that parses) -- that parses)
getKey (KeySizeFixed n) = getByteString n getKey (KeySizeFixed n) = getByteString n
getKey (KeySizeEnum ns) = asum [ getKey $ KeySizeFixed n | n <- sortOn Down ns ] getKey (KeySizeEnum ns) = asum [ getKey $ KeySizeFixed n | n <- sortOn Down ns ]
getKey (KeySizeRange min' max') = getKey $ KeySizeEnum [min' .. max'] getKey (KeySizeRange min max) = getKey $ KeySizeEnum [min .. max]
-- | Error cases that can be encountered during 'encrypt' and 'decrypt' -- | Error cases that can be encountered during 'encrypt' and 'decrypt'
@ -169,7 +169,7 @@ genKey = CryptoIDKey <$> liftIO (getEntropy keySize)
keySize keySize
| KeySizeFixed n <- keySize' = n | KeySizeFixed n <- keySize' = n
| KeySizeEnum ns <- keySize' = maximum ns | KeySizeEnum ns <- keySize' = maximum ns
| KeySizeRange _ max' <- keySize' = max' | KeySizeRange _ max <- keySize' = max
-- | Try to read a 'CryptoIDKey' from a file. -- | Try to read a 'CryptoIDKey' from a file.
-- If the file does not exist, securely generate a key (using 'genKey') and -- If the file does not exist, securely generate a key (using 'genKey') and

View File

@ -11,8 +11,6 @@ module Data.CryptoID.Class
import Data.CryptoID (CryptoID) import Data.CryptoID (CryptoID)
import Data.Kind
import GHC.TypeLits (Symbol) import GHC.TypeLits (Symbol)
import Control.Monad.Catch (MonadThrow) import Control.Monad.Catch (MonadThrow)
@ -20,16 +18,18 @@ import Control.Monad.Catch (MonadThrow)
-- | Class of monads granting reader access to a key and allowing for failure during cryptographic operations -- | Class of monads granting reader access to a key and allowing for failure during cryptographic operations
-- --
-- This formulation is weaker than @MonadReader key@ (from mtl) in that it does not require @local@. -- This formulation is weaker than @MonadReader key@ (from mtl) in that it does not require @local@.
class MonadThrow m => MonadCrypto (m :: Type -> Type) where class MonadThrow m => MonadCrypto (m :: * -> *) where
type MonadCryptoKey m :: Type type MonadCryptoKey m :: *
cryptoIDKey :: (MonadCryptoKey m -> m a) -> m a cryptoIDKey :: (MonadCryptoKey m -> m a) -> m a
-- | Multiparameter typeclass of @(namespace, ciphertext, plaintext, monad)@ tuples which allow for cryptographic operations on 'CryptoID's with appropriate @namespace@, @plaintext@, and @ciphertext@, utilising the state of @monad@ -- | Multiparameter typeclass of @(namespace, ciphertext, plaintext, monad)@ tuples which allow for cryptographic operations on 'CryptoID's with appropriate @namespace@, @plaintext@, and @ciphertext@, utilising the state of @monad@
-- --
-- Instances of this typeclass are usually universally quantified over (at least) @namespace@, and @m@ -- Instances of this typeclass are usually universally quantified over (at least) @namespace@, and @m@
class MonadCrypto m => HasCryptoID (namespace :: Symbol) (ciphertext :: Type) (plaintext :: Type) (m :: Type -> Type) where class MonadCrypto m => HasCryptoID (namespace :: Symbol) (ciphertext :: *) (plaintext :: *) (m :: * -> *) where
encrypt :: plaintext -> m (CryptoID namespace ciphertext) encrypt :: plaintext -> m (CryptoID namespace ciphertext)
-- ^ Encrypt a @plaintext@ in a fashion dependent on the @namespace@ and desired @ciphertext@-type retrieving the key from and throwing errors into @m@ -- ^ Encrypt a @plaintext@ in a fashion dependent on the @namespace@ and desired @ciphertext@-type retrieving the key from and throwing errors into @m@
decrypt :: CryptoID namespace ciphertext -> m plaintext decrypt :: CryptoID namespace ciphertext -> m plaintext
-- ^ Encrypt a @ciphertext@ in a fashion dependent on the @namespace@ and desired @plaintext@-type retrieving the key from and throwing errors into @m@ -- ^ Encrypt a @ciphertext@ in a fashion dependent on the @namespace@ and desired @plaintext@-type retrieving the key from and throwing errors into @m@

View File

@ -17,13 +17,11 @@ module Data.CryptoID.Class.ImplicitNamespace
import qualified Data.CryptoID.Class as E import qualified Data.CryptoID.Class as E
import qualified Data.CryptoID as E import qualified Data.CryptoID as E
import Data.Kind
import GHC.TypeLits (Symbol) import GHC.TypeLits (Symbol)
-- | Type family of @namespace@s associated to certain @plaintext@-types (parameterized over @ciphertext@ for completeness) -- | Type family of @namespace@s associated to certain @plaintext@-types (parameterized over @ciphertext@ for completeness)
type family CryptoIDNamespace (ciphertext :: Type) (plaintext :: Type) :: Symbol type family CryptoIDNamespace (ciphertext :: *) (plaintext :: *) :: Symbol
-- | 'E.HasCryptoID' reformulated to utilize 'CryptoIDNamespace' -- | 'E.HasCryptoID' reformulated to utilize 'CryptoIDNamespace'
type HasCryptoID ciphertext plaintext = E.HasCryptoID (CryptoIDNamespace ciphertext plaintext) ciphertext plaintext type HasCryptoID ciphertext plaintext = E.HasCryptoID (CryptoIDNamespace ciphertext plaintext) ciphertext plaintext

View File

@ -26,10 +26,13 @@ module Data.CryptoID.Poly
import Data.CryptoID.ByteString hiding (encrypt, decrypt) import Data.CryptoID.ByteString hiding (encrypt, decrypt)
import qualified Data.CryptoID.ByteString as ByteString (encrypt, decrypt) import qualified Data.CryptoID.ByteString as ByteString (encrypt, decrypt)
import Data.CryptoID.Class (HasCryptoID)
import qualified Data.CryptoID.Class as Class (HasCryptoID(..)) import qualified Data.CryptoID.Class as Class (HasCryptoID(..))
import Data.Binary import Data.Binary
import Data.Monoid
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as Lazy.ByteString import qualified Data.ByteString.Lazy as Lazy.ByteString
@ -73,14 +76,14 @@ decrypt :: forall a m c namespace.
, MonadThrow m , MonadThrow m
, Binary a , Binary a
) => (c -> m ByteString) -> CryptoIDKey -> CryptoID namespace c -> m a ) => (c -> m ByteString) -> CryptoIDKey -> CryptoID namespace c -> m a
decrypt dcode key cID = do decrypt decode key cID = do
cID' <- _ciphertext dcode cID cID' <- _ciphertext decode cID
plaintext <- Lazy.ByteString.fromStrict <$> ByteString.decrypt key cID' plaintext <- Lazy.ByteString.fromStrict <$> ByteString.decrypt key cID'
case decodeOrFail plaintext of case decodeOrFail plaintext of
Left _ -> throwM DeserializationError Left _ -> throwM DeserializationError
Right (rem', _, res) Right (rem, _, res)
| Lazy.ByteString.all (== 0) rem' -> return res | Lazy.ByteString.all (== 0) rem -> return res
| otherwise -> throwM InvalidNamespaceDetected | otherwise -> throwM InvalidNamespaceDetected
instance ( MonadCrypto m instance ( MonadCrypto m