diff options
Diffstat (limited to 'src/Storage')
| -rw-r--r-- | src/Storage/Internal.hs | 10 | ||||
| -rw-r--r-- | src/Storage/Key.hs | 4 |
2 files changed, 9 insertions, 5 deletions
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 |