From c180c47ed48261403d37cb040fefce0d0de60be0 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Fri, 20 Sep 2024 07:29:36 +0300
Subject: [PATCH] wip

---
 fixme-new/lib/Fixme/Run/Internal.hs | 77 +++++++++++++++++++++++------
 1 file changed, 62 insertions(+), 15 deletions(-)

diff --git a/fixme-new/lib/Fixme/Run/Internal.hs b/fixme-new/lib/Fixme/Run/Internal.hs
index 546bd56c..51c84fe7 100644
--- a/fixme-new/lib/Fixme/Run/Internal.hs
+++ b/fixme-new/lib/Fixme/Run/Internal.hs
@@ -1003,7 +1003,6 @@ fixmeRefChanInit = do
         notice $ green "refchan added" <+> pretty (AsBase58 refchan)
 
 
-
 refchanExportGroupKeys :: FixmePerks m => FixmeM m ()
 refchanExportGroupKeys = do
 
@@ -1027,6 +1026,8 @@ refchanExportGroupKeys = do
   skip <- newTVarIO HS.empty
   gkz <- newTVarIO HS.empty
 
+  fixmeSign <- putBlock sto "FIXMEGROUPKEYBLOCKv1" <&> fmap HashRef
+
   walkRefChanTx @UNIX goodToGo chan $ \txh u -> do
 
     case u of
@@ -1081,9 +1082,16 @@ refchanExportGroupKeys = do
 
   let (pk,sk) = (view peerSignPk creds, view peerSignSk creds)
 
-  keyz <- Map.fromList <$> S.toList_ do
+  keyz <- Set.fromList <$> S.toList_ do
     for_ r $ \gkh -> void $ runMaybeT do
+
+      debug $ red $ "FOR GK" <+> pretty gkh
+
       gk <- loadGroupKeyMaybe @'HBS2Basic sto gkh >>= toMPlus
+
+      -- the original groupkey should be indexed as well
+      lift $ S.yield gkh
+
       gks <- liftIO (runKeymanClientRO $ findMatchedGroupKeySecret sto gk)
 
       when (isNothing gks) do
@@ -1093,30 +1101,69 @@ refchanExportGroupKeys = do
 
       gk1 <- generateGroupKey @'HBS2Basic gks (HS.toList $ view refChanHeadReaders rch)
       let lbs = serialise gk1
-      -- gkh1 <- writeAsMerkle sto lbs  <&> HashRef
+      gkh1 <- writeAsMerkle sto lbs  <&> HashRef
       debug $  red "prepare new gk0" <+> pretty (LBS.length lbs) <+> pretty gkh <+> pretty (groupKeyId gk)
-      lift $ S.yield (groupKeyId gk, gk1)
+      lift $ S.yield gkh1
 
-  notice $ yellow $ "new gk:" <+> pretty (Map.size keyz)
+  notice $ yellow $ "new gk:" <+> pretty (Set.size keyz)
 
-  let nitems = 262144 `div` (125 * HS.size (view refChanHeadReaders rch) )
-  let chunks = Map.elems keyz & chunksOf nitems
+  -- let nitems = 262144 `div` (125 * HS.size (view refChanHeadReaders rch) )
+  -- let chunks = Map.elems keyz & chunksOf nitems
 
-  for_ chunks $ \x -> do
+  -- TODO: gk:performance-vs-reliability
+  --   ситуация такова: групповой ключ это меркл-дерево
+  --   для одного и того же блоба могут быть разные меркл-деревья,
+  --   так как могут быть разные настройки.
+  --
+  --   если распространять ключи по-одному, то хотя бы тот же ключ,
+  --   который мы создали изначально -- будет доступен по своему хэшу,
+  --   как отдельный артефакт.
+  --
+  --   Если писать их пачками, где каждый ключ представлен непосредственно,
+  --   то на принимающей стороне нет гарантии, что меркл дерево будет писаться
+  --   с таким же параметрами, хотя и может.
+  --
+  --   Решение:  делать групповой ключ БЛОКОМ. тогда его размер будет ограничен,
+  --   но он хотя бы будет всегда однозначно определён хэшем.
+  --
+  --   Решение: ссылаться не на групповой ключ, а на хэш его секрета
+  --   что ломает текущую схему и обратная совместимость будет морокой.
+  --
+  --   Решение: добавить в hbs2-keyman возможно индексации единичного
+  --   ключа, и индексировать таким образом *исходные* ключи.
+  --
+  --   Тогда можно эти вот ключи писать пачками, их хэши не имеют особого значения,
+  --   если мы проиндексируем оригинальный ключ и будем знать, на какой секрет он
+  --   ссылается.
+  --
+  --   Заметим, что в один блок поместится аж >2000 читателей, что должно быть
+  --   более, чем достаточно => при таких группах вероятность утечки секрета
+  --   стремится к 1.0, так как большинство клало болт на меры безопасности.
+  --
+  --   Кстати говоря, проблема недостаточного количества авторов в ключе легко
+  --   решается полем ORIGIN, т.к мы можем эти самые ключи разделять.
+  --
+  --   Что бы не стоять перед такой проблемой, мы всегда можем распостранять эти ключи
+  --   по-одному, ЛИБО добавить в производный ключ поле
+  --   ORIGIN: где будет хэш изначального ключа.
+  --
+  --   Это нормально, так как мы сможем проверить, что у этих ключей
+  --   (текущий и ORIGIN) одинаковые хэши секретов.
+  --
+  --   Это всё равно оставляет возможность еще одной DoS атаки на сервис,
+  --   с распространением кривых ключей, но это хотя бы выяснимо, ну и атака
+  --   может быть только в рамках рефчана, т.е лечится выкидыванием пиров /
+  --   исключением зловредных авторов.
 
-      let gktreemeta = HM.fromList [ ("GK", Text.pack (show $ pretty $ L.length x)) ]
-      -- group keys are public (and already encrypted)
-      -- therefore, no encryption
-      href <- liftIO $ createTreeWithMetadata sto mzero gktreemeta (serialise x)
-                >>= orThrowPassIO
+  for_ (Set.toList keyz) $ \href -> do
 
-      let tx = AnnotatedHashRef Nothing href
+      let tx = AnnotatedHashRef fixmeSign href
 
       let lbs = serialise tx
 
       let box = makeSignedBox @'HBS2Basic @BS.ByteString pk sk (LBS.toStrict lbs)
 
-      warn $ "POST GK TX" <+> pretty (length x) <+> "tree" <+> pretty href
+      warn $ "post gk tx" <+> "tree" <+> pretty href
 
       result <- callRpcWaitMay @RpcRefChanPropose (TimeoutSec 1) api (chan, box)