wip

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

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
       ]
 

hbs2-core/test/TestBlockInfoActor.hs

@@ -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
-
-

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)
 

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 )