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

wtf

This commit is contained in:
Dmitry Zuikov 2023-01-21 16:00:26 +03:00
parent d5ea301ffc
commit 1bdf9e58ae
2 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hbs2-core/lib/HBS2/Actors/ChunkWriter.hs
View File

@ -40,7 +40,10 @@ newtype ChunkId = ChunkId FilePath
deriving newtype (IsString) deriving newtype (IsString)
deriving stock (Eq,Ord,Show) deriving stock (Eq,Ord,Show)
data ChunkWriter h m = forall a . (MonadIO m, Storage a h ByteString m, Block ByteString ~ ByteString) => data ChunkWriter h m = forall a . ( MonadIO m
, Storage a h ByteString m
, Block ByteString ~ ByteString
) =>
ChunkWriter ChunkWriter
{ pipeline :: Pipeline m () { pipeline :: Pipeline m ()
, dir :: FilePath , dir :: FilePath
@ -57,7 +60,7 @@ runChunkWriter w = do
stopChunkWriter :: MonadIO m => ChunkWriter h m -> m () stopChunkWriter :: MonadIO m => ChunkWriter h m -> m ()
stopChunkWriter w = stopPipeline ( pipeline w ) stopChunkWriter w = stopPipeline ( pipeline w )
newChunkWriterIO :: forall h a m . ( Key h ~ Hash h newChunkWriterIO :: forall h a m . ( Key h ~ Hash h, h ~ HbSync
, Storage a h ByteString m , Storage a h ByteString m
, Block ByteString ~ ByteString , Block ByteString ~ ByteString
, MonadIO m , MonadIO m
@ -155,6 +158,7 @@ getHash w salt h = liftIO do
commitBlock :: forall salt h m . commitBlock :: forall salt h m .
( Hashable salt ( Hashable salt
, Hashed h ByteString , Hashed h ByteString
, Block ByteString ~ ByteString
, MonadIO m , MonadIO m
, Pretty (Hash h) , Pretty (Hash h)
) )

14
hbs2-tests/test/Peer2Main.hs
View File

@ -161,11 +161,11 @@ makeResponse h = AnyProtocol { myProtoId = natVal (Proxy @(ProtocolId p))
data PeerEnv e = data PeerEnv e =
PeerEnv PeerEnv
{ _envSelf :: Peer e { _envSelf :: Peer e
, _envFab :: Fabriq e , _envFab :: Fabriq e
, _envStorage :: AnyStorage , _envStorage :: AnyStorage
, _envDeferred :: Pipeline IO () , _envDeferred :: Pipeline IO ()
, _envSessions :: Cache SKey Dynamic , _envSessions :: Cache SKey Dynamic
} }
newtype PeerM e m a = PeerM { fromPeerM :: ReaderT (PeerEnv e) m a } newtype PeerM e m a = PeerM { fromPeerM :: ReaderT (PeerEnv e) m a }
@ -374,8 +374,8 @@ runTestPeer p zu = do
let opts = [ StoragePrefix dir let opts = [ StoragePrefix dir
] ]
stor <- simpleStorageInit @_ @_ @HbSync opts stor <- simpleStorageInit opts
cww <- newChunkWriterIO stor (Just chDir) cww <- newChunkWriterIO stor (Just chDir)
sw <- liftIO $ async $ simpleStorageWorker stor sw <- liftIO $ async $ simpleStorageWorker stor
cw <- liftIO $ async $ runChunkWriter cww cw <- liftIO $ async $ runChunkWriter cww