hbs2-peer http-port on by default

hbs2-peer/app/HttpWorker.hs

@@ -116,7 +116,10 @@ httpWorker :: forall e s m . ( MyPeer e
 httpWorker (PeerConfig syn) pmeta = do
 
   sto <- getStorage
-  let port' = runReader (cfgValue @PeerHttpPortKey) syn  <&>  fromIntegral
+
+  let port' = runReader (cfgValue @PeerHttpPortKey @PeerHttpPort) syn
+              & (fmap fromIntegral . coerce)
+
   penv <- ask
 
   maybe1 port' none $ \port -> liftIO do

hbs2-peer/app/PeerConfig.hs

@@ -39,13 +39,16 @@ data PeerTcpProbeWaitKey
 data PeerUseHttpDownload
 data PeerBrainsDBPath
 
+newtype PeerHttpPort = PeerHttpPort (Maybe Integer)
+                       deriving newtype (Pretty)
+
 instance Monad m => HasConf (ReaderT PeerConfig m) where
   getConf = asks (\(PeerConfig syn) -> syn)
 
 instance HasCfgKey PeerListenTCPKey (Maybe String) where
   key = "listen-tcp"
 
-instance HasCfgKey PeerHttpPortKey (Maybe Integer) where
+instance HasCfgKey PeerHttpPortKey b where
   key = "http-port"
 
 instance HasCfgKey PeerTcpProbeWaitKey (Maybe Integer) where
@@ -73,6 +76,19 @@ instance {-# OVERLAPPABLE #-} (HasConf m, HasCfgKey a b) => HasCfgValue a Featur
                 | ListVal (Key s [SymbolVal e]) <- syn, s == key @a @b
                 ]
 
+
+instance {-# OVERLAPPING #-} (HasConf m, HasCfgKey PeerHttpPortKey b, b ~ PeerHttpPort) => HasCfgValue PeerHttpPortKey b m where
+  cfgValue = val <$> getConf
+    where
+      val syn = do
+        let found = lastMay [ v
+                            | ListVal (Key s [v]) <- syn, s == key @PeerHttpPortKey @b
+                            ]
+        case found of
+          Just (TextLike "off")  -> PeerHttpPort Nothing
+          Just (LitIntVal n)     -> (PeerHttpPort (Just n))
+          _                      -> (PeerHttpPort (Just 5005))
+
 cfgName :: FilePath
 cfgName = "config"
 

hbs2-peer/app/PeerMain.hs

@@ -1333,9 +1333,9 @@ runPeer opts = respawnOnError opts $ do
 
   let k = view peerSignPk pc
 
-  let http = case runReader (cfgValue @PeerHttpPortKey @(Maybe Integer)) syn of
-               Nothing -> mempty
-               Just p  -> "http-port:" <+> pretty p
+  let http = case runReader (cfgValue @PeerHttpPortKey @PeerHttpPort) syn of
+               PeerHttpPort Nothing -> mempty
+               PeerHttpPort (Just p)  -> "http-port:" <+> pretty p
 
   let rpc = getRpcSocketName conf
 

hbs2-peer/app/PeerTypes.hs

@@ -43,6 +43,7 @@ import Control.Monad.Trans.Maybe
 import Control.Monad.Reader
 import Control.Monad.Writer qualified as W
 import Data.ByteString.Lazy (ByteString)
+import Data.Coerce
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HashMap
 import Data.List qualified as L
@@ -288,8 +289,10 @@ getKnownPeers  = do
 
 mkPeerMeta :: PeerConfig -> PeerEnv e -> AnnMetaData
 mkPeerMeta (PeerConfig syn) penv = do
+
     let mHttpPort :: Maybe Integer
-        mHttpPort = runReader (cfgValue @PeerHttpPortKey) syn
+        mHttpPort = coerce $ runReader (cfgValue @PeerHttpPortKey @PeerHttpPort) syn
+
     let mTcpPort :: Maybe Word16
         mTcpPort =
           (