merged PR#4dMi3uox8r whitelist-config-option

.fixme/log

@@ -0,0 +1,2 @@
+
+(fixme-set "workflow" "test" "4dMi3uox8r")

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 whs = cfgValue @PeerWhiteListKey conf :: Set String
-  let blkeys = Set.fromList
+  let toKeys xs = Set.fromList
-                    $ catMaybes [ fromStringMay x | x <- Set.toList bls
+                    $ 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