diff --git a/.fixme/log b/.fixme/log index e69de29b..22644f2a 100644 --- a/.fixme/log +++ b/.fixme/log @@ -0,0 +1,2 @@ + +(fixme-set "workflow" "test" "4dMi3uox8r") \ No newline at end of file diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 32896256..7548a606 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -92,6 +92,7 @@ data PeerListenKey data PeerRpcKey data PeerKeyFileKey data PeerBlackListKey +data PeerWhiteListKey data PeerStorageKey data PeerAcceptAnnounceKey data PeerTraceKey @@ -124,6 +125,9 @@ instance HasCfgKey PeerStorageKey (Maybe String) where instance HasCfgKey PeerBlackListKey (Set String) where key = "blacklist" +instance HasCfgKey PeerWhiteListKey (Set String) where + key = "whitelist" + instance HasCfgKey PeerAcceptAnnounceKey AcceptAnnounce where key = "accept-block-announce" @@ -432,10 +436,12 @@ runPeer opts = Exception.handle myException $ do setLogging @TRACE tracePrefix let bls = cfgValue @PeerBlackListKey conf :: Set String - - let blkeys = Set.fromList - $ catMaybes [ fromStringMay x | x <- Set.toList bls + let whs = cfgValue @PeerWhiteListKey conf :: Set String + let toKeys xs = Set.fromList + $ catMaybes [ fromStringMay x | x <- Set.toList xs ] :: Set (PubKey 'Sign UDP) + let blkeys = toKeys bls + let wlkeys = toKeys (whs `Set.difference` bls) let accptAnn = cfgValue @PeerAcceptAnnounceKey conf :: AcceptAnnounce @@ -444,7 +450,9 @@ runPeer opts = Exception.handle myException $ do -- FIXME: move-peerBanned-somewhere let peerBanned p d = do let k = view peerSignKey d - pure $ k `Set.member` blkeys + let blacklisted = k `Set.member` blkeys + let whitelisted = Set.null wlkeys || (k `Set.member` wlkeys) + pure $ blacklisted || not whitelisted let acceptAnnounce p d = do case accptAnn of