From ed1e426e73bece3a3c061353a0a0802691e517d7 Mon Sep 17 00:00:00 2001
From: Lia Lenckowski <lialenck@protonmail.com>
Date: Thu, 27 Jul 2023 01:40:51 +0200
Subject: add some caching

---
 src/BangState.hs | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

(limited to 'src/BangState.hs')

diff --git a/src/BangState.hs b/src/BangState.hs
index fd3bbaa..8eba764 100644
--- a/src/BangState.hs
+++ b/src/BangState.hs
@@ -6,15 +6,19 @@ module BangState (
     getBangsJSON,
     getBangsBrotli,
     addBang,
+    getBangsHash,
 ) where
 
 import Codec.Compression.Brotli (compress)
 import Control.Applicative ((<|>))
 import Control.Concurrent.STM.TChan
 import Control.Monad (forever)
+import Crypto.Hash (hashlazy, Digest, SHA512)
 import Data.Aeson
-import Data.ByteString (ByteString, toStrict, empty)
+import Data.ByteArray.Encoding (convertToBase, Base(Base64))
+import Data.ByteString (ByteString, toStrict, empty, take)
 import Data.Text (Text)
+import Data.Text.Encoding (decodeASCII)
 import GHC.Conc
 import Network.HTTP.Simple (Response, httpJSON, getResponseBody)
 import System.AtomicWrite.Writer.LazyByteString (atomicWriteFile)
@@ -26,6 +30,7 @@ data BangState = BangState {
     ddgBangs :: TVar Bangs,
     serializedBangs :: TVar ByteString,
     brotliBangs :: TVar ByteString,
+    serializedHash :: TVar Text,
     syncFileNotifications :: TChan ()
 }
 
@@ -33,10 +38,13 @@ reserialize :: BangState -> STM ()
 reserialize s = do
     own <- readTVar $ ownBangs s
     ddg <- readTVar $ ddgBangs s
-
     let jsonBs = encode $ own <> ddg -- left biased union
+
     writeTVar (serializedBangs s) $ toStrict $ jsonBs
     writeTVar (brotliBangs s)     $ toStrict $ compress jsonBs
+    -- hash: for now, base64 of the first 120 bits of the SHA512 of the bangs
+    writeTVar (serializedHash s)  $ decodeASCII $ Data.ByteString.take 20
+        $ convertToBase Base64 $ (hashlazy jsonBs :: Digest SHA512)
     writeTChan (syncFileNotifications s) ()
 
 -- spawns a thread for syncing the current state to disk. do *NOT* use forkIO on this
@@ -68,6 +76,7 @@ initBangState = do
         <*> newTVarIO (toBangs $ getResponseBody ans)
         <*> newTVarIO empty -- initially filled in by 'spawnFileSyncThread'
         <*> newTVarIO empty -- same as above
+        <*> newTVarIO ""    -- same as above
         <*> newBroadcastTChanIO
 
     spawnFileSyncThread s
@@ -81,3 +90,6 @@ getBangsBrotli s = readTVarIO $ brotliBangs s
 
 addBang :: Text -> Text -> Text -> BangState -> IO ()
 addBang _ _ _ _ = error $ "TODO"
+
+getBangsHash :: BangState -> IO Text
+getBangsHash s = readTVarIO $ serializedHash s
-- 
cgit v1.2.3-70-g09d2