From bfcfbb8523e6fc5ea2a74302661995e09ad0de71 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 12 Nov 2019 21:40:59 +0100
Subject: Storage: watching head changes

---
 src/Storage/Internal.hs | 10 +++++++---
 src/Storage/Key.hs      |  4 ++--
 2 files changed, 9 insertions(+), 5 deletions(-)

(limited to 'src/Storage')

diff --git a/src/Storage/Internal.hs b/src/Storage/Internal.hs
index 76a3945..88741e0 100644
--- a/src/Storage/Internal.hs
+++ b/src/Storage/Internal.hs
@@ -21,6 +21,7 @@ import qualified Data.Map as M
 
 import System.Directory
 import System.FilePath
+import System.INotify (INotify)
 import System.IO
 import System.IO.Error
 import System.Posix.Files
@@ -35,7 +36,7 @@ data Storage' c = Storage
     deriving (Eq)
 
 instance Show (Storage' c) where
-    show st@(Storage { stBacking = StorageDir path }) = "dir" ++ showParentStorage st ++ ":" ++ path
+    show st@(Storage { stBacking = StorageDir { dirPath = path }}) = "dir" ++ showParentStorage st ++ ":" ++ path
     show st@(Storage { stBacking = StorageMemory {} }) = "mem" ++ showParentStorage st
 
 showParentStorage :: Storage' c -> String
@@ -43,10 +44,13 @@ showParentStorage Storage { stParent = Nothing } = ""
 showParentStorage Storage { stParent = Just st } = "@" ++ show st
 
 data StorageBacking c
-         = StorageDir FilePath
+         = StorageDir { dirPath :: FilePath
+                      , dirWatchers :: MVar (Maybe INotify, [(String, Head' c -> IO ())])
+                      }
          | StorageMemory { memHeads :: MVar [Head' c]
                          , memObjs :: MVar (Map RefDigest BL.ByteString)
                          , memKeys :: MVar (Map RefDigest ScrubbedBytes)
+                         , memWatchers :: MVar [(String, Head' c -> IO ())]
                          }
     deriving (Eq)
 
@@ -107,7 +111,7 @@ ioLoadBytesFromStorage st dgst = loadCurrent st >>=
     \case Just bytes -> return $ Just bytes
           Nothing | Just parent <- stParent st -> ioLoadBytesFromStorage parent dgst
                   | otherwise                  -> return Nothing
-    where loadCurrent Storage { stBacking = StorageDir spath } = handleJust (guard . isDoesNotExistError) (const $ return Nothing) $
+    where loadCurrent Storage { stBacking = StorageDir { dirPath = spath } } = handleJust (guard . isDoesNotExistError) (const $ return Nothing) $
               Just . decompress <$> (BL.readFile $ refPath spath dgst)
           loadCurrent Storage { stBacking = StorageMemory { memObjs = tobjs } } = M.lookup dgst <$> readMVar tobjs
 
diff --git a/src/Storage/Key.hs b/src/Storage/Key.hs
index 8e6d04c..28fc989 100644
--- a/src/Storage/Key.hs
+++ b/src/Storage/Key.hs
@@ -31,13 +31,13 @@ storeKey :: KeyPair sec pub => sec -> IO ()
 storeKey key = do
     let spub = keyGetPublic key
     case stBacking $ storedStorage spub of
-         StorageDir dir -> writeFileOnce (keyFilePath dir spub) (BL.fromStrict $ convert $ keyGetData key)
+         StorageDir { dirPath = dir } -> writeFileOnce (keyFilePath dir spub) (BL.fromStrict $ convert $ keyGetData key)
          StorageMemory { memKeys = kstore } -> modifyMVar_ kstore $ return . M.insert (refDigest $ storedRef spub) (keyGetData key)
 
 loadKey :: KeyPair sec pub => Stored pub -> IO (Maybe sec)
 loadKey spub = do
     case stBacking $ storedStorage spub of
-         StorageDir dir -> tryIOError (BC.readFile (keyFilePath dir spub)) >>= \case
+         StorageDir { dirPath = dir } -> tryIOError (BC.readFile (keyFilePath dir spub)) >>= \case
              Right kdata -> return $ keyFromData (convert kdata) spub
              Left _ -> return Nothing
          StorageMemory { memKeys = kstore } -> (flip keyFromData spub <=< M.lookup (refDigest $ storedRef spub)) <$> readMVar kstore
-- 
cgit v1.2.3