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

got rid of Block ByteString everywhere

This commit is contained in:
Dmitry Zuikov 2023-07-15 13:03:02 +03:00
parent e4c759a49d
commit 075a28d9bf
10 changed files with 9 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hbs2-core/lib/HBS2/Actors/Peer.hs
View File

@ -180,7 +180,7 @@ instance Monad m => HasPeerLocator e (PeerM e m) where
instance Monad m => HasFabriq e (PeerM e m) where
getFabriq = asks (view envFab)
instance (Block ByteString ~ ByteString, Monad m) => HasStorage (PeerM e m) where
instance (Monad m) => HasStorage (PeerM e m) where
getStorage = asks (view envStorage)
instance Monad m => HasPeerNonce e (PeerM e m) where

6
hbs2-core/lib/HBS2/Actors/Peer/Types.hs
View File

@ -8,7 +8,6 @@ import Control.Monad.Trans.Maybe
import Data.ByteString.Lazy (ByteString)
-- instance (IsKey HbSync, Key HbSync ~ Hash HbSync, Block ByteString ~ ByteString) => Storage AnyStorage HbSync ByteString IO where
instance (IsKey HbSync) => Storage AnyStorage HbSync ByteString IO where
putBlock (AnyStorage s) = putBlock s
enqueueBlock (AnyStorage s) = enqueueBlock s
@ -20,11 +19,10 @@ instance (IsKey HbSync) => Storage AnyStorage HbSync ByteString IO where
delBlock (AnyStorage s) = delBlock s
delRef (AnyStorage s) = delRef s
data AnyStorage = forall zu . ( Block ByteString ~ ByteString
, Storage zu HbSync ByteString IO
data AnyStorage = forall zu . ( Storage zu HbSync ByteString IO
) => AnyStorage zu
class Block ByteString ~ ByteString => HasStorage m where
class HasStorage m where
getStorage :: m AnyStorage

10
hbs2-core/lib/HBS2/Storage.hs
View File

@ -20,8 +20,6 @@ newtype StoragePrefix = StoragePrefix { fromPrefix :: FilePath }
deriving stock (Data,Show)
deriving newtype (IsString,Pretty)
type family Block block :: Type
newtype Offset = Offset Integer
deriving newtype (Eq,Ord,Enum,Num,Real,Integral,Hashable,Pretty)
deriving stock (Show)
@ -35,15 +33,15 @@ class ( Monad m
, Hashed h block
) => Storage a h block m | a -> block, a -> h where
putBlock :: a -> Block block -> m (Maybe (Key h))
putBlock :: a -> block -> m (Maybe (Key h))
enqueueBlock :: a -> Block block -> m (Maybe (Key h))
enqueueBlock :: a -> block -> m (Maybe (Key h))
getBlock :: a -> Key h -> m (Maybe (Block block))
getBlock :: a -> Key h -> m (Maybe block)
delBlock :: a -> Key h -> m ()
getChunk :: a -> Key h -> Offset -> Size -> m (Maybe (Block block))
getChunk :: a -> Key h -> Offset -> Size -> m (Maybe block)
hasBlock :: a -> Key h -> m (Maybe Integer)

3
hbs2-peer/app/BlockDownload.hs
View File

@ -92,7 +92,6 @@ processBlock :: forall e m . ( MonadIO m
, HasStorage m
, MyPeer e
, HasPeerLocator e (BlockDownloadM e m)
, Block ByteString ~ ByteString
)
=> Hash HbSync
-> BlockDownloadM e m ()
@ -412,7 +411,6 @@ blockDownloadLoop :: forall e m . ( m ~ PeerM e IO
, PeerSessionKey e (PeerInfo e)
, HasStorage m
, Pretty (Peer e)
, Block ByteString ~ ByteString
, PeerMessaging e
, IsPeerAddr e m
, HasPeerLocator e m
@ -654,7 +652,6 @@ mkAdapter :: forall e m . ( m ~ PeerM e IO
, Typeable (SessionKey e (BlockChunks e))
, EventEmitter e (BlockChunks e) m
, Pretty (Peer e)
, Block ByteString ~ ByteString
)
=> m (BlockChunksI e (ResponseM e m ))
mkAdapter = do

4
hbs2-peer/app/BlockHttpDownload.hs
View File

@ -66,10 +66,6 @@ blockHttpDownloadLoop :: forall e m .
, PeerSessionKey e (PeerInfo e)
, Pretty (Peer e)
, IsPeerAddr e m
-- FIXME: backlog-do-something-with-that
-- это не ревью, это надо что-то с этим
-- сделать, неудачное решение
, Block LBS.ByteString ~ LBS.ByteString
)
=> DownloadEnv e -> m ()
blockHttpDownloadLoop denv = do

1
hbs2-peer/app/PeerMain.hs
View File

@ -427,7 +427,6 @@ respawn opts = case view peerRespawn opts of
runPeer :: forall e s . ( e ~ L4Proto
, FromStringMaybe (PeerAddr e)
, s ~ Encryption e
, Block ByteString ~ ByteString
) => PeerOpts -> IO ()
runPeer opts = U.handle (\e -> myException e

3
hbs2-peer/app/PeerTypes.hs
View File

@ -111,7 +111,6 @@ type MyPeer e = ( Eq (Peer e)
, Hashable (Peer e)
, Pretty (Peer e)
, HasPeer e
, Block ByteString ~ ByteString
)
data DownloadReq e
@ -150,7 +149,6 @@ type DownloadFromPeerStuff e m = ( MyPeer e
, EventListener e (BlockChunks e) m
, Sessions e (BlockChunks e) m
, Sessions e (PeerInfo e) m
, Block ByteString ~ ByteString
, HasStorage m
)
@ -256,7 +254,6 @@ type DownloadConstr e m = ( MyPeer e
, MonadIO m
, HasPeerLocator e (BlockDownloadM e m)
, HasStorage m -- (BlockDownloadM e m)
, Block ByteString ~ ByteString
)
addDownload :: forall e m . ( DownloadConstr e m

4
hbs2-peer/app/RefChan.hs
View File

@ -90,7 +90,6 @@ refChanNotifyOnUpdated env chan = do
refChanAddDownload :: forall e m . ( m ~ PeerM e IO
, MyPeer e
, Block ByteString ~ ByteString
)
=> RefChanWorkerEnv e -> RefChanId e -> HashRef -> m ()
refChanAddDownload env chan r = do
@ -102,7 +101,7 @@ refChanAddDownload env chan r = do
atomically $ modifyTVar (view refChanWorkerEnvDownload env) (HashMap.insert r (chan,t))
-- FIXME: slow-deep-scan-exception-seems-not-working
checkDownloaded :: forall m . (MonadIO m, HasStorage m, Block ByteString ~ ByteString) => HashRef -> m Bool
checkDownloaded :: forall m . (MonadIO m, HasStorage m) => HashRef -> m Bool
checkDownloaded hr = do
sto <- getStorage
let readBlock h = liftIO $ getBlock sto h
@ -127,7 +126,6 @@ refChanWorker :: forall e s m . ( MonadIO m
, s ~ Encryption e
, IsRefPubKey s
, Pretty (AsBase58 (PubKey 'Sign s))
, Block ByteString ~ ByteString
, ForRefChans e
, m ~ PeerM e IO
)

5
hbs2-storage-simple/lib/HBS2/Storage/Simple.hs
View File

@ -5,7 +5,6 @@ module HBS2.Storage.Simple
( module HBS2.Storage.Simple
, StoragePrefix(..)
, Storage(..)
, Block
) where
import HBS2.Clock
@ -68,9 +67,6 @@ type IsSimpleStorageKey h = ( Eq (Key h)
, FromByteString (AsBase58 (Hash h))
)
type instance Block LBS.ByteString = LBS.ByteString
newtype StorageQueueSize = StorageQueueSize { fromQueueSize :: Int }
deriving stock (Data,Show)
deriving newtype (Eq,Ord,Enum,Num,Integral,Real)
@ -411,7 +407,6 @@ instance ( MonadIO m, IsKey hash
, Hashed hash LBS.ByteString
, Key hash ~ Hash hash
, IsSimpleStorageKey hash
, Block LBS.ByteString ~ LBS.ByteString
)
=> Storage (SimpleStorage hash) hash LBS.ByteString m where

2
hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs
View File

@ -74,7 +74,7 @@ instance SimpleStorageExtra [HashRef] where
pure (MerkleHash root)
instance Block ByteString ~ ByteString => SimpleStorageExtra ByteString where
instance SimpleStorageExtra ByteString where
putAsMerkle ss bs = do
hashes <- S.each (B.unpack bs)