From 63b6aa47c8d8b6375c0b98788501d78611b5e638 Mon Sep 17 00:00:00 2001
From: voidlizard <dzuikov@gmail.com>
Date: Tue, 26 Aug 2025 09:02:00 +0300
Subject: [PATCH] wip, fixing

---
 .gitignore                                                 | 1 +
 hbs2-cli/lib/HBS2/CLI/Run/GroupKey.hs                      | 2 +-
 hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs             | 2 +-
 hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs               | 3 ++-
 hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs                        | 2 +-
 .../hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs      | 7 ++++++-
 hbs2-peer/app/CLI/RefChan.hs                               | 2 +-
 hbs2-sync/src/HBS2/Sync/State.hs                           | 1 -
 8 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/.gitignore b/.gitignore
index 5319eadd..1cabcc15 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,4 @@ bin/
 .direnv/
 .hbs2-git3/
 
+temp/
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/GroupKey.hs b/hbs2-cli/lib/HBS2/CLI/Run/GroupKey.hs
index 2ca6ae06..5df6d4b0 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/GroupKey.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/GroupKey.hs
@@ -162,7 +162,7 @@ groupKeyEntries = do
 
         gk <- loadGroupKey gkh >>= orThrowUser "can't load groupkey"
 
-        what <- runKeymanClient $ findMatchedGroupKeySecret sto gk
+        what <- runKeymanClientRO $ findMatchedGroupKeySecret sto gk
                    >>= orThrowUser "groupkey secret not found"
 
         let gid = generateGroupKeyId GroupKeyIdBasic1 what
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs
index dac57267..2a9f6096 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs
@@ -44,7 +44,7 @@ encryptBlock sto gk x = do
 
   let HbSyncHash non = hashObject (serialise x)
 
-  gks <- runKeymanClient (extractGroupKeySecret gk)
+  gks <- runKeymanClientRO (extractGroupKeySecret gk)
            >>= orThrowUser "can't extract group key secret"
 
   Symm.encryptBlock sto gks (Right gk) (Just non) x
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs b/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs
index 6edd1bfb..c893e5d2 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs
@@ -27,6 +27,7 @@ import Data.Text qualified as Text
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.Cont
 import Control.Monad.Except
+import Data.Maybe
 
 
 --FIXME: move-somewhere-else
@@ -83,7 +84,7 @@ createTreeWithMetadata sto mgk meta lbs = do -- flip runContT pure do
     -- FIXME: support-encryption
     createEncryptedTree gk mt = do
       -- 1. find key
-      mgks <- runKeymanClient do
+      mgks <- runKeymanClientRO do
                 extractGroupKeySecret gk
 
       gks <- orThrowUser "can't get groupkey's secret" mgks
diff --git a/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs b/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs
index a4cfa141..b7139f9a 100644
--- a/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs
@@ -43,7 +43,7 @@ import Streaming.Prelude qualified as S
 
 getCredentialsForReflog :: MonadUnliftIO m => RefLogKey 'HBS2Basic -> m (PeerCredentials 'HBS2Basic)
 getCredentialsForReflog reflog = do
-  runKeymanClient (loadCredentials reflog)
+  runKeymanClientRO (loadCredentials reflog)
      >>= orThrowUser "credentials not found"
 
 mkRefLogUpdateFrom :: (MonadUnliftIO m) => RefLogKey 'HBS2Basic -> m ByteString ->  m (RefLogUpdate L4Proto)
diff --git a/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs b/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs
index 967074f5..af0e1b73 100644
--- a/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs
+++ b/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs
@@ -9,6 +9,7 @@ import HBS2.Storage
 import HBS2.Data.Types.Refs
 import HBS2.Net.Auth.Credentials
 import HBS2.Net.Auth.GroupKeySymm as Symm
+import HBS2.Net.Auth.Schema()
 
 
 import HBS2.System.Dir
@@ -114,12 +115,16 @@ loadCredentials k = KeyManClient do
 loadKeyRingEntry :: forall m .
                     ( MonadIO m
                     , SerialisedCredentials 'HBS2Basic
+                    , IsRefPubKey 'HBS2Basic
                     )
                  => PubKey 'Encrypt 'HBS2Basic
                  -> KeyManClient m (Maybe (KeyringEntry 'HBS2Basic))
 loadKeyRingEntry pk = KeyManClient do
   runMaybeT do
-    fn <- toMPlus =<< lift (selectKeyFile pk)
+    fn' <- lift (selectKeyFile pk)
+    -- when (isNothing fn') do
+    --   error $ "keyman: key file not found"
+    fn <- toMPlus fn'
     bs <- liftIO (try @_ @IOException $ BS.readFile fn) >>= toMPlus
     creds <- toMPlus $ parseCredentials (AsCredFile bs)
     toMPlus $ headMay [ e
diff --git a/hbs2-peer/app/CLI/RefChan.hs b/hbs2-peer/app/CLI/RefChan.hs
index 807dc7f9..44bd09a1 100644
--- a/hbs2-peer/app/CLI/RefChan.hs
+++ b/hbs2-peer/app/CLI/RefChan.hs
@@ -72,7 +72,7 @@ pRefChanHeadGen = do
   rchan <- argument pRefChanId (metavar "REFCHAN-KEY")
   pure $ do
 
-    creds <- runKeymanClient $ loadCredentials rchan
+    creds <- runKeymanClientRO $ loadCredentials rchan
                >>= orThrowUser "can't load credentials"
 
     s <- maybe1 fn getContents readFile
diff --git a/hbs2-sync/src/HBS2/Sync/State.hs b/hbs2-sync/src/HBS2/Sync/State.hs
index 9c601644..7134f9a5 100644
--- a/hbs2-sync/src/HBS2/Sync/State.hs
+++ b/hbs2-sync/src/HBS2/Sync/State.hs
@@ -376,7 +376,6 @@ getStateFromRefChan rchan = do
             AnnotatedHashRef w href <- deserialiseOrFail @AnnotatedHashRef (LBS.fromStrict bs)
                                         & toMPlus . either (const Nothing) Just
 
-
             runExceptT (extractMetaData @'HBS2Basic findKey sto href)
              >>= either (const none) ( \meta -> atomically $ writeTQueue outq (orig, ((href, meta), txh)) )