From f57b4f29c7c753157ef0a634f36e7d9afe998f41 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Fri, 13 Jan 2023 10:20:44 +0300
Subject: [PATCH] wip

---
 hbs2-core/hbs2-core.cabal                |  3 ++
 hbs2-core/lib/HBS2/Net/Messaging/Fake.hs | 47 ++++++++++++++++++++++++
 2 files changed, 50 insertions(+)
 create mode 100644 hbs2-core/lib/HBS2/Net/Messaging/Fake.hs

diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal
index d6fd7595..b0c5f421 100644
--- a/hbs2-core/hbs2-core.cabal
+++ b/hbs2-core/hbs2-core.cabal
@@ -70,6 +70,7 @@ library
                     , HBS2.Hash
                     , HBS2.Merkle
                     , HBS2.Net.Messaging
+                    , HBS2.Net.Messaging.Fake
                     , HBS2.Net.Proto
                     , HBS2.Net.Proto.Actors.BlockInfo
                     , HBS2.Prelude
@@ -85,6 +86,7 @@ library
                      , base58-bytestring
                      , binary
                      , bytestring
+                     , cache
                      , cborg
                      , clock
                      , containers
@@ -97,6 +99,7 @@ library
                      , prettyprinter
                      , safe
                      , serialise
+                     , stm
                      , text
                      , uniplate
 
diff --git a/hbs2-core/lib/HBS2/Net/Messaging/Fake.hs b/hbs2-core/lib/HBS2/Net/Messaging/Fake.hs
new file mode 100644
index 00000000..c79bcfec
--- /dev/null
+++ b/hbs2-core/lib/HBS2/Net/Messaging/Fake.hs
@@ -0,0 +1,47 @@
+module HBS2.Net.Messaging.Fake
+  ( FakeP2P
+  , newFakeP2P
+  , Messaging(..)
+  ) where
+
+import Control.Concurrent.STM (atomically) -- as STM
+import Control.Concurrent.STM.TChan qualified as Chan
+import Control.Concurrent.STM.TChan (TChan,newTChanIO)
+import Control.Monad.IO.Class
+import Data.Cache (Cache)
+import Data.Cache qualified as Cache
+import Data.List qualified as List
+import Data.Maybe
+
+import HBS2.Net.Proto
+import HBS2.Net.Messaging
+
+data FakeP2P peer msg =
+  FakeP2P
+  {
+    blocking :: Bool
+  , fakeP2p  :: Cache peer (TChan msg)
+  }
+
+newFakeP2P :: Bool -> IO (FakeP2P peer msg)
+newFakeP2P block = FakeP2P block <$> Cache.newCache Nothing
+
+instance ( IsPeer peer
+         ) => Messaging (FakeP2P peer msg) peer msg where
+
+  sendTo bus (To whom) _ msg = liftIO do
+    chan <- Cache.fetchWithCache (fakeP2p bus) whom $ const newTChanIO
+    atomically $ Chan.writeTChan chan msg
+
+  -- NOTE: non-blocking version!
+  receive bus (To me) = liftIO do
+    Cache.fetchWithCache (fakeP2p bus)
+                         me
+                         (const newTChanIO)
+
+                         >>= readChan
+
+    where
+      readChan | blocking bus = atomically . (List.singleton <$>) . Chan.readTChan
+               | otherwise    = atomically . (maybeToList <$>) . Chan.tryReadTChan
+