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