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.Monoid
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as Lazy.ByteString
import GHC.TypeLits
import Control.Monad
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 (Maybe Int))
-> (ByteString -> m c)
-> CryptoIDKey
-> a
-> m (CryptoID namespace c)
encrypt pLength' encode' key plaintext = do
cID <- ByteString.encrypt key <=< (\str -> pad str =<< pLength' str) . Lazy.ByteString.toStrict $ encode plaintext
_ciphertext encode' cID
where
pad str pLength
| Just l <- pLength
, l' <= l = return $ str <> ByteString.replicate (l l') 0
| Just _ <- pLength = throwM $ CiphertextConversionFailed str
| otherwise = return str
where
l' = ByteString.length str
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 _ -> throwM DeserializationError
Right (rem, _, res)
| Lazy.ByteString.all (== 0) rem -> return res
| otherwise -> throwM InvalidNamespaceDetected