{-# 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.Example2.Cache
  ( -- * Cache services
    deleteContact
  , loadContact
  , saveContact
  , runRedisAction

    -- * Redis Connection
  , Connection
  , defaultConn
  )
where

import           Control.Monad (void)
import           Data.ByteString.Char8 (pack, unpack, ByteString)
import           Database.Redis

import           TmpProc.Example2.Schema

{-| A default for local development .-}
defaultConn :: IO Connection
defaultConn :: IO Connection
defaultConn = ConnectInfo -> IO Connection
connect ConnectInfo
defaultConnectInfo

runRedisAction :: Connection -> Redis a -> IO a
runRedisAction :: forall a. Connection -> Redis a -> IO a
runRedisAction Connection
loc Redis a
action = forall a. Connection -> Redis a -> IO a
runRedis Connection
loc Redis a
action

saveContact :: Connection -> ContactID -> Contact -> IO ()
saveContact :: Connection -> ContactID -> Contact -> IO ()
saveContact Connection
loc ContactID
cid Contact
contact = forall a. Connection -> Redis a -> IO a
runRedisAction Connection
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 :: Connection -> ContactID -> IO (Maybe Contact)
loadContact :: Connection -> ContactID -> IO (Maybe Contact)
loadContact Connection
loc ContactID
cid = forall a. Connection -> Redis a -> IO a
runRedisAction Connection
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 :: Connection -> ContactID -> IO ()
deleteContact :: Connection -> ContactID -> IO ()
deleteContact Connection
loc ContactID
cid = do
  forall a. Connection -> Redis a -> IO a
runRedis Connection
loc 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