module Freckle.App.Memcached
( Cachable (..)
, caching
, cachingAs
, cachingAsJSON
, cachingAsCBOR
, module Freckle.App.Memcached.Client
, module Freckle.App.Memcached.CacheKey
, module Freckle.App.Memcached.CacheTTL
, module Freckle.App.Memcached.MD5
) where
import Freckle.App.Prelude
import Blammo.Logging
import Codec.Serialise (Serialise, deserialiseOrFail, serialise)
import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Freckle.App.Exception (annotatedExceptionMessage)
import Freckle.App.Memcached.CacheKey
import Freckle.App.Memcached.CacheTTL
import Freckle.App.Memcached.Client (HasMemcachedClient (..))
import qualified Freckle.App.Memcached.Client as Memcached
import Freckle.App.Memcached.MD5
import Freckle.App.OpenTelemetry
class Cachable a where
toCachable :: a -> ByteString
fromCachable :: ByteString -> Either String a
instance Cachable ByteString where
toCachable :: ByteString -> ByteString
toCachable = forall a. a -> a
id
fromCachable :: ByteString -> Either String ByteString
fromCachable = forall a b. b -> Either a b
Right
instance Cachable BSL.ByteString where
toCachable :: ByteString -> ByteString
toCachable = ByteString -> ByteString
BSL.toStrict
fromCachable :: ByteString -> Either String ByteString
fromCachable = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict
instance Cachable Text where
toCachable :: Text -> ByteString
toCachable = Text -> ByteString
encodeUtf8
fromCachable :: ByteString -> Either String Text
fromCachable = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode
data CachingError
= CacheGetError SomeException
| CacheSetError SomeException
| CacheDeserializeError String
deriving stock (Int -> CachingError -> ShowS
[CachingError] -> ShowS
CachingError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CachingError] -> ShowS
$cshowList :: [CachingError] -> ShowS
show :: CachingError -> String
$cshow :: CachingError -> String
showsPrec :: Int -> CachingError -> ShowS
$cshowsPrec :: Int -> CachingError -> ShowS
Show)
instance Exception CachingError where
displayException :: CachingError -> String
displayException = \case
CacheGetError SomeException
ex -> String
"Unable to get: " forall a. Semigroup a => a -> a -> a
<> forall e. Exception e => e -> String
displayException SomeException
ex
CacheSetError SomeException
ex -> String
"Unable to set: " forall a. Semigroup a => a -> a -> a
<> forall e. Exception e => e -> String
displayException SomeException
ex
CacheDeserializeError String
err -> String
"Unable to deserialize: " forall a. Semigroup a => a -> a -> a
<> String
err
warnOnCachingError :: (MonadUnliftIO m, MonadLogger m) => a -> m a -> m a
warnOnCachingError :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
a -> m a -> m a
warnOnCachingError a
val =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
(Exception e, MonadUnliftIO m, HasCallStack) =>
m a -> (e -> m a) -> m a
catch forall a b. (a -> b) -> a -> b
$
(a
val forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Text -> Message -> m ()
logWarnNS Text
"caching"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ex. Exception ex => AnnotatedException ex -> Message
annotatedExceptionMessage @CachingError
caching
:: ( MonadUnliftIO m
, MonadLogger m
, MonadTracer m
, MonadReader env m
, HasMemcachedClient env
, Cachable a
, HasCallStack
)
=> CacheKey
-> CacheTTL
-> m a
-> m a
caching :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadTracer m, MonadReader env m,
HasMemcachedClient env, Cachable a, HasCallStack) =>
CacheKey -> CacheTTL -> m a -> m a
caching = forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadTracer m, MonadReader env m,
HasMemcachedClient env, HasCallStack) =>
(ByteString -> Either String a)
-> (a -> ByteString) -> CacheKey -> CacheTTL -> m a -> m a
cachingAs forall a. Cachable a => ByteString -> Either String a
fromCachable forall a. Cachable a => a -> ByteString
toCachable
cachingAs
:: ( MonadUnliftIO m
, MonadLogger m
, MonadTracer m
, MonadReader env m
, HasMemcachedClient env
, HasCallStack
)
=> (ByteString -> Either String a)
-> (a -> ByteString)
-> CacheKey
-> CacheTTL
-> m a
-> m a
cachingAs :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadTracer m, MonadReader env m,
HasMemcachedClient env, HasCallStack) =>
(ByteString -> Either String a)
-> (a -> ByteString) -> CacheKey -> CacheTTL -> m a -> m a
cachingAs ByteString -> Either String a
from a -> ByteString
to CacheKey
key CacheTTL
ttl m a
f = do
Maybe a
mCached <- forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
a -> m a -> m a
warnOnCachingError forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ByteString -> m a
cacheDeserialize forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Maybe ByteString)
cacheGet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
store forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
mCached
where
store :: m a
store = do
a
a <- m a
f
a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
a -> m a -> m a
warnOnCachingError () (a -> m ()
cacheSet a
a)
cacheGet :: m (Maybe ByteString)
cacheGet = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
(Exception e, MonadUnliftIO m, HasCallStack) =>
m a -> (e -> m a) -> m a
catch (forall e (m :: * -> *) a.
(Exception e, MonadIO m, HasCallStack) =>
e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> CachingError
CacheGetError) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadUnliftIO m, MonadTracer m, MonadReader env m,
HasMemcachedClient env) =>
CacheKey -> m (Maybe ByteString)
Memcached.get CacheKey
key
cacheSet :: a -> m ()
cacheSet a
a = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
(Exception e, MonadUnliftIO m, HasCallStack) =>
m a -> (e -> m a) -> m a
catch (forall e (m :: * -> *) a.
(Exception e, MonadIO m, HasCallStack) =>
e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> CachingError
CacheSetError) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadUnliftIO m, MonadTracer m, MonadReader env m,
HasMemcachedClient env) =>
CacheKey -> ByteString -> CacheTTL -> m ()
Memcached.set CacheKey
key (a -> ByteString
to a
a) CacheTTL
ttl
cacheDeserialize :: ByteString -> m a
cacheDeserialize = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a.
(Exception e, MonadIO m, HasCallStack) =>
e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CachingError
CacheDeserializeError) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
from
cachingAsJSON
:: ( MonadUnliftIO m
, MonadLogger m
, MonadTracer m
, MonadReader env m
, HasMemcachedClient env
, FromJSON a
, ToJSON a
, HasCallStack
)
=> CacheKey
-> CacheTTL
-> m a
-> m a
cachingAsJSON :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadTracer m, MonadReader env m,
HasMemcachedClient env, FromJSON a, ToJSON a, HasCallStack) =>
CacheKey -> CacheTTL -> m a -> m a
cachingAsJSON = forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadTracer m, MonadReader env m,
HasMemcachedClient env, HasCallStack) =>
(ByteString -> Either String a)
-> (a -> ByteString) -> CacheKey -> CacheTTL -> m a -> m a
cachingAs forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict forall a. ToJSON a => a -> ByteString
encodeStrict
cachingAsCBOR
:: ( MonadUnliftIO m
, MonadLogger m
, MonadTracer m
, MonadReader env m
, HasMemcachedClient env
, Serialise a
, HasCallStack
)
=> CacheKey
-> CacheTTL
-> m a
-> m a
cachingAsCBOR :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadTracer m, MonadReader env m,
HasMemcachedClient env, Serialise a, HasCallStack) =>
CacheKey -> CacheTTL -> m a -> m a
cachingAsCBOR =
forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadTracer m, MonadReader env m,
HasMemcachedClient env, HasCallStack) =>
(ByteString -> Either String a)
-> (a -> ByteString) -> CacheKey -> CacheTTL -> m a -> m a
cachingAs
(forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict)
(ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => a -> ByteString
serialise)
encodeStrict :: ToJSON a => a -> ByteString
encodeStrict :: forall a. ToJSON a => a -> ByteString
encodeStrict = ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode