diff --git a/cryptoids.cabal b/cryptoids.cabal index 6653797..0f6f2e2 100644 --- a/cryptoids.cabal +++ b/cryptoids.cabal @@ -17,6 +17,9 @@ source-repository head library exposed-modules: + Data.CryptoID + Data.CryptoID.Class + Data.CryptoID.Class.ImplicitNamespace Data.CryptoID.Poly Data.CryptoID.Poly.ImplicitNamespace Data.CryptoID.ByteString diff --git a/src/Data/CryptoID.hs b/src/Data/CryptoID.hs new file mode 100644 index 0000000..9bc67da --- /dev/null +++ b/src/Data/CryptoID.hs @@ -0,0 +1,28 @@ +module Data.CryptoID + ( CryptoID(..) + ) where + +import GHC.Generics (Generic) +import Data.Typeable (Typeable) +import Data.Data (Data) +import GHC.TypeLits (Symbol) + +import Data.Binary (Binary) +import Foreign.Storable (Storable) + +import Web.PathPieces (PathPiece) +import Web.HttpApiData (ToHttpApiData, FromHttpApiData) + +import Control.DeepSeq (NFData) +import Data.Aeson (ToJSON, ToJSONKey, FromJSON, FromJSONKey) + +import Data.Hashable (Hashable) + +newtype CryptoID (namespace :: Symbol) a = CryptoID { ciphertext :: a } + deriving ( Eq, Ord + , Read, Show + , Binary, Storable, NFData, Hashable + , Data, Typeable, Generic + , PathPiece, ToHttpApiData, FromHttpApiData + , ToJSON, ToJSONKey, FromJSON, FromJSONKey + ) diff --git a/src/Data/CryptoID/Class.hs b/src/Data/CryptoID/Class.hs new file mode 100644 index 0000000..37fcb71 --- /dev/null +++ b/src/Data/CryptoID/Class.hs @@ -0,0 +1,35 @@ +{-| +Description: Typeclass based interface to 'cryptoids' +License: BSD3 + +Polymorphic functions to perform cryptographic operations on 'CryptoID's in a monadic context +-} +module Data.CryptoID.Class + ( MonadCrypto(..) + , HasCryptoID(..) + ) where + +import Data.CryptoID (CryptoID) + +import GHC.TypeLits (Symbol) + +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 :: * + 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 + 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@ + + diff --git a/src/Data/CryptoID/Class/ImplicitNamespace.hs b/src/Data/CryptoID/Class/ImplicitNamespace.hs new file mode 100644 index 0000000..da82863 --- /dev/null +++ b/src/Data/CryptoID/Class/ImplicitNamespace.hs @@ -0,0 +1,39 @@ +{-| +Description: 'cryptoids' with implied namespaces +License: BSD3 + +When unambiguous it can be convenient to automatically infer the namespace based on the plaintext type. + +Consider using newtype wrappers in order to do so. +-} +module Data.CryptoID.Class.ImplicitNamespace + ( E.MonadCrypto(..) + , CryptoIDNamespace + , HasCryptoID + , CryptoID, pattern E.CryptoID, E.ciphertext + , encrypt, decrypt + ) where + +import qualified Data.CryptoID.Class as E +import qualified Data.CryptoID as E + +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 + +-- | 'E.HasCryptoID' reformulated to utilize 'CryptoIDNamespace' +type HasCryptoID ciphertext plaintext = E.HasCryptoID (CryptoIDNamespace ciphertext plaintext) ciphertext plaintext + +-- | 'E.CryptoID' reformulated to utilize 'CryptoIDNamespace' +type CryptoID ciphertext plaintext = E.CryptoID (CryptoIDNamespace ciphertext plaintext) ciphertext + + +encrypt :: HasCryptoID ciphertext plaintext m => plaintext -> m (CryptoID ciphertext plaintext) +-- ^ Specialised version of 'encrypt' for when @(plaintext, ciphertext)@ uniquely determines the namespace +encrypt = E.encrypt + +decrypt :: HasCryptoID ciphertext plaintext m => CryptoID ciphertext plaintext -> m plaintext +-- ^ Specialised version of 'decrypt' for when @(plaintext, ciphertext)@ uniquely determines the namespace +decrypt = E.decrypt