wip, fixing

.gitignore

@@ -4,3 +4,4 @@ bin/
 .direnv/
 .hbs2-git3/
 
+temp/

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

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

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

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)

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

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

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)) )