{-# 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 (pack, unpack, ByteString)
import           Database.Redis

import           TmpProc.Example1.Schema

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

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

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

saveContact :: Locator -> ContactID -> Contact -> IO ()
saveContact :: Locator -> ContactID -> Contact -> IO ()
saveContact Locator
loc ContactID
cid Contact
contact = forall a. Locator -> Redis a -> IO a
runRedisAction Locator
loc forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> ByteString -> m (f Status)
setex (ContactID -> ByteString
toKey ContactID
cid) Integer
3600 (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Contact
contact)

loadContact :: Locator -> ContactID -> IO (Maybe Contact)
loadContact :: Locator -> ContactID -> IO (Maybe Contact)
loadContact Locator
loc ContactID
cid = forall a. Locator -> Redis a -> IO a
runRedisAction Locator
loc forall a b. (a -> b) -> a -> b
$ do
  (forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
get forall a b. (a -> b) -> a -> b
$ ContactID -> ByteString
toKey ContactID
cid) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (Just ByteString
contactString) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpack forall a b. (a -> b) -> a -> b
$ ByteString
contactString)
    Either Reply (Maybe ByteString)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

deleteContact :: Locator -> ContactID -> IO ()
deleteContact :: Locator -> ContactID -> IO ()
deleteContact Locator
loc ContactID
cid = do
  Connection
connection <- Locator -> IO Connection
connect Locator
loc
  forall a. Connection -> Redis a -> IO a
runRedis Connection
connection forall a b. (a -> b) -> a -> b
$ do
    Either Reply Integer
_ <- forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
del [String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ContactID
cid]
    forall (m :: * -> *) a. Monad m => a -> m a
return ()


toKey :: ContactID -> ByteString
toKey :: ContactID -> ByteString
toKey = String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show