voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip

This commit is contained in:
Dmitry Zuikov 2023-01-18 07:39:39 +03:00
parent ac39a3f51d
commit 5df9b43a20
5 changed files with 2 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
hbs2-core/hbs2-core.cabal
View File

@ -78,7 +78,7 @@ library
, HBS2.Net.Peer , HBS2.Net.Peer
, HBS2.Net.Proto , HBS2.Net.Proto
, HBS2.Net.Proto.Types , HBS2.Net.Proto.Types
, HBS2.Net.Proto.Actors.BlockInfo , HBS2.Net.Proto.BlockInfo
, HBS2.Prelude , HBS2.Prelude
, HBS2.Prelude.Plated , HBS2.Prelude.Plated
, HBS2.Storage , HBS2.Storage
@ -122,7 +122,6 @@ test-suite test
other-modules: TestFakeMessaging other-modules: TestFakeMessaging
, TestActors , TestActors
, TestBlockInfoActor
, TestUniqProtoId , TestUniqProtoId
, FakeMessaging , FakeMessaging
, HasProtocol , HasProtocol

2
hbs2-core/test/Main.hs
View File

@ -2,7 +2,6 @@ module Main where
import TestFakeMessaging import TestFakeMessaging
import TestActors import TestActors
import TestBlockInfoActor
import TestUniqProtoId import TestUniqProtoId
import Test.Tasty import Test.Tasty
@ -15,7 +14,6 @@ main =
[ [
testCase "testFakeMessaging1" testFakeMessaging1 testCase "testFakeMessaging1" testFakeMessaging1
, testCase "testActorsBasic" testActorsBasic , testCase "testActorsBasic" testActorsBasic
, testCase "testBlockInfoActor" testBlockInfoActor
, testCase "testUniqProtoId" testUniqProtoId , testCase "testUniqProtoId" testUniqProtoId
] ]

43
hbs2-core/test/TestBlockInfoActor.hs
View File

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

2
hbs2-storage-simple/test/TestSimpleStorage.hs
View File

@ -61,7 +61,7 @@ testSimpleStorageErrors = do
assertBool "nothing written" (isNothing key) assertBool "nothing written" (isNothing key)
here <- hasBlock storage strKey here <- hasBlock storage strKey <&> isJust
assertBool "nothing written, again" (not here) assertBool "nothing written, again" (not here)

4
hbs2-tests/test/Main.hs
View File

@ -77,15 +77,11 @@ blockSizeProto :: forall e m . ( MonadIO m
blockSizeProto getBlockSize evHasBlock = blockSizeProto getBlockSize evHasBlock =
\case \case
GetBlockSize h -> do GetBlockSize h -> do
-- TODO: STORAGE: seek for block
-- TODO: defer answer (?)
-- TODO: does it really work?
deferred (Proxy @(BlockSize e))$ do deferred (Proxy @(BlockSize e))$ do
getBlockSize h >>= \case getBlockSize h >>= \case
Just size -> response (BlockSize @e h size) Just size -> response (BlockSize @e h size)
Nothing -> response (NoBlock @e h) Nothing -> response (NoBlock @e h)
-- deferred (Proxy @(BlockSize e)) $ do
NoBlock h -> do NoBlock h -> do
that <- thatPeer (Proxy @(BlockSize e)) that <- thatPeer (Proxy @(BlockSize e))
evHasBlock ( that, h, Nothing ) evHasBlock ( that, h, Nothing )