module Data.CryptoID.Poly
( CryptoID(..)
, CryptoIDKey
, genKey, readKeyFile
, encrypt
, decrypt
, CryptoIDError(..)
, CryptoCipher, CryptoHash
) where
import Data.CryptoID
import Data.CryptoID.ByteString hiding (encrypt, decrypt)
import qualified Data.CryptoID.ByteString as ByteString (encrypt, decrypt)
import Data.Binary
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as Lazy.ByteString
import GHC.TypeLits
import Control.Monad.Catch (MonadThrow(..))
_ciphertext :: Functor m => (a -> m b) -> CryptoID n a -> m (CryptoID n b)
_ciphertext f (CryptoID x) = CryptoID <$> f x
encrypt :: forall a m c namespace.
( KnownSymbol namespace
, MonadThrow m
, Binary a
) => (ByteString -> m c) -> CryptoIDKey -> a -> m (CryptoID namespace c)
encrypt encode' key plaintext = do
cID <- ByteString.encrypt key . Lazy.ByteString.toStrict $ encode plaintext
_ciphertext encode' cID
decrypt :: forall a m c namespace.
( KnownSymbol namespace
, MonadThrow m
, Binary a
) => (c -> m ByteString) -> CryptoIDKey -> CryptoID namespace c -> m a
decrypt decode key cID = do
cID' <- _ciphertext decode cID
plaintext <- Lazy.ByteString.fromStrict <$> ByteString.decrypt key cID'
case decodeOrFail plaintext of
Left err -> throwM $ DeserializationError err
Right (rem, _, res)
| Lazy.ByteString.all (== 0) rem -> return res
| otherwise -> throwM InvalidNamespaceDetected