{-# 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 :: Connection -> Redis a -> IO a
runRedisAction Connection
loc Redis a
action = Connection -> Redis a -> IO a
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 = Connection -> Redis () -> IO ()
forall a. Connection -> Redis a -> IO a
runRedisAction Connection
loc (Redis () -> IO ()) -> Redis () -> IO ()
forall a b. (a -> b) -> a -> b
$ Redis (Either Reply Status) -> Redis ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Redis (Either Reply Status) -> Redis ())
-> Redis (Either Reply Status) -> Redis ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer -> ByteString -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> ByteString -> m (f Status)
setex (ContactID -> ByteString
toKey ContactID
cid) Integer
3600 (String -> ByteString
pack (String -> ByteString)
-> (Contact -> String) -> Contact -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contact -> String
forall a. Show a => a -> String
show (Contact -> ByteString) -> Contact -> ByteString
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 = Connection -> Redis (Maybe Contact) -> IO (Maybe Contact)
forall a. Connection -> Redis a -> IO a
runRedisAction Connection
loc (Redis (Maybe Contact) -> IO (Maybe Contact))
-> Redis (Maybe Contact) -> IO (Maybe Contact)
forall a b. (a -> b) -> a -> b
$ do
  (ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
get (ByteString -> Redis (Either Reply (Maybe ByteString)))
-> ByteString -> Redis (Either Reply (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ ContactID -> ByteString
toKey ContactID
cid) Redis (Either Reply (Maybe ByteString))
-> (Either Reply (Maybe ByteString) -> Redis (Maybe Contact))
-> Redis (Maybe Contact)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (Just ByteString
contactString) -> Maybe Contact -> Redis (Maybe Contact)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Contact -> Redis (Maybe Contact))
-> Maybe Contact -> Redis (Maybe Contact)
forall a b. (a -> b) -> a -> b
$ Contact -> Maybe Contact
forall a. a -> Maybe a
Just (String -> Contact
forall a. Read a => String -> a
read (String -> Contact)
-> (ByteString -> String) -> ByteString -> Contact
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpack (ByteString -> Contact) -> ByteString -> Contact
forall a b. (a -> b) -> a -> b
$ ByteString
contactString)
    Either Reply (Maybe ByteString)
_ -> Maybe Contact -> Redis (Maybe Contact)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Contact
forall a. Maybe a
Nothing

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


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