add modules from former cryptoids-class and cryptoids-types

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

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
+           )

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@
+
+

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