From 075a28d9bf74526f0094a91349f6889fbac83c61 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Sat, 15 Jul 2023 13:03:02 +0300 Subject: [PATCH] got rid of Block ByteString everywhere --- hbs2-core/lib/HBS2/Actors/Peer.hs | 2 +- hbs2-core/lib/HBS2/Actors/Peer/Types.hs | 6 ++---- hbs2-core/lib/HBS2/Storage.hs | 10 ++++------ hbs2-peer/app/BlockDownload.hs | 3 --- hbs2-peer/app/BlockHttpDownload.hs | 4 ---- hbs2-peer/app/PeerMain.hs | 1 - hbs2-peer/app/PeerTypes.hs | 3 --- hbs2-peer/app/RefChan.hs | 4 +--- hbs2-storage-simple/lib/HBS2/Storage/Simple.hs | 5 ----- hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs | 2 +- 10 files changed, 9 insertions(+), 31 deletions(-) diff --git a/hbs2-core/lib/HBS2/Actors/Peer.hs b/hbs2-core/lib/HBS2/Actors/Peer.hs index 2aa5fb60..0b778724 100644 --- a/hbs2-core/lib/HBS2/Actors/Peer.hs +++ b/hbs2-core/lib/HBS2/Actors/Peer.hs @@ -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 diff --git a/hbs2-core/lib/HBS2/Actors/Peer/Types.hs b/hbs2-core/lib/HBS2/Actors/Peer/Types.hs index 920481b1..e02739d4 100644 --- a/hbs2-core/lib/HBS2/Actors/Peer/Types.hs +++ b/hbs2-core/lib/HBS2/Actors/Peer/Types.hs @@ -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 diff --git a/hbs2-core/lib/HBS2/Storage.hs b/hbs2-core/lib/HBS2/Storage.hs index 1a4f507d..198418f8 100644 --- a/hbs2-core/lib/HBS2/Storage.hs +++ b/hbs2-core/lib/HBS2/Storage.hs @@ -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) diff --git a/hbs2-peer/app/BlockDownload.hs b/hbs2-peer/app/BlockDownload.hs index 56db73a0..1f4acf23 100644 --- a/hbs2-peer/app/BlockDownload.hs +++ b/hbs2-peer/app/BlockDownload.hs @@ -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 diff --git a/hbs2-peer/app/BlockHttpDownload.hs b/hbs2-peer/app/BlockHttpDownload.hs index e362819f..8a2e91a6 100644 --- a/hbs2-peer/app/BlockHttpDownload.hs +++ b/hbs2-peer/app/BlockHttpDownload.hs @@ -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 diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 1a53ef5c..d372684d 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -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 diff --git a/hbs2-peer/app/PeerTypes.hs b/hbs2-peer/app/PeerTypes.hs index 57e67cde..55e84f0b 100644 --- a/hbs2-peer/app/PeerTypes.hs +++ b/hbs2-peer/app/PeerTypes.hs @@ -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 diff --git a/hbs2-peer/app/RefChan.hs b/hbs2-peer/app/RefChan.hs index 0a8e1eaf..2ae2eac8 100644 --- a/hbs2-peer/app/RefChan.hs +++ b/hbs2-peer/app/RefChan.hs @@ -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 ) diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs index cf39b4f6..d701456c 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs @@ -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 diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs index 0dd8c1c4..bbeee924 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs @@ -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)