voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip, reusing group key for same entries

This commit is contained in:
Dmitry Zuikov 2024-08-07 12:45:24 +03:00
parent c7cd7875a7
commit 9bc657be48
1 changed files with 17 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
hbs2-sync/src/HBS2/Sync/Prelude.hs
View File

@ -497,7 +497,7 @@ runDirectory = do
<&> fromRight (Just 0) <&> fromRight (Just 0)
when (n < Just 2) do when (n < Just 2) do
postEntryTx Nothing refchan path e postEntryTx (HM.lookup p hasGK0) refchan path e
Compact.putVal tombs p (maybe 0 succ n) Compact.putVal tombs p (maybe 0 succ n)
N (_,_) -> none N (_,_) -> none
@ -506,14 +506,14 @@ runDirectory = do
notice $ green "move entry" <+> pretty f <+> pretty t notice $ green "move entry" <+> pretty f <+> pretty t
mv (path </> f) (path </> t) mv (path </> f) (path </> t)
notice $ green "post renamed entry tx" <+> pretty f notice $ green "post renamed entry tx" <+> pretty f
postEntryTx Nothing refchan path e postEntryTx (HM.lookup f hasGK0) refchan path e
E (p,UpdatedFileEntry _ e) -> do E (p,UpdatedFileEntry _ e) -> do
let fullPath = path </> p let fullPath = path </> p
here <- liftIO $ doesFileExist fullPath here <- liftIO $ doesFileExist fullPath
writeEntry path e writeEntry path e
notice $ red "updated file entry" <+> pretty here <+> pretty p <+> line <+> pretty (AsSexp @C e) notice $ red "updated file entry" <+> pretty here <+> pretty p <+> line <+> pretty (AsSexp @C e)
postEntryTx Nothing refchan path e postEntryTx (HM.lookup p hasGK0) refchan path e
E (p,e@(FileEntry _)) -> do E (p,e@(FileEntry _)) -> do
let fullPath = path </> p let fullPath = path </> p
@ -535,7 +535,7 @@ runDirectory = do
when here do when here do
tombs <- getTombs tombs <- getTombs
postEntryTx Nothing refchan path e postEntryTx (HM.lookup p hasGK0) refchan path e
n <- Compact.getValEither @Integer tombs p n <- Compact.getValEither @Integer tombs p
<&> fromRight (Just 0) <&> fromRight (Just 0)
@ -623,13 +623,23 @@ postEntryTx mgk refchan path entry = do
let members = view refChanHeadReaders rch & HS.toList let members = view refChanHeadReaders rch & HS.toList
-- взять GK из дерева из стейта если там есть такая Entry
-- FIXME: support-unencrypted? -- FIXME: support-unencrypted?
when (L.null members) do when (L.null members) do
throwIO EncryptionKeysNotDefined throwIO EncryptionKeysNotDefined
gk <- Symm.generateGroupKey @'HBS2Basic Nothing members let rcpt = maybe mempty (HM.keys . recipients) mgk
gk <- case (members == rcpt, mgk) of
(True, Just g) -> pure g
(False,_) -> do
sec <- runMaybeT $
toMPlus mgk >>= liftIO . runKeymanClient . extractGroupKeySecret >>= toMPlus
case sec of
Just s -> Symm.generateGroupKey @'HBS2Basic (Just s) members
Nothing -> Symm.generateGroupKey @'HBS2Basic Nothing members
_ -> Symm.generateGroupKey @'HBS2Basic Nothing members
-- FIXME: survive-this-error? -- FIXME: survive-this-error?
href <- lift $ createTreeWithMetadata sto (Just gk) meta lbs href <- lift $ createTreeWithMetadata sto (Just gk) meta lbs