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
  deriving (Typeable)
newtype CryptoIDEncryption ciphertext plaintext = CryptoIDEncryption ciphertext
  deriving (Typeable)

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