Cache.hs

{-# LANGUAGE LambdaCase #-}

{- |
Copyright   : (c) 2020-2021 Tim Emiola
SPDX-License-Identifier: BSD3
Maintainer  : Tim Emiola <adetokunbo@users.noreply.github.com>

Implements a cache for the demo service
-}
module TmpProc.Example1.Cache
  ( -- * Cache services
    deleteContact
  , loadContact
  , saveContact
  , runRedisAction

    -- * Redis location
  , Locator
  , defaultLoc
  )
where

import Control.Monad (void)
import Data.ByteString.Char8 (ByteString, pack, unpack)
import Database.Redis
  ( ConnectInfo
  , Redis
  , connect
  , defaultConnectInfo
  , get
  , runRedis
  , setex
  )
import System.TmpProc.Docker.Redis (del)
import TmpProc.Example1.Schema


-- | Specifies the @Redis@ instance to use as a cache .
type Locator = ConnectInfo


-- | A default for local development .
defaultLoc :: Locator
defaultLoc = defaultConnectInfo


runRedisAction :: Locator -> Redis a -> IO a
runRedisAction loc action = do
  connection <- connect loc
  runRedis connection action


saveContact :: Locator -> ContactID -> Contact -> IO ()
saveContact loc cid contact = runRedisAction loc $ void $ setex (toKey cid) 3600 (pack . show $ contact)


loadContact :: Locator -> ContactID -> IO (Maybe Contact)
loadContact loc cid = runRedisAction loc $ do
  (get $ toKey cid) >>= \case
    Right (Just contactString) -> return $ Just (read . unpack $ contactString)
    _ -> return Nothing


deleteContact :: Locator -> ContactID -> IO ()
deleteContact loc cid = do
  connection <- connect loc
  runRedis connection $ do
    _ <- del [pack . show $ cid]
    return ()


toKey :: ContactID -> ByteString
toKey = pack . show