mirror of https://github.com/voidlizard/hbs2
wip, moving to new suckless-conf
This commit is contained in:
parent
5450f3daad
commit
6bbc451c2f
|
@ -3,7 +3,8 @@ packages: **/*.cabal
|
|||
|
||||
allow-newer: all
|
||||
|
||||
constraints: pandoc ==3.1.11, suckless-conf ==0.1.2.0
|
||||
constraints: pandoc ==3.1.11, suckless-conf ==0.1.2.1
|
||||
|
||||
|
||||
-- executable-static: True
|
||||
-- profiling: True
|
||||
|
|
|
@ -72,30 +72,30 @@ data StateRefOpt
|
|||
data QBLFRefKey
|
||||
type MyRefKey = AnyRefKey QBLFRefKey 'HBS2Basic
|
||||
|
||||
instance Monad m => HasCfgKey HttpPortOpt (Maybe Int) m where
|
||||
instance HasCfgKey HttpPortOpt (Maybe Int) where
|
||||
key = "http"
|
||||
|
||||
|
||||
instance {-# OVERLAPPING #-} (HasConf m, HasCfgKey HttpPortOpt (Maybe Int) m) => HasCfgValue HttpPortOpt (Maybe Int) m where
|
||||
instance {-# OVERLAPPING #-} (HasConf m, HasCfgKey HttpPortOpt (Maybe Int)) => HasCfgValue HttpPortOpt (Maybe Int) m where
|
||||
cfgValue = val <$> getConf
|
||||
where
|
||||
val syn = lastMay [ fromIntegral e
|
||||
| ListVal (Key s [LitIntVal e]) <- syn, s == key @HttpPortOpt @(Maybe Int) @m
|
||||
| ListVal (Key s [LitIntVal e]) <- syn, s == key @HttpPortOpt @(Maybe Int)
|
||||
]
|
||||
|
||||
instance Monad m => HasCfgKey RefChanOpt (Maybe String) m where
|
||||
instance HasCfgKey RefChanOpt (Maybe String) where
|
||||
key = "refchan"
|
||||
|
||||
instance Monad m => HasCfgKey SocketOpt (Maybe String) m where
|
||||
instance HasCfgKey SocketOpt (Maybe String) where
|
||||
key = "socket"
|
||||
|
||||
instance Monad m => HasCfgKey ActorOpt (Maybe String) m where
|
||||
instance HasCfgKey ActorOpt (Maybe String) where
|
||||
key = "actor"
|
||||
|
||||
instance Monad m => HasCfgKey DefStateOpt (Maybe String) m where
|
||||
instance HasCfgKey DefStateOpt (Maybe String) where
|
||||
key = "default-state"
|
||||
|
||||
instance Monad m => HasCfgKey StateRefOpt (Maybe String) m where
|
||||
instance HasCfgKey StateRefOpt (Maybe String) where
|
||||
key = "state-ref"
|
||||
|
||||
class ToBalance s tx where
|
||||
|
|
13
flake.lock
13
flake.lock
|
@ -520,17 +520,18 @@
|
|||
]
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1715860766,
|
||||
"narHash": "sha256-GklvSI6ANQaZlj8yrVhvDP5O8KS/zra4WLkDP5jQKP8=",
|
||||
"lastModified": 1715866786,
|
||||
"narHash": "sha256-Pl4JDMBw1kzdcK/g2yA/BGu97dMRkQ2hJHi09PLbeq8=",
|
||||
"ref": "refs/heads/master",
|
||||
"rev": "0c5c235ed2bc6218d24a50aded412876a8fabb65",
|
||||
"revCount": 29,
|
||||
"rev": "864b359f44a4824f2a7b3dd49a37356c05f3ceff",
|
||||
"revCount": 31,
|
||||
"type": "git",
|
||||
"url": "https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ?tag=0.1.2.0"
|
||||
"url": "https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ"
|
||||
},
|
||||
"original": {
|
||||
"rev": "864b359f44a4824f2a7b3dd49a37356c05f3ceff",
|
||||
"type": "git",
|
||||
"url": "https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ?tag=0.1.2.0"
|
||||
"url": "https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ"
|
||||
}
|
||||
}
|
||||
},
|
||||
|
|
|
@ -14,7 +14,7 @@ inputs = {
|
|||
fixme.inputs.nixpkgs.follows = "nixpkgs";
|
||||
|
||||
suckless-conf.url =
|
||||
"git+https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ?tag=0.1.2.0";
|
||||
"git+https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ?rev=864b359f44a4824f2a7b3dd49a37356c05f3ceff";
|
||||
|
||||
suckless-conf.inputs.nixpkgs.follows = "nixpkgs";
|
||||
|
||||
|
|
|
@ -23,11 +23,11 @@ data HttpPortOpt
|
|||
|
||||
data DevelopAssetsOpt
|
||||
|
||||
instance HasConf m => HasCfgKey HttpPortOpt a m where
|
||||
instance HasCfgKey HttpPortOpt a where
|
||||
key = "port"
|
||||
|
||||
|
||||
instance HasConf m => HasCfgKey DevelopAssetsOpt a m where
|
||||
instance HasCfgKey DevelopAssetsOpt a where
|
||||
key = "develop-assets"
|
||||
|
||||
data RunDashBoardOpts = RunDashBoardOpts
|
||||
|
|
|
@ -28,10 +28,10 @@ data PeerDnsBootStrapKey
|
|||
|
||||
data PeerKnownPeer
|
||||
|
||||
instance Monad m => HasCfgKey PeerDnsBootStrapKey (Set String) m where
|
||||
instance HasCfgKey PeerDnsBootStrapKey (Set String) where
|
||||
key = "bootstrap-dns"
|
||||
|
||||
instance Monad m => HasCfgKey PeerKnownPeer (Set String) m where
|
||||
instance HasCfgKey PeerKnownPeer (Set String) where
|
||||
key = "known-peer"
|
||||
|
||||
-- FIXME: tcp-addr-support-bootstrap
|
||||
|
|
|
@ -68,7 +68,7 @@ instance FromField HashRef where
|
|||
fromField = fmap fromString . fromField @String
|
||||
|
||||
|
||||
instance Monad m => HasCfgKey PeerBrainsDb (Maybe String) m where
|
||||
instance HasCfgKey PeerBrainsDb (Maybe String) where
|
||||
key = "brains"
|
||||
|
||||
newtype CommitCmd = CommitCmd { onCommited :: IO () }
|
||||
|
@ -937,7 +937,7 @@ newBasicBrains cfg = liftIO do
|
|||
|
||||
data PeerDownloadsDelOnStart
|
||||
|
||||
instance Monad m => HasCfgKey PeerDownloadsDelOnStart b m where
|
||||
instance HasCfgKey PeerDownloadsDelOnStart b where
|
||||
key = "downloads-del-on-start"
|
||||
|
||||
{- HLINT ignore "Use camelCase" -}
|
||||
|
|
|
@ -38,7 +38,7 @@ instance Pretty AcceptAnnounce where
|
|||
|
||||
|
||||
|
||||
instance Monad m => HasCfgKey PeerAcceptAnnounceKey AcceptAnnounce m where
|
||||
instance HasCfgKey PeerAcceptAnnounceKey AcceptAnnounce m where
|
||||
key = "accept-block-announce"
|
||||
|
||||
instance (Monad m, HasConf m) => HasCfgValue PeerAcceptAnnounceKey AcceptAnnounce m where
|
||||
|
|
|
@ -16,10 +16,10 @@ import Lens.Micro.Platform
|
|||
data PeerBlackListKey
|
||||
data PeerWhiteListKey
|
||||
|
||||
instance Monad m => HasCfgKey PeerBlackListKey (Set String) m where
|
||||
instance PeerBlackListKey (Set String) where
|
||||
key = "blacklist"
|
||||
|
||||
instance Monad m => HasCfgKey PeerWhiteListKey (Set String) m where
|
||||
instance PeerWhiteListKey (Set String) where
|
||||
key = "whitelist"
|
||||
|
||||
peerBanned :: forall e m . ( Monad m
|
||||
|
|
|
@ -42,31 +42,31 @@ data PeerBrainsDBPath
|
|||
instance Monad m => HasConf (ReaderT PeerConfig m) where
|
||||
getConf = asks (\(PeerConfig syn) -> syn)
|
||||
|
||||
instance Monad m => HasCfgKey PeerListenTCPKey (Maybe String) m where
|
||||
instance HasCfgKey PeerListenTCPKey (Maybe String) where
|
||||
key = "listen-tcp"
|
||||
|
||||
instance Monad m => HasCfgKey PeerHttpPortKey (Maybe Integer) m where
|
||||
instance HasCfgKey PeerHttpPortKey (Maybe Integer) where
|
||||
key = "http-port"
|
||||
|
||||
instance Monad m => HasCfgKey PeerTcpProbeWaitKey (Maybe Integer) m where
|
||||
instance HasCfgKey PeerTcpProbeWaitKey (Maybe Integer) where
|
||||
key = "tcp-probe-wait"
|
||||
|
||||
instance Monad m => HasCfgKey PeerUseHttpDownload b m where
|
||||
instance HasCfgKey PeerUseHttpDownload b where
|
||||
key = "http-download"
|
||||
|
||||
instance Monad m => HasCfgKey PeerBrainsDBPath b m where
|
||||
instance HasCfgKey PeerBrainsDBPath b where
|
||||
key = "brains-db"
|
||||
|
||||
instance Monad m => HasCfgKey PeerDownloadLogKey (Maybe String) m where
|
||||
instance HasCfgKey PeerDownloadLogKey (Maybe String) where
|
||||
key = "download-log"
|
||||
|
||||
data PeerKnownPeersFile
|
||||
|
||||
instance Monad m => HasCfgKey PeerKnownPeersFile (Set String) m where
|
||||
instance HasCfgKey PeerKnownPeersFile (Set String) where
|
||||
key = "known-peers-file"
|
||||
|
||||
|
||||
instance {-# OVERLAPPABLE #-} (HasConf m, HasCfgKey a b m) => HasCfgValue a FeatureSwitch m where
|
||||
instance {-# OVERLAPPABLE #-} (HasConf m, HasCfgKey a b) => HasCfgValue a FeatureSwitch m where
|
||||
cfgValue = lastDef FeatureOff . val <$> getConf
|
||||
where
|
||||
val syn = [ if e == "on" then FeatureOn else FeatureOff
|
||||
|
|
|
@ -41,7 +41,7 @@ import UnliftIO
|
|||
data PeerPingIntervalKey
|
||||
|
||||
-- TODO: ping-interval-specifically-for-peer
|
||||
instance Monad m => HasCfgKey PeerPingIntervalKey (Maybe Integer) m where
|
||||
instance HasCfgKey PeerPingIntervalKey (Maybe Integer) where
|
||||
key = "ping-interval"
|
||||
|
||||
|
||||
|
|
|
@ -145,34 +145,34 @@ data PeerTcpSOCKS5
|
|||
data PeerDownloadThreadKey
|
||||
|
||||
|
||||
instance Monad m => HasCfgKey PeerDebugKey a m where
|
||||
instance HasCfgKey PeerDebugKey a where
|
||||
key = "debug"
|
||||
|
||||
instance Monad m => HasCfgKey PeerTraceKey a m where
|
||||
instance HasCfgKey PeerTraceKey a where
|
||||
key = "trace"
|
||||
|
||||
instance Monad m => HasCfgKey PeerTrace1Key a m where
|
||||
instance HasCfgKey PeerTrace1Key a where
|
||||
key = "trace1"
|
||||
|
||||
instance Monad m => HasCfgKey PeerListenKey (Maybe String) m where
|
||||
instance HasCfgKey PeerListenKey (Maybe String) where
|
||||
key = "listen"
|
||||
|
||||
instance Monad m => HasCfgKey PeerKeyFileKey (Maybe String) m where
|
||||
instance HasCfgKey PeerKeyFileKey (Maybe String) where
|
||||
key = "key"
|
||||
|
||||
instance Monad m => HasCfgKey PeerStorageKey (Maybe String) m where
|
||||
instance HasCfgKey PeerStorageKey (Maybe String) where
|
||||
key = "storage"
|
||||
|
||||
instance Monad m => HasCfgKey PeerProxyFetchKey (Set String) m where
|
||||
instance HasCfgKey PeerProxyFetchKey (Set String) where
|
||||
key = "proxy-fetch-for"
|
||||
|
||||
-- NOTE: socks5-auth
|
||||
-- Network.Simple.TCP does not support
|
||||
-- SOCKS5 authentification
|
||||
instance Monad m => HasCfgKey PeerTcpSOCKS5 (Maybe String) m where
|
||||
instance HasCfgKey PeerTcpSOCKS5 (Maybe String) where
|
||||
key = "tcp.socks5"
|
||||
|
||||
instance Monad m => HasCfgKey PeerDownloadThreadKey (Maybe Int) m where
|
||||
instance HasCfgKey PeerDownloadThreadKey (Maybe Int) where
|
||||
key = "download-threads"
|
||||
|
||||
data PeerOpts =
|
||||
|
|
|
@ -287,7 +287,7 @@ instance ForRefChans e => FromStringMaybe (RefChanHeadBlock e) where
|
|||
<*> pure (LBS.toStrict ext)
|
||||
|
||||
where
|
||||
parsed = parseTop str & fromRight mempty
|
||||
parsed = parseTop (fromString str) & fromRight mempty
|
||||
version = lastMay [ n | (ListVal [SymbolVal "version", LitIntVal n] ) <- parsed ]
|
||||
quorum = lastMay [ n | (ListVal [SymbolVal "quorum", LitIntVal n] ) <- parsed ]
|
||||
wait = lastMay [ n | (ListVal [SymbolVal "wait", LitIntVal n] ) <- parsed ]
|
||||
|
|
|
@ -39,16 +39,16 @@ data RpcUnixOpt
|
|||
|
||||
data SigilPathOpt
|
||||
|
||||
instance Monad m => HasCfgKey IgnoreOpt (Set String) m where
|
||||
instance HasCfgKey IgnoreOpt (Set String) where
|
||||
key = "ignore"
|
||||
|
||||
instance Monad m => HasCfgKey RefChanOpt (Maybe RChan) m where
|
||||
instance HasCfgKey RefChanOpt (Maybe RChan) where
|
||||
key = "refchan"
|
||||
|
||||
instance Monad m => HasCfgKey RpcUnixOpt (Maybe String) m where
|
||||
instance HasCfgKey RpcUnixOpt (Maybe String) where
|
||||
key = "rpc.unix"
|
||||
|
||||
instance Monad m => HasCfgKey SigilPathOpt (Maybe String) m where
|
||||
instance HasCfgKey SigilPathOpt (Maybe String) where
|
||||
key = "sigil"
|
||||
|
||||
appName :: FilePath
|
||||
|
|
Loading…
Reference in New Issue