Add brains-db config parameter

hbs2-peer/app/Brains.hs

@@ -720,12 +720,18 @@ newBasicBrains :: forall e m . (Hashable (Peer e), MonadIO m)
                -> m (BasicBrains e)
 
 newBasicBrains cfg = liftIO do
-
-  sdir <- peerStateDirDefault
-
-  liftIO $ createDirectoryIfMissing True sdir
-
-  let stateDb = sdir </> "brains.db"
+  stateDb <-
+      flip runReaderT cfg (cfgValue @PeerBrainsDBPath @(Maybe String))
+          >>= maybe
+              ( do
+                  sdir <- peerStateDirDefault
+                  liftIO $ createDirectoryIfMissing True sdir
+                  pure $ sdir </> "brains.db"
+              )
+              ( \p ->
+                  p <$ do
+                      liftIO $ createDirectoryIfMissing True (takeDirectory p)
+              )
 
   brains <- runReaderT (cfgValue @PeerBrainsDb @(Maybe String)) cfg
               <&> fromMaybe ":memory:"

hbs2-peer/app/PeerConfig.hs

@@ -39,6 +39,7 @@ data PeerDownloadLogKey
 data PeerHttpPortKey
 data PeerTcpProbeWaitKey
 data PeerUseHttpDownload
+data PeerBrainsDBPath
 
 instance Monad m => HasConf (ReaderT PeerConfig m) where
   getConf = asks (\(PeerConfig syn) -> syn)
@@ -55,6 +56,9 @@ instance Monad m => HasCfgKey PeerTcpProbeWaitKey (Maybe Integer) m where
 instance Monad m => HasCfgKey PeerUseHttpDownload b m where
   key = "http-download"
 
+instance Monad m => HasCfgKey PeerBrainsDBPath b m where
+  key = "brains-db"
+
 instance Monad m => HasCfgKey PeerDownloadLogKey (Maybe String) m where
   key = "download-log"