diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal index 6dfde22f..d5544848 100644 --- a/hbs2-core/hbs2-core.cabal +++ b/hbs2-core/hbs2-core.cabal @@ -122,6 +122,7 @@ library , HBS2.Prelude , HBS2.Prelude.Plated , HBS2.Storage + , HBS2.Storage.AdHocStorage , HBS2.Storage.Operations.Class , HBS2.Storage.Operations.ByteString , HBS2.Storage.Operations.Missed diff --git a/hbs2-core/lib/HBS2/Storage/AdHocStorage.hs b/hbs2-core/lib/HBS2/Storage/AdHocStorage.hs new file mode 100644 index 00000000..19ed48b1 --- /dev/null +++ b/hbs2-core/lib/HBS2/Storage/AdHocStorage.hs @@ -0,0 +1,32 @@ +{-| +Обёртка над AnyStorage чтобы в рантайме для инстанса Storage подменить +реализацию getBlock. Например на такую, которая будет отправлять ненайденный +блок на закачку. +-} +module HBS2.Storage.AdHocStorage where + +import HBS2.Hash +import HBS2.Prelude.Plated +import HBS2.Storage + +import Data.ByteString.Lazy qualified as LBS +import Data.Kind + +data AdHocStorage (m :: Type -> Type) k b = AdHocStorage + { adHocStorageAnySto :: AnyStorage + , adHocStorageGetBlock :: k -> m (Maybe b) + } + +instance + (MonadIO m) + => Storage (AdHocStorage m (Hash HbSync) LBS.ByteString) HbSync LBS.ByteString m + where + putBlock (AdHocStorage {..}) = putBlock adHocStorageAnySto + enqueueBlock (AdHocStorage {..}) = enqueueBlock adHocStorageAnySto + getBlock (AdHocStorage {..}) = adHocStorageGetBlock + getChunk (AdHocStorage {..}) = getChunk adHocStorageAnySto + hasBlock (AdHocStorage {..}) = hasBlock adHocStorageAnySto + updateRef (AdHocStorage {..}) = updateRef adHocStorageAnySto + getRef (AdHocStorage {..}) = getRef adHocStorageAnySto + delBlock (AdHocStorage {..}) = delBlock adHocStorageAnySto + delRef (AdHocStorage {..}) = delRef adHocStorageAnySto diff --git a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Import.hs b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Import.hs index 1165970b..b076f8aa 100644 --- a/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Import.hs +++ b/hbs2-git/hbs2-git-client-lib/HBS2/Git/Client/Import.hs @@ -15,6 +15,7 @@ import HBS2.Data.Detect (readLogThrow) import HBS2.Merkle.Walk import HBS2.Peer.Proto.LWWRef import HBS2.Storage +import HBS2.Storage.AdHocStorage import HBS2.Storage.Operations.Missed import HBS2.Storage.Operations.ByteString -- import HBS2.Git.Data.GK