From 66d62127a1f79c138e4f7875524984472692c068 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Thu, 19 Jan 2023 07:11:53 +0300 Subject: [PATCH] session reworking wip --- hbs2-tests/test/Main.hs | 42 ++++++++++++++++++++++------------------- 1 file changed, 23 insertions(+), 19 deletions(-) diff --git a/hbs2-tests/test/Main.hs b/hbs2-tests/test/Main.hs index dca36eb1..a87eb0d0 100644 --- a/hbs2-tests/test/Main.hs +++ b/hbs2-tests/test/Main.hs @@ -56,17 +56,24 @@ newtype ChunkNum = ChunkNum Word16 -- FIXME: peer should be a part of the key -- therefore, key is ( p | cookie ) -- but client's cookie in protocol should be just ( cookie :: Word32 ) + +data BlockDownload = + BlockDownload + { _sBlockHash :: Hash HbSync + , _sBlockChunkSize :: ChunkSize + , _sBlockOffset :: Offset + , _sBlockWritten :: Size + } + data Sessions e = Sessions - { _sBlockHash :: Cache (Cookie e) (Hash HbSync) - , _sBlockChunkSize :: Cache (Cookie e) ChunkSize - , _sBlockOffset :: Cache (Cookie e) Offset - , _sBlockWritten :: Cache (Cookie e) Size + { _sBlockDownload :: Cache (Cookie e) BlockDownload , _sBlockSizes :: Cache (Hash HbSync) (Map (Peer e) Size) , _sBlockSize :: Cache (Hash HbSync) Size } makeLenses 'Sessions +makeLenses 'BlockDownload type GetBlockChunk h m = Hash h -> Offset -> Size -> m (Maybe ByteString) @@ -179,9 +186,6 @@ emptySessions = Sessions <$> Cache.newCache (Just defCookieTimeout) <*> Cache.newCache (Just defBlockInfoTimeout) <*> Cache.newCache (Just defBlockInfoTimeout) - <*> Cache.newCache (Just defBlockInfoTimeout) - <*> Cache.newCache (Just defBlockInfoTimeout) - <*> Cache.newCache (Just defBlockInfoTimeout) newSession :: (Eq k, Hashable k,MonadIO m) => s @@ -251,7 +255,7 @@ runFakePeer se env = do BlockChunksI { blkSize = hasBlock storage , blkChunk = getChunk storage - , blkGetHash = getSession se sBlockHash + , blkGetHash = \c -> getSession' se sBlockDownload c (view sBlockHash) --(\BlockDownload{} -> error "AAA") -- КАК ТОЛЬКО ПРИНЯЛИ ВСЕ ЧАНКИ (ПРИШЁЛ ПОСЛЕДНИЙ ЧАНК): -- СЧИТАЕМ ХЭШ ТОГО, ЧТО ПОЛУЧИЛОСЬ @@ -261,24 +265,26 @@ runFakePeer se env = do -- УДАЛЯЕМ КУКУ? , blkAcceptChunk = \(c,p,h,n,bs) -> void $ runMaybeT $ do + let def = BlockDownload h 0 0 0 -- FIXME: ASAP + let chuKey = (p,c) let bslen = fromIntegral $ B8.length bs -- TODO: log this situation mbSize <- MaybeT $ getSession' se sBlockSizes h (Map.lookup p) <&> fromMaybe Nothing - mbChSize <- MaybeT $ getSession se sBlockChunkSize c + mbChSize <- MaybeT $ getSession' se sBlockDownload c (view sBlockChunkSize) let offset = fromIntegral n * fromIntegral mbChSize :: Offset - updSession se offset sBlockOffset c (max offset) + updSession se def sBlockDownload c (over sBlockOffset (max offset)) liftIO $ do -- newBlock cww (p,c) h mbSize writeChunk cww chuKey h offset bs - updSession se 0 sBlockWritten c (+bslen) + updSession se def sBlockDownload c (over sBlockWritten (+bslen)) - maxOff <- MaybeT $ getSession se sBlockOffset c - written <- MaybeT $ getSession se sBlockWritten c + maxOff <- MaybeT $ getSession' se sBlockDownload c (view sBlockOffset) + written <- MaybeT $ getSession' se sBlockDownload c (view sBlockWritten) let mbDone = (maxOff + fromIntegral mbChSize) > fromIntegral mbSize && written >= mbSize @@ -347,12 +353,10 @@ test1 = do let cookie = 0 let s0 = (fst . head) ee - -- getSession' se sBlockSizes h ??? - - withNewSession s0 sBlockHash cookie h $ do - let chsz = defChunkSize - updSession s0 chsz sBlockChunkSize cookie (const chsz) - request p1 (BlockChunks @Fake cookie (BlockGetAllChunks h chsz)) + let chsz = defChunkSize + let def = BlockDownload h 0 0 0 -- FIXME: ASAP!! + updSession s0 def sBlockDownload cookie (set sBlockChunkSize chsz) + request p1 (BlockChunks @Fake cookie (BlockGetAllChunks h chsz)) pure ()