mirror of https://github.com/voidlizard/hbs2
publishing repo index entry notification
This commit is contained in:
Dmitry Zuikov
parent
2289845078
commit
9c989890f8
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue