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