summaryrefslogtreecommitdiff
path: root/src/Storage
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-09-09 15:11:41 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2023-09-09 15:11:41 +0200
commit1a9b84130aca8ad39d32b45ad011cfac7ce980a2 (patch)
tree61d8e079db8537d06689d49dd1e4794e9bb8965f /src/Storage
parent2144ddbd1750475d187670430a0b343bd47489c2 (diff)
Look for private keys in parent storage
Diffstat (limited to 'src/Storage')
-rw-r--r--src/Storage/Key.hs19
1 files changed, 12 insertions, 7 deletions
diff --git a/src/Storage/Key.hs b/src/Storage/Key.hs
index a51496f..7730f9f 100644
--- a/src/Storage/Key.hs
+++ b/src/Storage/Key.hs
@@ -38,15 +38,20 @@ storeKey key = do
StorageMemory { memKeys = kstore } -> modifyMVar_ kstore $ return . M.insert (refDigest $ storedRef spub) (keyGetData key)
loadKey :: (KeyPair sec pub, MonadIO m, MonadError String m) => Stored pub -> m sec
-loadKey = maybe (throwError "secret key not found") return <=< loadKeyMb
+loadKey pub = maybe (throwError $ "secret key not found for " <> show (storedRef pub)) return =<< loadKeyMb pub
loadKeyMb :: (KeyPair sec pub, MonadIO m) => Stored pub -> m (Maybe sec)
-loadKeyMb spub = liftIO $ do
- case stBacking $ storedStorage spub of
- 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
+loadKeyMb spub = liftIO $ run $ storedStorage spub
+ where
+ run st = tryOneLevel (stBacking st) >>= \case
+ key@Just {} -> return key
+ Nothing | Just parent <- stParent st -> run parent
+ | otherwise -> return Nothing
+ tryOneLevel = \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
moveKeys :: MonadIO m => Storage -> Storage -> m ()
moveKeys from to = liftIO $ do