From 5df9b43a203911d97d170151e9b17e8817a13a9b Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Wed, 18 Jan 2023 07:39:39 +0300
Subject: [PATCH] wip

---
 hbs2-core/hbs2-core.cabal                     |  3 +-
 hbs2-core/test/Main.hs                        |  2 -
 hbs2-core/test/TestBlockInfoActor.hs          | 43 -------------------
 hbs2-storage-simple/test/TestSimpleStorage.hs |  2 +-
 hbs2-tests/test/Main.hs                       |  4 --
 5 files changed, 2 insertions(+), 52 deletions(-)
 delete mode 100644 hbs2-core/test/TestBlockInfoActor.hs

diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal
index 9e6594ae..adfc05f5 100644
--- a/hbs2-core/hbs2-core.cabal
+++ b/hbs2-core/hbs2-core.cabal
@@ -78,7 +78,7 @@ library
                     , HBS2.Net.Peer
                     , HBS2.Net.Proto
                     , HBS2.Net.Proto.Types
-                    , HBS2.Net.Proto.Actors.BlockInfo
+                    , HBS2.Net.Proto.BlockInfo
                     , HBS2.Prelude
                     , HBS2.Prelude.Plated
                     , HBS2.Storage
@@ -122,7 +122,6 @@ test-suite test
 
     other-modules:  TestFakeMessaging
                   , TestActors
-                  , TestBlockInfoActor
                   , TestUniqProtoId
                   , FakeMessaging
                   , HasProtocol
diff --git a/hbs2-core/test/Main.hs b/hbs2-core/test/Main.hs
index 5186bac5..81fa1bf1 100644
--- a/hbs2-core/test/Main.hs
+++ b/hbs2-core/test/Main.hs
@@ -2,7 +2,6 @@ module Main where
 
 import TestFakeMessaging
 import TestActors
-import TestBlockInfoActor
 import TestUniqProtoId
 
 import Test.Tasty
@@ -15,7 +14,6 @@ main =
       [
         testCase "testFakeMessaging1" testFakeMessaging1
       , testCase "testActorsBasic" testActorsBasic
-      , testCase "testBlockInfoActor" testBlockInfoActor
       , testCase "testUniqProtoId" testUniqProtoId
       ]
 
diff --git a/hbs2-core/test/TestBlockInfoActor.hs b/hbs2-core/test/TestBlockInfoActor.hs
deleted file mode 100644
index 43246e94..00000000
--- a/hbs2-core/test/TestBlockInfoActor.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-module TestBlockInfoActor where
-
-import HBS2.Hash
-import HBS2.Clock
-import HBS2.Net.Proto
-import HBS2.Net.Proto.Actors.BlockInfo
-import HBS2.Net.PeerLocator
-import HBS2.Net.PeerLocator.Static
-
-import FakeMessaging
-import HasProtocol
-
-import Test.Tasty.HUnit
-
-import Test.QuickCheck
-import Data.Word
-import Data.ByteString qualified as B
-import Control.Concurrent.Async
-
-
-testBlockInfoActor :: IO ()
-testBlockInfoActor = do
-
-
-  np <- newStaticPeerLocator @Fake [1..10]
-
-  a <- createBlockInfoActor (AnyPeerLocator np)
-  actor <- async $ runBlockInfoActor a
-
-  let obj = shrink [0x00 .. 0xFF] :: [[Word8]]
-
-  forConcurrently_ obj $ \x -> do
-    requestBlockInfo @Fake a Nothing (hashObject (B.pack x) :: Hash HbSync)
-
-  pause ( 1 :: Timeout 'Seconds)
-
-  stopBlockInfoActor a
-
-  waitAnyCatchCancel [actor]
-
-  assertBool "testBlockInfoActor" True
-
-
diff --git a/hbs2-storage-simple/test/TestSimpleStorage.hs b/hbs2-storage-simple/test/TestSimpleStorage.hs
index 6d59ae3f..125bfc76 100644
--- a/hbs2-storage-simple/test/TestSimpleStorage.hs
+++ b/hbs2-storage-simple/test/TestSimpleStorage.hs
@@ -61,7 +61,7 @@ testSimpleStorageErrors = do
 
             assertBool "nothing written" (isNothing key)
 
-            here <- hasBlock storage strKey
+            here <- hasBlock storage strKey <&> isJust
 
             assertBool "nothing written, again" (not here)
 
diff --git a/hbs2-tests/test/Main.hs b/hbs2-tests/test/Main.hs
index d62bb442..5c52cf98 100644
--- a/hbs2-tests/test/Main.hs
+++ b/hbs2-tests/test/Main.hs
@@ -77,15 +77,11 @@ blockSizeProto :: forall e m  . ( MonadIO m
 blockSizeProto getBlockSize evHasBlock =
   \case
     GetBlockSize h -> do
-      -- TODO: STORAGE: seek for block
-      -- TODO: defer answer (?)
-      -- TODO: does it really work?
       deferred (Proxy @(BlockSize e))$ do
         getBlockSize h >>= \case
           Just size -> response (BlockSize @e h size)
           Nothing   -> response (NoBlock @e h)
 
-      -- deferred (Proxy @(BlockSize e)) $ do
     NoBlock h       -> do
       that <- thatPeer (Proxy @(BlockSize e))
       evHasBlock ( that, h, Nothing )