Cache getAllLectures requests for 60 seconds

We do this because Squeak doesn't have a getLectureById endpoint yet.

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

package.yaml

@@ -26,7 +26,7 @@ dependencies:
 - req >= 3.10
 - Spock >= 0.14
 - text >= 1.0
-- time
+- time >= 1.13
 
 library:
   source-dirs: src

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
+    (expirationTime, lectures) <- liftIO $ takeMVar lecturesMVar
-    lectures' <- case contents of
+    now <- liftIO getCurrentTime
-        Just lectures -> pure $ Right lectures
+    (newContents, result) <- if now >= expirationTime
-        Nothing -> do
+    then -- Cache expired => fetch lectures again.
-            liftIO $ putStrLn "Fetching lectures for the first time..."
+        Squeak.getAllLectures >>= \case
-            Squeak.getAllLectures
+            -- On error: Clear cache.
-    liftIO $ putMVar lecturesMVar $ either (const Nothing) Just lectures'
+            Left err ->
-    pure lectures'
+                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 ()