upstream Freckle.Memcached from megarepo/backend/entities (#123)

freckle · Oct 18, 2023 · d1cd456 · d1cd456
1 parent f92e28b
commit d1cd456
Show file tree

Hide file tree

Showing 6 changed files with 60 additions and 2 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,6 +1,12 @@
-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.10.1.0...main)
+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.10.2.0...main)
 
-## [v1.10.0.1](https://github.com/freckle/freckle-app/compare/v1.10.0.0...v1.10.1.0)
+## [v1.10.2.0](https://github.com/freckle/freckle-app/compare/v1.10.1.0...v1.10.2.0)
+
+- Add module `Freckle.App.Memcached.MD5`
+- Add `fiveMinuteTTL` to module `Freckle.App.Memcached.CacheTTL`
+- Add `cachingAsCBOR` to module `Freckle.App.Memcached`
+
+## [v1.10.1.1](https://github.com/freckle/freckle-app/compare/v1.10.0.0...v1.10.1.0)
 
 - Use `withTraceIdContext` in `Freckle.App.Kafka.Consumer.runConsumer`, ensuring
   all logging contains the `trace_id` in context.

diff --git a/freckle-app.cabal b/freckle-app.cabal
@@ -51,6 +51,7 @@ library
       Freckle.App.Memcached.CacheKey
       Freckle.App.Memcached.CacheTTL
       Freckle.App.Memcached.Client
+      Freckle.App.Memcached.MD5
       Freckle.App.Memcached.Servers
       Freckle.App.OpenTelemetry
       Freckle.App.Prelude
@@ -155,12 +156,14 @@ library
     , persistent-postgresql
     , postgresql-simple
     , primitive
+    , pureMD5
     , resource-pool >=0.4.0.0
     , resourcet
     , retry >=0.8.1.0
     , safe
     , scientist
     , semigroupoids
+    , serialise
     , template-haskell
     , text
     , time

diff --git a/library/Freckle/App/Memcached.hs b/library/Freckle/App/Memcached.hs
@@ -13,16 +13,19 @@ module Freckle.App.Memcached
   , caching
   , cachingAs
   , cachingAsJSON
+  , cachingAsCBOR
 
     -- * Re-exports
   , 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
@@ -31,6 +34,7 @@ import Data.Text.Encoding.Error (lenientDecode)
 import Freckle.App.Memcached.CacheKey
 import Freckle.App.Memcached.CacheTTL
 import Freckle.App.Memcached.Client (HasMemcachedClient (..))
+import Freckle.App.Memcached.MD5
 import qualified Freckle.App.Memcached.Client as Memcached
 import UnliftIO.Exception (Exception (..), handleAny)
 
@@ -110,6 +114,23 @@ cachingAsJSON
   -> m a
 cachingAsJSON = cachingAs eitherDecodeStrict encodeStrict
 
+-- | Cache data in memcached in CBOR format
+cachingAsCBOR
+  :: ( MonadUnliftIO m
+     , MonadLogger m
+     , MonadReader env m
+     , HasMemcachedClient env
+     , Serialise a
+     )
+  => CacheKey
+  -> CacheTTL
+  -> m a
+  -> m a
+cachingAsCBOR =
+  cachingAs
+    (first show . deserialiseOrFail . BSL.fromStrict)
+    (BSL.toStrict . serialise)
+
 handleCachingError
   :: (MonadUnliftIO m, MonadLogger m) => a -> Text -> m a -> m a
 handleCachingError value action = handleAny $ \ex -> do

diff --git a/library/Freckle/App/Memcached/CacheTTL.hs b/library/Freckle/App/Memcached/CacheTTL.hs
@@ -2,6 +2,7 @@ module Freckle.App.Memcached.CacheTTL
   ( CacheTTL
   , cacheTTL
   , fromCacheTTL
+  , fiveMinuteTTL
   ) where
 
 import Freckle.App.Prelude
@@ -27,3 +28,7 @@ fromCacheTTL (CacheTTL i)
 
   maxWord :: Word32
   maxWord = maxBound
+
+-- | Standard 5 minute time to live
+fiveMinuteTTL :: CacheTTL
+fiveMinuteTTL = cacheTTL $ 5 * 60
diff --git a/library/Freckle/App/Memcached/MD5.hs b/library/Freckle/App/Memcached/MD5.hs
@@ -0,0 +1,21 @@
+module Freckle.App.Memcached.MD5
+  ( md5CacheKey
+  , md5Key
+  , md5Text
+  ) where
+
+import Freckle.App.Prelude
+
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.Digest.Pure.MD5 as Digest
+import Freckle.App.Memcached.CacheKey
+
+md5CacheKey :: Show a => a -> CacheKey
+md5CacheKey = either (error "md5 is always cacheable") id . cacheKey . md5Key
+
+-- | Pack any showable into an md5 encoded text
+md5Key :: Show a => a -> Text
+md5Key = md5Text . pack . show
+
+md5Text :: Text -> Text
+md5Text = pack . show . Digest.md5 . BSL.fromStrict . encodeUtf8
diff --git a/package.yaml b/package.yaml
@@ -121,12 +121,14 @@ library:
     - persistent-postgresql
     - postgresql-simple
     - primitive
+    - pureMD5
     - resource-pool >= 0.4.0.0 # defaultPoolConfig, etc
     - resourcet
     - retry >= 0.8.1.0 # retryingDynamic
     - safe
     - scientist
     - semigroupoids
+    - serialise
     - template-haskell
     - text
     - time