Compare commits
3 Commits
509158793d
...
1d3f484337
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1d3f484337 | ||
|
|
1b2a8bdce6 | ||
|
|
1752d03fe7 |
@ -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
|
||||
|
||||
@ -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@
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user