From 28598ad2cde0552fb7ef63ea90f07abf0d20d44a Mon Sep 17 00:00:00 2001
From: Paul Brinkmeier <hallo@pbrinkmeier.de>
Date: Mon, 5 Sep 2022 17:11:23 +0200
Subject: [PATCH] Cache getAllLectures requests for 60 seconds

We do this because Squeak doesn't have a getLectureById endpoint yet.
---
 lisa.cabal   |  6 +++---
 package.yaml |  2 +-
 src/Lisa.hs  | 34 ++++++++++++++++++++++++----------
 3 files changed, 28 insertions(+), 14 deletions(-)

diff --git a/lisa.cabal b/lisa.cabal
index 91c981b..24e7562 100644
--- a/lisa.cabal
+++ b/lisa.cabal
@@ -40,7 +40,7 @@ library
     , blaze-html >=0.9
     , req >=3.10
     , text >=1.0
-    , time
+    , time >=1.13
   default-language: Haskell2010
 
 executable lisa-exe
@@ -58,7 +58,7 @@ executable lisa-exe
     , lisa
     , req >=3.10
     , text >=1.0
-    , time
+    , time >=1.13
   default-language: Haskell2010
 
 test-suite lisa-test
@@ -77,5 +77,5 @@ test-suite lisa-test
     , lisa
     , req >=3.10
     , text >=1.0
-    , time
+    , time >=1.13
   default-language: Haskell2010
diff --git a/package.yaml b/package.yaml
index e7a751a..e5ca84c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -26,7 +26,7 @@ dependencies:
 - req >= 3.10
 - Spock >= 0.14
 - text >= 1.0
-- time
+- time >= 1.13
 
 library:
   source-dirs: src
diff --git a/src/Lisa.hs b/src/Lisa.hs
index 19b172b..299356b 100644
--- a/src/Lisa.hs
+++ b/src/Lisa.hs
@@ -10,9 +10,11 @@ module Lisa
 import Control.Concurrent (MVar, newMVar, putMVar, takeMVar)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Maybe (fromMaybe)
+import Data.Time.Clock (UTCTime, getCurrentTime, addUTCTime)
 import Network.HTTP.Req (https)
 import Text.Blaze.Html (Html)
 import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
+import Text.Printf (printf)
 import Web.Spock (SpockAction, SpockM, ActionCtxT, get, getState, lazyBytes, param, root, setHeader, var, (<//>))
 import Web.Spock.Config (PoolOrConn(PCNoDatabase), SpockCfg, defaultSpockCfg)
 
@@ -36,27 +38,39 @@ instance SqueakCtx (SpockAction () () State) where
 -- State
 
 data State = State
-    { stateLectures :: MVar (Maybe [Lecture]) -- ^ Cached lectures
+    { stateLectures :: MVar (UTCTime, [Lecture]) -- ^ Cached lectures with cache expiration time.
     }
 
 -- | Get lectures from cache if they've been retrieved before or from Squeak.
+-- Uses 'MVar's for synchronisation: As long as each thread 'takeMVar's before it 'putMVar's, we're in the clear.
+-- TODO: Evaluate lectures to NF before 'putMVar'ing them.
 getAllLecturesCached :: SpockAction () () State (Either SqueakError [Lecture])
 getAllLecturesCached = do
     lecturesMVar <- stateLectures <$> getState
-    contents <- liftIO $ takeMVar lecturesMVar
-    lectures' <- case contents of
-        Just lectures -> pure $ Right lectures
-        Nothing -> do
-            liftIO $ putStrLn "Fetching lectures for the first time..."
-            Squeak.getAllLectures
-    liftIO $ putMVar lecturesMVar $ either (const Nothing) Just lectures'
-    pure lectures'
+    (expirationTime, lectures) <- liftIO $ takeMVar lecturesMVar
+    now <- liftIO getCurrentTime
+    (newContents, result) <- if now >= expirationTime
+    then -- Cache expired => fetch lectures again.
+        Squeak.getAllLectures >>= \case
+            -- On error: Clear cache.
+            Left err ->
+                pure ((now, []), Left err)
+            -- On success: Cache fetched lectures for 60 seconds.
+            Right lectures' -> do
+                let expirationTime' = addUTCTime 60 now
+                liftIO $ printf "Fetched %d lectures, valid until %s\n" (length lectures') (show expirationTime')
+                pure ((expirationTime', lectures'), Right lectures')
+    else -- Cache still valid => return it.
+        pure ((expirationTime, lectures), Right lectures)
+    liftIO $ putMVar lecturesMVar newContents
+    pure result
 
 -- Exports
 
 mkConfig :: IO (SpockCfg () () State)
 mkConfig = do
-    lecturesMVar <- newMVar Nothing
+    now <- getCurrentTime
+    lecturesMVar <- newMVar (now, [])
     defaultSpockCfg () PCNoDatabase (State lecturesMVar)
 
 app :: SpockM () () State ()