diff --git a/cabal.project b/cabal.project index ed1a356d..567bd75a 100644 --- a/cabal.project +++ b/cabal.project @@ -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 diff --git a/examples/refchan-qblf/app/RefChanQBLFMain.hs b/examples/refchan-qblf/app/RefChanQBLFMain.hs index 730d7313..ef9e2783 100644 --- a/examples/refchan-qblf/app/RefChanQBLFMain.hs +++ b/examples/refchan-qblf/app/RefChanQBLFMain.hs @@ -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 diff --git a/flake.lock b/flake.lock index 9804c87d..faa41bc9 100644 --- a/flake.lock +++ b/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" } } }, diff --git a/flake.nix b/flake.nix index 35545934..59df4709 100644 --- a/flake.nix +++ b/flake.nix @@ -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"; diff --git a/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/DashBoard/Types.hs b/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/DashBoard/Types.hs index 7064512e..fb6d2117 100644 --- a/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/DashBoard/Types.hs +++ b/hbs2-git/hbs2-git-dashboard/src/HBS2/Git/DashBoard/Types.hs @@ -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 diff --git a/hbs2-peer/app/Bootstrap.hs b/hbs2-peer/app/Bootstrap.hs index 5122f115..601a20b7 100644 --- a/hbs2-peer/app/Bootstrap.hs +++ b/hbs2-peer/app/Bootstrap.hs @@ -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 diff --git a/hbs2-peer/app/Brains.hs b/hbs2-peer/app/Brains.hs index 2f32003e..abb40bbd 100644 --- a/hbs2-peer/app/Brains.hs +++ b/hbs2-peer/app/Brains.hs @@ -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" -} diff --git a/hbs2-peer/app/CheckBlockAnnounce.hs b/hbs2-peer/app/CheckBlockAnnounce.hs index ffcde038..5c529af1 100644 --- a/hbs2-peer/app/CheckBlockAnnounce.hs +++ b/hbs2-peer/app/CheckBlockAnnounce.hs @@ -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 diff --git a/hbs2-peer/app/CheckPeer.hs b/hbs2-peer/app/CheckPeer.hs index c5edf61e..19183707 100644 --- a/hbs2-peer/app/CheckPeer.hs +++ b/hbs2-peer/app/CheckPeer.hs @@ -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 diff --git a/hbs2-peer/app/PeerConfig.hs b/hbs2-peer/app/PeerConfig.hs index 024142e7..e77af9d0 100644 --- a/hbs2-peer/app/PeerConfig.hs +++ b/hbs2-peer/app/PeerConfig.hs @@ -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 diff --git a/hbs2-peer/app/PeerInfo.hs b/hbs2-peer/app/PeerInfo.hs index 952d8ebf..f2c5940f 100644 --- a/hbs2-peer/app/PeerInfo.hs +++ b/hbs2-peer/app/PeerInfo.hs @@ -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" diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 9939819d..f5e8106c 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -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 = diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs index 58e0109d..a57ce736 100644 --- a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs +++ b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs @@ -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 ] diff --git a/hbs2-share/src/HBS2/Share/Config.hs b/hbs2-share/src/HBS2/Share/Config.hs index cc7e0b67..1a13bd8d 100644 --- a/hbs2-share/src/HBS2/Share/Config.hs +++ b/hbs2-share/src/HBS2/Share/Config.hs @@ -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