Move AdHocStorage to separate module

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

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

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