From 33f56c9620d10e3033ddf6951b7872025e31d46e Mon Sep 17 00:00:00 2001
From: Sergey Ivanov <ivanovs-4@yandex.ru>
Date: Thu, 16 Mar 2023 04:44:14 +0400
Subject: [PATCH] ad-hoc lref-update client side implementation

---
 hbs2-peer/app/PeerMain.hs | 27 +++++++++++++++------------
 hbs2-peer/app/RPC.hs      |  9 ++++++---
 2 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index b2b5410b..73aa9a4a 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@@ -826,14 +826,16 @@ runPeer opts = Exception.handle myException $ do
             request who (RPCLRefGetAnswer @e hval)
             debug $ "lrefGetAction sent" <+> pretty h
 
-  let lrefUpdateAction h = do
-        debug $ "lrefUpdateAction" <+> pretty True
-        -- who <- thatPeer (Proxy @(RPC e))
-        -- void $ liftIO $ async $ withPeerM penv $ do
-        -- --     -- st <- getStorage
-        -- --     mlref <- undefined  -- FIXME: lrefUpdateAction
-        -- --     -- request who (RPCLRefUpdateAnswer @e mlref)
-        --     debug $ "lrefUpdateAction sent" <+> pretty h
+  let lrefUpdateAction q@(sk, pk, lrefId, valh) = do
+        debug $ "lrefUpdateAction" <+> viaShow q
+        who <- thatPeer (Proxy @(RPC e))
+        void $ liftIO $ async $ withPeerM penv $ do
+            st <- getStorage
+            let cred = PeerCredentials @e sk pk mempty
+            liftIO $ modifyLinearRef st cred lrefId \_ -> pure valh
+            mlref <- getLRefValAction st lrefId
+            request who (RPCLRefUpdateAnswer @e mlref)
+            debug $ "lrefUpdateAction sent" <+> pretty mlref
 
   let arpc = RpcAdapter
         { rpcOnPoke             = pokeAction
@@ -1032,10 +1034,11 @@ runRpcCommand opt = \case
       -- увеличить счётчик, обновить значение, подписать
       -- выполнить (RPCLRefUpdate lref)
       -- дождаться ответа
-      let
-        lref :: Signed 'SignaturePresent (MutableRef UDP 'LinearRef)
-        lref = undefined
-      withRPC opt (RPCLRefUpdate lref)
+      -- let
+      --   lref :: Signed 'SignaturePresent (MutableRef UDP 'LinearRef)
+      --   lref = undefined
+      -- withRPC opt (RPCLRefUpdate lref)
+      withRPC opt (RPCLRefUpdate sk pk lrefId h)
 
   _ -> pure ()
 
diff --git a/hbs2-peer/app/RPC.hs b/hbs2-peer/app/RPC.hs
index e3e6effb..49f2a011 100644
--- a/hbs2-peer/app/RPC.hs
+++ b/hbs2-peer/app/RPC.hs
@@ -38,7 +38,8 @@ data RPC e =
   | RPCLRefNewAnswer (Hash HbSync)
   | RPCLRefGet (Hash HbSync)
   | RPCLRefGetAnswer (Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)))
-  | RPCLRefUpdate (Signed 'SignaturePresent (MutableRef e 'LinearRef))
+  -- | RPCLRefUpdate (Signed 'SignaturePresent (MutableRef e 'LinearRef))
+  | RPCLRefUpdate (PrivKey 'Sign UDP) (PubKey 'Sign UDP) (Hash HbSync) (Hash HbSync)
   | RPCLRefUpdateAnswer (Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)))
   deriving stock (Generic)
 
@@ -79,7 +80,8 @@ data RpcAdapter e m =
   , rpcOnLRefNewAnswer :: Hash HbSync -> m ()
   , rpcOnLRefGet     :: Hash HbSync -> m ()
   , rpcOnLRefGetAnswer :: Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m ()
-  , rpcOnLRefUpdate  :: (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m ()
+  -- , rpcOnLRefUpdate  :: (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m ()
+  , rpcOnLRefUpdate  :: (PrivKey 'Sign UDP, PubKey 'Sign UDP, Hash HbSync, Hash HbSync) -> m ()
   , rpcOnLRefUpdateAnswer :: Maybe (Signed 'SignaturePresent (MutableRef e 'LinearRef)) -> m ()
   }
 
@@ -135,5 +137,6 @@ rpcHandler adapter = \case
     (RPCLRefNewAnswer h)       -> rpcOnLRefNewAnswer adapter h
     (RPCLRefGet h)             -> rpcOnLRefGet adapter h
     (RPCLRefGetAnswer hval)    -> rpcOnLRefGetAnswer adapter hval
-    (RPCLRefUpdate upd)        -> rpcOnLRefUpdate adapter upd
+    -- (RPCLRefUpdate upd)        -> rpcOnLRefUpdate adapter upd
+    (RPCLRefUpdate sk pk lrefId h) -> rpcOnLRefUpdate adapter (sk, pk, lrefId, h)
     (RPCLRefUpdateAnswer mupd) -> rpcOnLRefUpdateAnswer adapter mupd