wip

hbs2-git/git-hbs2/Main.hs

@@ -150,7 +150,7 @@ pShowRef = do
       tx  <- withState do
                selectMaxAppliedTx >>= lift  . toMPlus <&> fst
 
-      rh <- TX.readRepoHeadFromTx sto tx >>= toMPlus
+      rh <- TX.readRepoHeadFromTx sto tx >>= toMPlus <&> snd
 
       liftIO $ print $ vcat (fmap formatRef (_repoHeadRefs rh))
 
@@ -172,7 +172,8 @@ pKeyShow = do
                selectMaxAppliedTx >>= lift  . toMPlus <&> fst
 
       rh <- TX.readRepoHeadFromTx sto tx
-               >>= toMPlus
+                >>= toMPlus
+                <&> snd
 
       gkh <- toMPlus (_repoHeadGK0 rh)
 

hbs2-git/git-remote-hbs2/Main.hs

@@ -177,7 +177,10 @@ main = do
                     r'  <- runMaybeT $ withState do
                             tx <- selectMaxAppliedTx >>= lift  . toMPlus <&> fst
 
-                            rh <- TX.readRepoHeadFromTx sto tx >>= lift . toMPlus
+                            rh <- TX.readRepoHeadFromTx sto tx
+                                      >>= lift . toMPlus
+                                      <&> snd
+
                             pure (_repoHeadRefs rh)
 
                     let r = fromMaybe mempty r'

hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Export.hs

@@ -191,7 +191,7 @@ export key refs  = do
 
       tx0 <- getLastAppliedTx
 
-      rh0 <- runMaybeT ( toMPlus tx0 >>= readRepoHeadFromTx sto >>= toMPlus )
+      rh0 <- runMaybeT ( toMPlus tx0 >>= readRepoHeadFromTx sto >>= toMPlus <&> snd)
 
       (name,brief,mf) <- lift getManifest
 

hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx.hs

@@ -212,7 +212,7 @@ readTx sto href = do
 readRepoHeadFromTx :: MonadIO m
        => AnyStorage
        -> HashRef
-       -> m (Maybe RepoHead)
+       -> m (Maybe (HashRef, RepoHead))
 
 readRepoHeadFromTx sto href = runMaybeT do
 
@@ -226,6 +226,7 @@ readRepoHeadFromTx sto href = runMaybeT do
     >>= toMPlus
     <&> deserialiseOrFail @RepoHead
     >>= toMPlus
+    <&> (rhh,)
 
 
 data BundleMeta =

hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs

@@ -3,6 +3,7 @@ module HBS2.Git.Oracle.Run where
 import HBS2.Git.Oracle.Prelude
 import HBS2.Git.Oracle.App
 
+import HBS2.Hash
 import HBS2.Merkle
 
 import HBS2.Git.Data.LWWBlock
@@ -17,13 +18,14 @@ import Codec.Serialise
 import Control.Monad.Trans.Maybe
 import Data.Coerce
 import Data.Ord
+import Data.Text qualified as Text
 import Control.Monad.Trans.Except
 import Data.List
 import Safe
 
 {- HLINT ignore "Functor law" -}
 
-data GitRepoFact =
+data GitRepoRefFact =
   GitRepoFact1
   { gitLwwRef :: LWWRefKey HBS2Basic
   , gitLwwSeq :: Word64
@@ -32,23 +34,29 @@ data GitRepoFact =
   deriving stock (Generic)
 
 data GitRepoHeadFact =
-  GitRepoHeadFact
+  GitRepoHeadFact1
-  {
+  { gitRepoName      :: Text
+  , gitRepoBrief     :: Text
+  , gitRepoEncrypted :: Bool
+  , gitRepoHeadRef   :: HashRef
   }
   deriving stock (Generic)
 
 
-instance Serialise GitRepoFact
+data GitRepoFacts =
+      GitRepoRefFact  GitRepoRefFact
+    | GitRepoHeadFact HashRef GitRepoHeadFact
+    deriving stock (Generic)
 
-instance Pretty GitRepoFact where
+instance Serialise GitRepoRefFact
+instance Serialise GitRepoHeadFact
+instance Serialise GitRepoFacts
+
+instance Pretty GitRepoRefFact where
   pretty (GitRepoFact1{..}) =
     parens ( "gitrepofact1" <+>  hsep [pretty gitLwwRef, pretty gitLwwSeq, pretty gitRefLog])
 
 
-makeGitRepoFactBlock :: MonadUnliftIO m => [GitRepoFact] -> Oracle m HashRef
-makeGitRepoFactBlock facts = do
-  undefined
-
 runOracle :: forall m  . MonadUnliftIO m => Oracle m ()
 runOracle = do
   debug "hbs2-git-oracle"
@@ -94,12 +102,14 @@ runOracle = do
 
       let tx' = maximumByMay (comparing fst) txs
 
-      forM_ tx' $ \(n,tx) -> void $ runMaybeT do
+      headFact <- forM tx' $ \(n,tx) -> void $ runMaybeT do
-        RepoHeadSimple{..} <- readRepoHeadFromTx sto tx >>= toMPlus
 
-        let enc = if isJust _repoHeadGK0 then "E" else "P"
+        (rhh,RepoHeadSimple{..}) <- readRepoHeadFromTx sto tx
-        let name  = _repoHeadName
+                                       >>= toMPlus
-        let brief = _repoHeadBrief
+
+        let enc = isJust _repoHeadGK0
+        let name  = Text.take 256 $  _repoHeadName
+        let brief = Text.take 1024 $ _repoHeadBrief
         let manifest = _repoManifest
 
         debug $ "found head"
@@ -115,4 +125,22 @@ runOracle = do
           <> line
           <> line
 
+        let f1 = GitRepoRefFact what
+        let f2 = GitRepoHeadFact
+                    repoFactHash
+                    (GitRepoHeadFact1 name brief enc undefined
+                    )
+
+        pure undefined
+
+      pure ()
+        -- debug $ "found head"
+        --   <+> pretty gitLwwRef
+        --   <+> pretty n
+        --   <+> pretty enc
+        --   <+> pretty gitRefLog
+        --   <+> pretty name
+        --   <+> pretty brief
+        --   <+> pretty manifest
+        --   <+> pretty tx
 

hbs2-peer/lib/HBS2/Peer/Proto/RefChan/RefChanUpdate.hs

@@ -299,30 +299,6 @@ refChanUpdateProto self pc adapter msg = do
 
         debug $ "OMG!!! TRANS AUTHORIZED" <+> pretty (AsBase58 peerKey)  <+> pretty (AsBase58 authorKey)
 
-        -- TODO: validate-transaction
-        --  итак, как нам валидировать транзакцию?
-        --  HTTP ?
-        --  TCP ?
-        --  UDP ? (кстати, годно и быстро)
-        --  CLI ?
-        --  получается, риалтайм: ждём не более X секунд валидации,
-        --  иначе не валидируем.
-        --  по хорошему,  не блокироваться бы в запросе.
-        --  тут мы зависим от состояния конвейра, нас можно DDoS-ить
-        --  большим количеством запросов и транзакции будут отклоняться
-        --  при большом потоке.
-        --  но решается это.. тадам! PoW! подбором красивых хэшей
-        --  при увеличении нагрузки.
-        --  тогда, правда, в открытой системе работает паттерн -- DDoS
-        --  всех, кроме своих узлов, а свои узлы всё принимают.
-
-        -- для начала: сделаем хук для валидации, которыйне будет делать ничего
-
-        -- если не смогли сохранить транзу, то и Accept разослать
-        -- не сможем
-        -- это правильно, так как транза содержит ссылку на RefChanId
-        -- следовательно, для другого рефчана будет другая транза
-
         hash <- MaybeT $ liftIO $ putBlock sto (serialise msg)
 
         ts <- liftIO getTimeCoarse