From 69f612e5fce250df881995f94fa4608e33ce5e35 Mon Sep 17 00:00:00 2001
From: Sergey Ivanov <ivanovs-4@yandex.ru>
Date: Mon, 12 Feb 2024 15:36:34 +0400
Subject: [PATCH] Add brains-db config parameter

---
 hbs2-peer/app/Brains.hs     | 18 ++++++++++++------
 hbs2-peer/app/PeerConfig.hs |  4 ++++
 2 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/hbs2-peer/app/Brains.hs b/hbs2-peer/app/Brains.hs
index d04c0874..282ccbfb 100644
--- a/hbs2-peer/app/Brains.hs
+++ b/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:"
diff --git a/hbs2-peer/app/PeerConfig.hs b/hbs2-peer/app/PeerConfig.hs
index 02a5c506..464fea18 100644
--- a/hbs2-peer/app/PeerConfig.hs
+++ b/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"