StorageClient

... for RPC

hbs2-core/lib/HBS2/Net/Proto/Service.hs

@@ -2,15 +2,16 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE PolyKinds #-}
-module HBS2.Net.Proto.Service where
+module HBS2.Net.Proto.Service
+  ( module HBS2.Net.Proto.Service
+  , module HBS2.Net.Proto.Types
+  ) where
 
 import HBS2.Actors.Peer
 import HBS2.Net.Messaging.Unix
-import HBS2.Net.Proto
+import HBS2.Net.Proto.Types
 import HBS2.Prelude.Plated
 
-import HBS2.System.Logger.Simple
-
 import Codec.Serialise
 import Control.Monad.Reader
 import Control.Monad.Trans.Resource

hbs2-peer/hbs2-peer.cabal

@@ -136,6 +136,7 @@ library
       HBS2.Peer.RPC.API
       HBS2.Peer.RPC.API.Storage
       HBS2.Peer.RPC.Client.Unix
+      HBS2.Peer.RPC.Client.StorageClient
       HBS2.Peer.RPC.Internal.Storage
       HBS2.Peer.RPC.Internal.Types
 

hbs2-peer/lib/HBS2/Peer/RPC/API/Storage.hs

@@ -14,6 +14,7 @@ data RpcStorageHasBlock
 data RpcStorageGetBlock
 data RpcStorageEnqueueBlock
 data RpcStoragePutBlock
+data RpcStorageDelBlock
 data RpcStorageGetChunk
 data RpcStorageGetRef
 data RpcStorageUpdateRef
@@ -23,6 +24,7 @@ type StorageAPI = '[ RpcStorageHasBlock
                    , RpcStorageGetBlock
                    , RpcStorageEnqueueBlock
                    , RpcStoragePutBlock
+                   , RpcStorageDelBlock
                    , RpcStorageGetChunk
                    , RpcStorageGetRef
                    , RpcStorageUpdateRef

hbs2-peer/lib/HBS2/Peer/RPC/Client/StorageClient.hs

@@ -0,0 +1,63 @@
+{-# Language AllowAmbiguousTypes #-}
+{-# Language UndecidableInstances #-}
+module HBS2.Peer.RPC.Client.StorageClient
+  ( Storage(..)
+  , StorageClient(..)
+  ) where
+
+import HBS2.Prelude.Plated
+
+import HBS2.Hash
+import HBS2.Data.Types.Refs (HashRef(..),refAlias)
+import HBS2.Net.Proto.Service
+import HBS2.Storage
+
+import HBS2.Peer.RPC.Internal.Storage()
+
+import HBS2.Peer.RPC.API.Storage
+
+import Data.Functor
+import Data.ByteString.Lazy (ByteString)
+import Data.Either
+
+newtype StorageClient e =
+  StorageClient { fromStorageClient :: ServiceCaller StorageAPI e }
+
+instance ( MonadIO m
+         , HasProtocol e (ServiceProto StorageAPI e)
+         )
+  => Storage (StorageClient e) HbSync ByteString m where
+
+  putBlock s lbs = liftIO do
+    callService @RpcStoragePutBlock @StorageAPI (fromStorageClient s) lbs
+      <&> either (const Nothing) (fmap fromHashRef)
+
+  enqueueBlock s lbs = liftIO do
+    callService @RpcStorageEnqueueBlock @StorageAPI (fromStorageClient s) lbs
+      <&> either (const Nothing) (fmap fromHashRef)
+
+  getBlock s key = liftIO do
+    callService @RpcStorageGetBlock (fromStorageClient s) (HashRef key)
+      <&> fromRight Nothing
+
+  getChunk s k off size = liftIO do
+    callService @RpcStorageGetChunk (fromStorageClient s) (HashRef k,  off, size)
+      <&> fromRight Nothing
+
+  hasBlock s k = liftIO do
+    callService @RpcStorageHasBlock (fromStorageClient s) (HashRef k)
+      <&> fromRight Nothing
+
+  delBlock s h = liftIO do
+    void $ callService @RpcStorageDelBlock (fromStorageClient s) (HashRef h)
+
+  updateRef s ref v = liftIO do
+    void $ callService @RpcStorageUpdateRef (fromStorageClient s) (refAlias ref, HashRef v)
+
+  getRef s ref = liftIO do
+    callService @RpcStorageGetRef (fromStorageClient s) (refAlias ref)
+      <&> either (const Nothing) (fmap fromHashRef)
+
+  delRef s ref = liftIO do
+    void $ callService @RpcStorageDelRef (fromStorageClient s) (refAlias ref)
+

hbs2-peer/lib/HBS2/Peer/RPC/Internal/Storage.hs

@@ -16,7 +16,6 @@ import HBS2.Peer.RPC.API.Storage
 
 import HBS2.Net.Proto.Service
 
-import HBS2.Peer.RPC.Internal.Types
 
 import Data.Functor
 import Data.ByteString.Lazy ( ByteString )
@@ -56,6 +55,14 @@ instance (StorageContext m) => HandleMethod m RpcStoragePutBlock where
     sto <- getStorage
     liftIO $ putBlock sto lbs <&> fmap HashRef
 
+instance (StorageContext m) => HandleMethod m RpcStorageDelBlock where
+  type instance Input RpcStorageDelBlock = HashRef
+  type instance Output RpcStorageDelBlock = ()
+
+  handleMethod href = do
+    sto <- getStorage
+    liftIO $ delBlock sto (fromHashRef href)
+
 instance (StorageContext m) => HandleMethod m RpcStorageGetChunk where
   type instance Input RpcStorageGetChunk = (HashRef, Offset, Size)
   type instance Output RpcStorageGetChunk = Maybe ByteString

hbs2-tests/test/StorageServiceTest.hs

@@ -2,6 +2,7 @@
 module Main where
 
 import HBS2.Hash
+import HBS2.Base58
 import HBS2.Actors.Peer
 import HBS2.Data.Types.Refs
 import HBS2.Net.Messaging.Unix
@@ -13,6 +14,7 @@ import HBS2.Peer.RPC.Client.Unix
 
 import HBS2.Peer.RPC.Class
 import HBS2.Peer.RPC.Internal.Storage()
+import HBS2.Peer.RPC.Client.StorageClient
 
 import HBS2.OrDie
 
@@ -91,19 +93,28 @@ main = do
 
     withRPC2 @StorageAPI soname $ \caller -> do
 
+      let cto = StorageClient caller
+
       info "does it work?"
 
       size <- callService @RpcStorageHasBlock caller (HashRef h1) `orDie` "can't read block"
 
-      info $ "got block size: " <+> pretty size
+      size2 <- hasBlock cto h1
+
+      info $ "got block size: " <+> pretty size <+> pretty size2
 
       assertBool "block-size-1" (size == Just (fromIntegral $ LBS.length blk1))
 
+      assertBool "block-size-1.1" (fromJust size == fromJust size2)
+
       b <-  callService @RpcStorageGetBlock caller (HashRef h1) `orDie` "can't read block"
 
-      info $ "got block" <+> viaShow b
+      b1 <- getBlock cto h1 `orDie` "cant read  block via storage"
+
+      info $ "got block (0)" <+> viaShow b <+> viaShow b1
 
       assertBool "block-eq-1" ( b == Just blk1 )
+      assertBool "block-eq-1.1" ( b1 == blk1 )
 
       let pechen = "PECHENTERSKI"
 
@@ -113,11 +124,20 @@ main = do
 
       let hh2  = fromJust h2
 
+      let jopakita = "JOPAKITA"
+      h3 <- putBlock cto jopakita `orDie` "cant store block via client storage"
+
+      blk3 <- getBlock cto h3 `orDie` "cant read block via client storage"
+
+      info $ "stored block value" <+> viaShow jopakita <+> viaShow blk3
+
       blk2 <- callService @RpcStorageGetBlock caller hh2 `orDie` "block lookup failed"
 
       info $ "stored block value:" <+> viaShow blk2
 
-      assertBool "block-eq-2" (Just pechen == blk2)
+      assertBool "block-eq-2.1" (Just pechen == blk2)
+
+      assertBool "block-eq-2.2" (jopakita == blk3)
 
       let rk2 = refAlias rk1
 
@@ -141,6 +161,19 @@ main = do
 
       assertBool "ref-alias-works-2" (fromJust rk4val == fromHashRef hh2)
 
+      updateRef cto (SomeRefKey jopakita) h3
+
+      vjopa <- getRef cto (SomeRefKey jopakita)
+
+      info $ "refkey via client storage" <+> pretty vjopa <+> pretty h3
+
+      assertBool "ref-alias-works-3" (vjopa == Just h3)
+
+      pure ()
+
+
+
+
   setLoggingOff @DEBUG
   setLoggingOff @INFO