54 lines
2.2 KiB
Haskell
54 lines
2.2 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module CryptoID.Cached
|
|
( encrypt, decrypt
|
|
) where
|
|
|
|
import Import.NoModel
|
|
|
|
import qualified Data.Binary as Binary
|
|
|
|
import qualified Data.CryptoID.Class.ImplicitNamespace as I
|
|
|
|
|
|
newtype CryptoIDDecryption ciphertext plaintext = CryptoIDDecryption plaintext
|
|
newtype CryptoIDEncryption ciphertext plaintext = CryptoIDEncryption ciphertext
|
|
|
|
encrypt :: forall plaintext ciphertext m.
|
|
( I.HasCryptoID ciphertext plaintext (HandlerFor (HandlerSite m))
|
|
, Typeable plaintext, Typeable ciphertext
|
|
, Binary plaintext, Binary ciphertext
|
|
, MonadHandler m
|
|
)
|
|
=> plaintext -> m (I.CryptoID ciphertext plaintext)
|
|
encrypt plain = liftHandler $ do
|
|
(cachedEnc :: Maybe (CryptoIDEncryption ciphertext plaintext)) <- cacheByGet cacheKey
|
|
case cachedEnc of
|
|
Nothing -> do
|
|
cID@(I.CryptoID crypt) <- I.encrypt plain
|
|
cacheBySet cacheKey (CryptoIDEncryption crypt :: CryptoIDEncryption ciphertext plaintext)
|
|
cacheBySet (toStrict $ Binary.encode crypt) (CryptoIDDecryption plain :: CryptoIDDecryption ciphertext plaintext)
|
|
return cID
|
|
Just (CryptoIDEncryption crypt) -> return $ I.CryptoID crypt
|
|
where cacheKey = toStrict $ Binary.encode plain
|
|
|
|
decrypt :: forall plaintext ciphertext m.
|
|
( I.HasCryptoID ciphertext plaintext (HandlerFor (HandlerSite m))
|
|
, Typeable plaintext, Typeable ciphertext
|
|
, Binary plaintext, Binary ciphertext
|
|
, MonadHandler m
|
|
)
|
|
=> I.CryptoID ciphertext plaintext -> m plaintext
|
|
decrypt cID@(I.CryptoID crypt) = liftHandler $ do
|
|
(cachedDec :: Maybe (CryptoIDDecryption ciphertext plaintext)) <- cacheByGet cacheKey
|
|
case cachedDec of
|
|
Nothing -> do
|
|
plain <- I.decrypt cID
|
|
cacheBySet (toStrict $ Binary.encode plain) (CryptoIDEncryption crypt :: CryptoIDEncryption ciphertext plaintext)
|
|
cacheBySet cacheKey (CryptoIDDecryption plain :: CryptoIDDecryption ciphertext plaintext)
|
|
return plain
|
|
Just (CryptoIDDecryption plain) -> return plain
|
|
where cacheKey = toStrict $ Binary.encode crypt
|