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)
getKey (KeySizeFixed n) = getByteString n
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'
@ -169,7 +169,7 @@ genKey = CryptoIDKey <$> liftIO (getEntropy keySize)
keySize
| KeySizeFixed n <- keySize' = n
| KeySizeEnum ns <- keySize' = maximum ns
| KeySizeRange _ max <- keySize' = max
| 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

View File

@ -11,6 +11,8 @@ module Data.CryptoID.Class
import Data.CryptoID (CryptoID)
import Data.Kind
import GHC.TypeLits (Symbol)
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
--
-- This formulation is weaker than @MonadReader key@ (from mtl) in that it does not require @local@.
class MonadThrow m => MonadCrypto (m :: * -> *) where
type MonadCryptoKey m :: *
class MonadThrow m => MonadCrypto (m :: Type -> Type) where
type MonadCryptoKey m :: Type
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@
--
-- 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 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
-- ^ 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 as E
import Data.Kind
import GHC.TypeLits (Symbol)
-- | 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'
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 qualified Data.CryptoID.ByteString as ByteString (encrypt, decrypt)
import Data.CryptoID.Class (HasCryptoID)
import qualified Data.CryptoID.Class as Class (HasCryptoID(..))
import Data.Binary
import Data.Monoid
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as Lazy.ByteString
@ -76,14 +73,14 @@ decrypt :: forall a m c namespace.
, MonadThrow m
, Binary a
) => (c -> m ByteString) -> CryptoIDKey -> CryptoID namespace c -> m a
decrypt decode key cID = do
cID' <- _ciphertext decode cID
decrypt dcode key cID = do
cID' <- _ciphertext dcode cID
plaintext <- Lazy.ByteString.fromStrict <$> ByteString.decrypt key cID'
case decodeOrFail plaintext of
Left _ -> throwM DeserializationError
Right (rem, _, res)
| Lazy.ByteString.all (== 0) rem -> return res
Right (rem', _, res)
| Lazy.ByteString.all (== 0) rem' -> return res
| otherwise -> throwM InvalidNamespaceDetected
instance ( MonadCrypto m