freckle-app-1.10.8.0: tests/Freckle/App/MemcachedSpec.hs

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Freckle.App.MemcachedSpec
  ( spec
  ) where

import Freckle.App.Test

import Blammo.Logging.LogSettings
import Blammo.Logging.Logger
import Control.Lens (lens, to, (^?))
import Data.Aeson (Value (..))
import Data.Aeson.Lens
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Freckle.App.Env as Env
import Freckle.App.Memcached
import Freckle.App.Memcached.Client (MemcachedClient, withMemcachedClient)
import qualified Freckle.App.Memcached.Client as Memcached
import Freckle.App.Memcached.Servers
import Freckle.App.OpenTelemetry

data ExampleValue
  = A
  | B
  | C
  deriving stock (Eq, Show)

instance Cachable ExampleValue where
  toCachable = \case
    A -> "A"
    B -> "Broken"
    C -> "C"

  fromCachable = \case
    "A" -> Right A
    "B" -> Right B
    "C" -> Right C
    x -> Left $ "invalid: " <> show x

data App = App
  { appMemcachedClient :: MemcachedClient
  , appLogger :: Logger
  , appTracer :: Tracer
  }

instance HasMemcachedClient App where
  memcachedClientL =
    lens appMemcachedClient $ \x y -> x {appMemcachedClient = y}

instance HasLogger App where
  loggerL = lens appLogger $ \x y -> x {appLogger = y}

instance HasTracer App where
  tracerL = lens appTracer $ \x y -> x {appTracer = y}

loadApp :: (App -> IO a) -> IO a
loadApp f = do
  servers <-
    Env.parse id $
      Env.var
        (Env.eitherReader readMemcachedServers)
        "MEMCACHED_SERVERS"
        (Env.def defaultMemcachedServers)
  appLogger <- newTestLogger defaultLogSettings
  withTracerProvider $ \tp -> do
    let appTracer = makeTracer tp "freckle-app" tracerOptions
    withMemcachedClient servers $ \appMemcachedClient -> do
      f App {..}

spec :: Spec
spec = withApp loadApp $ do
  describe "caching" $ do
    it "caches the given action by key using Cachable" $ appExample $ do
      k <- cacheKeyThrow "A"

      val <- caching k (cacheTTL 5) $ pure A
      mbs <- Memcached.get k

      val `shouldBe` A
      mbs `shouldBe` Just "A"

    it "logs, but doesn't fail, on deserialization errors" $ appExample $ do
      k <- cacheKeyThrow "B"

      val0 <- caching k (cacheTTL 5) $ pure B -- set
      val1 <- caching k (cacheTTL 5) $ pure B -- get will fail
      mbs <- Memcached.get k

      val0 `shouldBe` B
      val1 `shouldBe` B
      mbs `shouldBe` Just "Broken"

      msgs <- getLoggedMessagesLenient
      let Just LoggedMessage {..} = NE.last <$> NE.nonEmpty msgs
      Object loggedMessageMeta ^? key "error" . key "message" . _String
        `shouldBe` Just "Unable to deserialize: invalid: \"Broken\""

      -- This assertion is far too brittle, but can be useful to un-comment if
      -- you intend to work on this logic specifically
      -- Object loggedMessageMeta ^? key "error" . key "stack" . _String . to T.lines
      --   `shouldBe` Just
      --     [ "CallStack (from HasCallStack):"
      --     , "  throwM, called at library/Freckle/App/Memcached.hs:121:30 in freckle-app-1.10.8.0-1ebuZKUCQVI9sAWTLATGfO:Freckle.App.Memcached"
      --     , "  cachingAs, called at library/Freckle/App/Memcached.hs:92:11 in freckle-app-1.10.8.0-1ebuZKUCQVI9sAWTLATGfO:Freckle.App.Memcached"
      --     , "  caching, called at tests/Freckle/App/MemcachedSpec.hs:87:15 in main:Freckle.App.MemcachedSpec"
      --     ]
      Object loggedMessageMeta
        ^? key "error" . key "stack" . _String . to T.lines
        `shouldSatisfy` maybe False (not . null)