Compare commits

...

3 Commits

Author SHA1 Message Date
Sarah Vaupel
1d3f484337 remove unneeded imports 2025-07-14 12:20:17 +02:00
Sarah Vaupel
1b2a8bdce6 use Data.Kind.Type instead of * 2025-07-14 12:19:56 +02:00
Sarah Vaupel
1752d03fe7 fix ambiguous occurrences 2025-07-14 12:19:10 +02:00
4 changed files with 14 additions and 15 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,6 +11,8 @@ 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)
@ -18,18 +20,16 @@ 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 :: * -> *) where class MonadThrow m => MonadCrypto (m :: Type -> Type) where
type MonadCryptoKey m :: * type MonadCryptoKey m :: Type
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 :: *) (plaintext :: *) (m :: * -> *) where class MonadCrypto m => HasCryptoID (namespace :: Symbol) (ciphertext :: Type) (plaintext :: Type) (m :: Type -> Type) 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,11 +17,13 @@ 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 :: *) (plaintext :: *) :: Symbol type family CryptoIDNamespace (ciphertext :: Type) (plaintext :: Type) :: 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,13 +26,10 @@ 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
@ -76,14 +73,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 decode key cID = do decrypt dcode key cID = do
cID' <- _ciphertext decode cID cID' <- _ciphertext dcode 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