voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

setup all stuff

This commit is contained in:
Dmitry Zuikov 2024-04-18 10:44:35 +03:00
parent 81f31e0bda
commit 700777a8fd
1 changed files with 42 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
hbs2-git/hbs2-git-dashboard/GitDashBoard.hs
View File

@ -8,6 +8,24 @@ import HBS2.OrDie
import HBS2.System.Dir import HBS2.System.Dir
import HBS2.System.Logger.Simple.ANSI hiding (info) import HBS2.System.Logger.Simple.ANSI hiding (info)
import HBS2.Data.Types.Refs
import HBS2.Net.Auth.Credentials
import HBS2.Merkle
import HBS2.Storage
import HBS2.Net.Messaging.Unix
import HBS2.OrDie
import HBS2.Misc.PrettyStuff
import HBS2.Net.Proto.Service
import HBS2.Peer.Proto.LWWRef
import HBS2.Peer.RPC.API.Peer
import HBS2.Peer.RPC.API.RefLog
import HBS2.Peer.RPC.API.RefChan
import HBS2.Peer.RPC.API.LWWRef
import HBS2.Peer.RPC.API.Storage
import HBS2.Peer.RPC.Client.StorageClient
import HBS2.Git.Web.Assets import HBS2.Git.Web.Assets
import HBS2.Git.DashBoard.State import HBS2.Git.DashBoard.State
import HBS2.Git.DashBoard.Types import HBS2.Git.DashBoard.Types
@ -93,6 +111,9 @@ runDashBoardM cli m = do
liftIO $ print (pretty conf) liftIO $ print (pretty conf)
-- FIXME: unix-socket-from-config
soname <- detectRPC `orDie` "hbs2-peer rpc not found"
env <- newDashBoardEnv conf dbFile env <- newDashBoardEnv conf dbFile
let errorPrefix = toStderr . logPrefix "[error] " let errorPrefix = toStderr . logPrefix "[error] "
@ -113,6 +134,27 @@ runDashBoardM cli m = do
forever do forever do
liftIO (atomically $ readTQueue q) & liftIO . join liftIO (atomically $ readTQueue q) & liftIO . join
client <- liftIO $ race (pause @'Seconds 1) (newMessagingUnix False 1.0 soname)
>>= orThrowUser ("can't connect to" <+> pretty soname)
void $ ContT $ withAsync $ runMessagingUnix client
peerAPI <- makeServiceCaller @PeerAPI (fromString soname)
refLogAPI <- makeServiceCaller @RefLogAPI (fromString soname)
storageAPI <- makeServiceCaller @StorageAPI (fromString soname)
lwwAPI <- makeServiceCaller @LWWRefAPI (fromString soname)
let sto = AnyStorage (StorageClient storageAPI)
let endpoints = [ Endpoint @UNIX peerAPI
, Endpoint @UNIX refLogAPI
, Endpoint @UNIX lwwAPI
, Endpoint @UNIX storageAPI
]
void $ ContT $ withAsync $ liftIO $ runReaderT (runServiceClientMulti endpoints) client
lift $ withDashBoardEnv env (withState evolveDB >> m) lift $ withDashBoardEnv env (withState evolveDB >> m)
`finally` do `finally` do
setLoggingOff @DEBUG setLoggingOff @DEBUG
@ -149,9 +191,6 @@ runScotty = do
pno <- cfgValue @HttpPortOpt @(Maybe Int) <&> fromMaybe 8090 pno <- cfgValue @HttpPortOpt @(Maybe Int) <&> fromMaybe 8090
wo <- cfgValue @DevelopAssetsOpt @(Maybe FilePath) <&> WebOptions wo <- cfgValue @DevelopAssetsOpt @(Maybe FilePath) <&> WebOptions
soname <- runMaybeT (getRPC <|> detectRPC)
`orDie` "hbs2-peer RPC not detected"
env <- ask env <- ask
addJob (withDashBoardEnv env updateIndex) addJob (withDashBoardEnv env updateIndex)