{-# 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 :: Locator -> Redis a -> IO a
runRedisAction Locator
loc Redis a
action = do
  Connection
connection <- Locator -> IO Connection
connect Locator
loc
  Connection -> Redis a -> IO a
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 = Locator -> Redis () -> IO ()
forall a. Locator -> Redis a -> IO a
runRedisAction Locator
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 :: Locator -> ContactID -> IO (Maybe Contact)
loadContact :: Locator -> ContactID -> IO (Maybe Contact)
loadContact Locator
loc ContactID
cid = Locator -> Redis (Maybe Contact) -> IO (Maybe Contact)
forall a. Locator -> Redis a -> IO a
runRedisAction Locator
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 :: Locator -> ContactID -> IO ()
deleteContact :: Locator -> ContactID -> IO ()
deleteContact Locator
loc ContactID
cid = do
  Connection
connection <- Locator -> IO Connection
connect Locator
loc
  Connection -> Redis () -> IO ()
forall a. Connection -> Redis a -> IO a
runRedis Connection
connection (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