diff --git a/hbs2-git/git-hbs2/Main.hs b/hbs2-git/git-hbs2/Main.hs index a48a2470..cde8f40c 100644 --- a/hbs2-git/git-hbs2/Main.hs +++ b/hbs2-git/git-hbs2/Main.hs @@ -11,14 +11,22 @@ import HBS2.Git.Data.RefLog import HBS2.Git.Local.CLI qualified as Git import HBS2.Git.Data.Tx.Git qualified as TX import HBS2.Git.Data.Tx.Git (RepoHead(..)) +import HBS2.Git.Data.Tx.Index import HBS2.Git.Data.LWWBlock +import HBS2.Peer.Proto.RefChan.Types import HBS2.Git.Data.GK +import HBS2.KeyMan.Keys.Direct import HBS2.Storage.Operations.ByteString +import Data.HashSet qualified as HS +import Data.Maybe +import Data.Coerce import Options.Applicative as O import Data.ByteString.Lazy qualified as LBS +import Streaming.Prelude qualified as S + import System.Exit globalOptions :: Parser [GitOption] @@ -215,10 +223,48 @@ pTrack = hsubparser ( command "send-repo-notify" (info pSendRepoNotify (progDes pSendRepoNotify :: GitPerks m => Parser (GitCLI m ()) pSendRepoNotify = do + dry <- flag False True (short 'n' <> long "dry" <> help "don't post anything") notifyChan <- argument pRefChanId (metavar "CHANNEL-KEY") pure do - notice "wip" - pure () + notice $ "test send-repo-notify" <+> pretty (AsBase58 notifyChan) + -- откуда мы берём ссылку, которую постим? их много. + + lwws <- withState selectAllLww + + -- берём те, для которых у нас есть приватный ключ (наши) + creds <- catMaybes <$> runKeymanClient do + for lwws $ \(lwref,_,_) -> do + loadCredentials (coerce @_ @(PubKey 'Sign 'HBS2Basic) lwref) + + sto <- getStorage + rchanAPI <- asks _refChanAPI + + hd <- getRefChanHead @L4Proto sto (RefChanHeadKey notifyChan) + `orDie` "refchan head not found" + + let notifiers = view refChanHeadNotifiers hd & HS.toList + + -- откуда мы берём ключ, которым подписываем? + -- ищем тоже в кеймане, берём тот, у которого выше weight + foundKey <- runKeymanClient ( + S.head_ do + for notifiers $ \n -> do + lift (loadCredentials n) >>= maybe none S.yield + ) `orDie` "signing key not found" + + for_ creds $ \c -> do + let lww = LWWRefKey @'HBS2Basic (view peerSignPk c) + let lwwSk = view peerSignSk c + let tx = makeNotificationTx @'HBS2Basic (NotifyCredentials foundKey) lww lwwSk Nothing + + notice $ "about to publish lwwref index entry:" + <+> pretty (AsBase58 $ view peerSignPk c) + + -- как мы постим ссылку + unless dry do + void $ callService @RpcRefChanNotify rchanAPI (notifyChan, tx) + + -- кто парсит ссылку и помещает в рефчан main :: IO () main = do diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App.hs index 26609664..adec00fa 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App.hs +++ b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App.hs @@ -136,11 +136,13 @@ runGitCLI o m = do peerAPI <- makeServiceCaller @PeerAPI (fromString soname) refLogAPI <- makeServiceCaller @RefLogAPI (fromString soname) + refChanAPI <- makeServiceCaller @RefChanAPI (fromString soname) storageAPI <- makeServiceCaller @StorageAPI (fromString soname) lwwAPI <- makeServiceCaller @LWWRefAPI (fromString soname) let endpoints = [ Endpoint @UNIX peerAPI , Endpoint @UNIX refLogAPI + , Endpoint @UNIX refChanAPI , Endpoint @UNIX lwwAPI , Endpoint @UNIX storageAPI ] @@ -160,7 +162,7 @@ runGitCLI o m = do progress <- ContT $ withAsync (drawProgress q) - env <- lift $ newGitEnv ip o git cpath conf peerAPI refLogAPI lwwAPI storageAPI + env <- lift $ newGitEnv ip o git cpath conf peerAPI refLogAPI refChanAPI lwwAPI storageAPI lift $ runReaderT setupLogging env lift $ withGitEnv env (evolveDB >> m) `finally` do diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App/Types.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App/Types.hs index 0fbcbbff..0e29200b 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App/Types.hs +++ b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App/Types.hs @@ -85,11 +85,12 @@ newGitEnv :: GitPerks m -> Config -> ServiceCaller PeerAPI UNIX -> ServiceCaller RefLogAPI UNIX + -> ServiceCaller RefChanAPI UNIX -> ServiceCaller LWWRefAPI UNIX -> ServiceCaller StorageAPI UNIX -> m GitEnv -newGitEnv p opts path cpath conf peer reflog lww sto = do +newGitEnv p opts path cpath conf peer reflog rchan lww sto = do let dbfile = cpath "state.db" let dOpt = dbPipeOptsDef { dbLogger = \x -> debug ("state:" <+> pretty x) } db <- newDBPipeEnv dOpt dbfile @@ -105,6 +106,7 @@ newGitEnv p opts path cpath conf peer reflog lww sto = do conf peer reflog + rchan lww (AnyStorage (StorageClient sto)) db diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App/Types/GitEnv.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App/Types/GitEnv.hs index 306f26fa..75b5c15d 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App/Types/GitEnv.hs +++ b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/App/Types/GitEnv.hs @@ -42,6 +42,7 @@ data GitEnv = , _config :: Config , _peerAPI :: ServiceCaller PeerAPI UNIX , _refLogAPI :: ServiceCaller RefLogAPI UNIX + , _refChanAPI :: ServiceCaller RefChanAPI UNIX , _lwwRefAPI :: ServiceCaller LWWRefAPI UNIX , _storage :: AnyStorage -- ServiceCaller StorageAPI UNIX , _db :: DBPipeEnv diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Index.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Index.hs index 71fc24ef..cc5b5e2c 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Index.hs +++ b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Data/Tx/Index.hs @@ -44,28 +44,22 @@ instance ForGitIndex s => Serialise (GitRepoAnnounceData s) instance ForGitIndex s => Serialise (GitRepoAnnounce s) -data NotifyCredentials s = - NotifyCredentials - { notifyPk :: PubKey 'Sign s - , notifySk :: PrivKey 'Sign s - } +newtype NotifyCredentials s = NotifyCredentials (PeerCredentials s) -- | makes notification tx -- | it is signed by lwwref private key in order to proove authorship -- | and signed with published notification private key in order -- | to publish tx via rpc -makeNotificationTx :: forall s m . (Monad m, ForGitIndex s) +makeNotificationTx :: forall s . (ForGitIndex s) => NotifyCredentials s -> LWWRefKey s - -> ( PubKey 'Sign s -> m (Maybe (PrivKey 'Sign s) ) ) + -> PrivKey 'Sign s -> Maybe (RepoForkInfo s) - -> m (Maybe (SignedBox ByteString s)) -makeNotificationTx ncred lww klook forkInfo = runMaybeT do + -> SignedBox ByteString s +makeNotificationTx ncred lww lwsk forkInfo = do + let creds = coerce ncred :: PeerCredentials s let annData = GitRepoAnnounceData @s lww forkInfo let lwpk = coerce lww :: PubKey 'Sign s - lwsk <- MaybeT $ klook lwpk let repoAnn = makeSignedBox @s lwpk lwsk (LBS.toStrict $ serialise annData) - pure $ makeSignedBox @s (notifyPk ncred) (notifySk ncred) (LBS.toStrict $ serialise repoAnn) - - + makeSignedBox @s (view peerSignPk creds) (view peerSignSk creds) (LBS.toStrict $ serialise repoAnn) diff --git a/hbs2-keyman/src/HBS2/KeyMan/Keys/Direct.hs b/hbs2-keyman/src/HBS2/KeyMan/Keys/Direct.hs index 4bf238c6..755f1ff9 100644 --- a/hbs2-keyman/src/HBS2/KeyMan/Keys/Direct.hs +++ b/hbs2-keyman/src/HBS2/KeyMan/Keys/Direct.hs @@ -59,8 +59,11 @@ loadCredentials k = KeyManClient do fnames <- select @(Only FilePath) [qc| select f.file - from keytype t join keyfile f on t.key = f.key + from keytype t + join keyfile f on t.key = f.key + left join keyweight w on w.key = f.key where t.key = ? and t.type = 'sign' + order by w.weight desc nulls last limit 1 |] (Only (SomePubKey k)) runMaybeT do diff --git a/hbs2-peer/app/CLI/RefChan.hs b/hbs2-peer/app/CLI/RefChan.hs index 71a5379d..807dc7f9 100644 --- a/hbs2-peer/app/CLI/RefChan.hs +++ b/hbs2-peer/app/CLI/RefChan.hs @@ -48,7 +48,7 @@ import UnliftIO pRefChan :: Parser (IO ()) -pRefChan = hsubparser ( command "head" (info pRefChanHead (progDesc "head commands" )) +pRefChan = hsubparser ( command "head" (info pRefChanHead (progDesc "head commands" )) <> command "propose" (info pRefChanPropose (progDesc "post propose transaction")) <> command "notify" (info pRefChanNotify (progDesc "post notify message")) <> command "fetch" (info pRefChanFetch (progDesc "fetch and sync refchan value")) diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs index 4b5c7343..ebc2ca71 100644 --- a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs +++ b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs @@ -418,13 +418,10 @@ getActualRefChanHead key = do case mbHead of Just hd -> do - debug "HEAD DISCOVERED" pure hd Nothing -> do - headblk <- MaybeT $ getRefChanHead sto key - debug "HEAD FOUND" - pure headblk + MaybeT $ getRefChanHead sto key getRefChanHead :: forall e s m . ( MonadIO m , s ~ Encryption e diff --git a/nix/peer/flake.lock b/nix/peer/flake.lock index ecfdcbc1..663c7a50 100644 --- a/nix/peer/flake.lock +++ b/nix/peer/flake.lock @@ -329,16 +329,17 @@ "suckless-conf": "suckless-conf_2" }, "locked": { - "lastModified": 1711190148, - "narHash": "sha256-XnvjD8yvSrSTMmsy3fE7chVg1oDBamMaWkEZ0lJ8sHU=", - "ref": "dev-0.24.2", - "rev": "37618a32bb0ae5bfa8b8380c6537638b1f5d412d", - "revCount": 983, + "lastModified": 1713159635, + "narHash": "sha256-iXf8qcJxePLM65E0fsAK2kj69/YIyQdNMrZ5yULzVGc=", + "ref": "hbs2-git-index", + "rev": "2289845078ba839bade83a1daf5234435e6e631e", + "revCount": 997, "type": "git", "url": "http://git.hbs2/BTThPdHKF8XnEq4m6wzbKHKA6geLFK4ydYhBXAqBdHSP" }, "original": { - "ref": "dev-0.24.2", + "ref": "hbs2-git-index", + "rev": "2289845078ba839bade83a1daf5234435e6e631e", "type": "git", "url": "http://git.hbs2/BTThPdHKF8XnEq4m6wzbKHKA6geLFK4ydYhBXAqBdHSP" }