{- |
Module      :  ./PGIP/RequestCache.hs
Description :  hets server request cache

License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Daniel Hackbarth <da_ha@uni-bremen.de>
-}

module PGIP.RequestCache where

import qualified Data.ByteString.Lazy.Char8 as BS
import Data.IORef
import qualified Data.Map as Map
import qualified Data.Text as T

import Network.HTTP.Types.Method
import Network.Wai.Internal

-- | Holds all necessary informations for caching a request
data RequestMapKey = RequestMapKey {
  -- | The used request method.
    RequestMapKey -> Method
requestMethod' :: Method
  -- | The request URL without the server and port.
  , RequestMapKey -> [Text]
pathInfo' :: [T.Text]
  -- | The send request body.
  , RequestMapKey -> ByteString
requestBody' :: BS.ByteString
  }
  deriving (Int -> RequestMapKey -> ShowS
[RequestMapKey] -> ShowS
RequestMapKey -> String
(Int -> RequestMapKey -> ShowS)
-> (RequestMapKey -> String)
-> ([RequestMapKey] -> ShowS)
-> Show RequestMapKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestMapKey] -> ShowS
$cshowList :: [RequestMapKey] -> ShowS
show :: RequestMapKey -> String
$cshow :: RequestMapKey -> String
showsPrec :: Int -> RequestMapKey -> ShowS
$cshowsPrec :: Int -> RequestMapKey -> ShowS
Show, Eq RequestMapKey
Eq RequestMapKey =>
(RequestMapKey -> RequestMapKey -> Ordering)
-> (RequestMapKey -> RequestMapKey -> Bool)
-> (RequestMapKey -> RequestMapKey -> Bool)
-> (RequestMapKey -> RequestMapKey -> Bool)
-> (RequestMapKey -> RequestMapKey -> Bool)
-> (RequestMapKey -> RequestMapKey -> RequestMapKey)
-> (RequestMapKey -> RequestMapKey -> RequestMapKey)
-> Ord RequestMapKey
RequestMapKey -> RequestMapKey -> Bool
RequestMapKey -> RequestMapKey -> Ordering
RequestMapKey -> RequestMapKey -> RequestMapKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RequestMapKey -> RequestMapKey -> RequestMapKey
$cmin :: RequestMapKey -> RequestMapKey -> RequestMapKey
max :: RequestMapKey -> RequestMapKey -> RequestMapKey
$cmax :: RequestMapKey -> RequestMapKey -> RequestMapKey
>= :: RequestMapKey -> RequestMapKey -> Bool
$c>= :: RequestMapKey -> RequestMapKey -> Bool
> :: RequestMapKey -> RequestMapKey -> Bool
$c> :: RequestMapKey -> RequestMapKey -> Bool
<= :: RequestMapKey -> RequestMapKey -> Bool
$c<= :: RequestMapKey -> RequestMapKey -> Bool
< :: RequestMapKey -> RequestMapKey -> Bool
$c< :: RequestMapKey -> RequestMapKey -> Bool
compare :: RequestMapKey -> RequestMapKey -> Ordering
$ccompare :: RequestMapKey -> RequestMapKey -> Ordering
$cp1Ord :: Eq RequestMapKey
Ord, RequestMapKey -> RequestMapKey -> Bool
(RequestMapKey -> RequestMapKey -> Bool)
-> (RequestMapKey -> RequestMapKey -> Bool) -> Eq RequestMapKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestMapKey -> RequestMapKey -> Bool
$c/= :: RequestMapKey -> RequestMapKey -> Bool
== :: RequestMapKey -> RequestMapKey -> Bool
$c== :: RequestMapKey -> RequestMapKey -> Bool
Eq)

type RequestCacheMap = Map.Map RequestMapKey Response

-- | Returns a new request cache.
createNewRequestCache :: IO (IORef (RequestCacheMap))
createNewRequestCache :: IO (IORef RequestCacheMap)
createNewRequestCache =
  RequestCacheMap -> IO (IORef RequestCacheMap)
forall a. a -> IO (IORef a)
newIORef (RequestCacheMap
forall k a. Map k a
Map.empty :: RequestCacheMap)

-- | Update the request cache by first building the key and then perform the update
updateCache :: IORef (BS.ByteString) -> Request -> Response -> IORef ((RequestCacheMap)) -> IO ()
updateCache :: IORef ByteString
-> Request -> Response -> IORef RequestCacheMap -> IO ()
updateCache requestBodyRef :: IORef ByteString
requestBodyRef request :: Request
request response :: Response
response cacheMap :: IORef RequestCacheMap
cacheMap = do
  ByteString
requestBodyBS <- IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
readIORef IORef ByteString
requestBodyRef
  RequestMapKey
requestKey <- Request -> ByteString -> IO RequestMapKey
convertRequestToMapKey Request
request ByteString
requestBodyBS
  RequestMapKey -> Response -> IORef RequestCacheMap -> IO ()
updateCacheWithKey RequestMapKey
requestKey Response
response IORef RequestCacheMap
cacheMap

-- | Update the request cache with a new request/response pair.
updateCacheWithKey :: RequestMapKey -> Response -> IORef ((RequestCacheMap)) -> IO ()
updateCacheWithKey :: RequestMapKey -> Response -> IORef RequestCacheMap -> IO ()
updateCacheWithKey requestKey :: RequestMapKey
requestKey response :: Response
response cacheRef :: IORef RequestCacheMap
cacheRef= do
  RequestCacheMap
cachedRequestsResponsesMap <- IORef RequestCacheMap -> IO RequestCacheMap
forall a. IORef a -> IO a
readIORef IORef RequestCacheMap
cacheRef
  let cacheMap :: RequestCacheMap
cacheMap = RequestMapKey -> Response -> RequestCacheMap -> RequestCacheMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert RequestMapKey
requestKey Response
response RequestCacheMap
cachedRequestsResponsesMap
  IORef RequestCacheMap -> RequestCacheMap -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef RequestCacheMap
cacheRef RequestCacheMap
cacheMap

-- | Checks the request cache for a request that could already be cached.
-- Returns the cached response or Nothing if the request is not cached.
lookupCache :: RequestMapKey -> IORef ((RequestCacheMap)) -> IO (Maybe Response)
lookupCache :: RequestMapKey -> IORef RequestCacheMap -> IO (Maybe Response)
lookupCache cacheKey :: RequestMapKey
cacheKey cacheRef :: IORef RequestCacheMap
cacheRef = do
  RequestCacheMap
cachedRequestsResponsesMap <- IORef RequestCacheMap -> IO RequestCacheMap
forall a. IORef a -> IO a
readIORef IORef RequestCacheMap
cacheRef
  Maybe Response -> IO (Maybe Response)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Response -> IO (Maybe Response))
-> Maybe Response -> IO (Maybe Response)
forall a b. (a -> b) -> a -> b
$ RequestMapKey -> RequestCacheMap -> Maybe Response
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RequestMapKey
cacheKey RequestCacheMap
cachedRequestsResponsesMap

-- | Converts a given request to a key that can be used for a request cache.
-- The original request body needs to be passed too because in the original request
-- the request body is already consumed.
convertRequestToMapKey :: Request -> BS.ByteString -> IO RequestMapKey
convertRequestToMapKey :: Request -> ByteString -> IO RequestMapKey
convertRequestToMapKey request :: Request
request requestBodyBS :: ByteString
requestBodyBS = do
  RequestMapKey -> IO RequestMapKey
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestMapKey -> IO RequestMapKey)
-> RequestMapKey -> IO RequestMapKey
forall a b. (a -> b) -> a -> b
$ Method -> [Text] -> ByteString -> RequestMapKey
RequestMapKey (Request -> Method
requestMethod Request
request) (Request -> [Text]
pathInfo Request
request) ByteString
requestBodyBS