lwwref proto skeleton

hbs2-peer/app/PeerMain.hs

@@ -16,6 +16,7 @@ import HBS2.Data.Types.Refs
 import HBS2.Data.Types.SignedBox
 import HBS2.Data.Types
 import HBS2.Net.Auth.Credentials
+import HBS2.Net.Auth.Schema()
 import HBS2.Net.IP.Addr
 import HBS2.Net.Messaging.UDP
 import HBS2.Net.Messaging.TCP
@@ -68,6 +69,8 @@ import HBS2.Peer.RPC.API.RefChan
 import HBS2.Peer.Notify
 import HBS2.Peer.RPC.Client.StorageClient
 
+import HBS2.Peer.Proto.LWWRef.Internal
+
 import RPC2(RPC2Context(..))
 
 import Codec.Serialise as Serialise
@@ -614,6 +617,8 @@ respawn opts =
 runPeer :: forall e s . ( e ~ L4Proto
                         , FromStringMaybe (PeerAddr e)
                         , s ~ Encryption e
+                        -- , ForLWWRefProto e
+                        -- , Serialise (PubKey 'Sign (Encryption e))
                         , HasStorage (PeerM e IO)
                         )=> PeerOpts -> IO ()
 
@@ -1043,6 +1048,7 @@ runPeer opts = Exception.handle (\e -> myException e
                     , makeResponse (refChanUpdateProto False pc refChanAdapter)
                     , makeResponse (refChanRequestProto False refChanAdapter)
                     , makeResponse (refChanNotifyProto False refChanAdapter)
+                    , makeResponse lwwRefProto
                     ]
 
 

hbs2-peer/hbs2-peer.cabal

@@ -157,6 +157,8 @@ library
       HBS2.Peer.Proto.RefChan.RefChanNotify
       HBS2.Peer.Proto.RefChan.RefChanUpdate
       HBS2.Peer.Proto.AnyRef
+      HBS2.Peer.Proto.LWWRef
+      HBS2.Peer.Proto.LWWRef.Internal
 
       HBS2.Peer.RPC.Class
       HBS2.Peer.RPC.API.Peer

hbs2-peer/lib/HBS2/Peer/Proto.hs

@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# Language UndecidableInstances #-}
 module HBS2.Peer.Proto
   ( module HBS2.Peer.Proto.PeerMeta
   , module HBS2.Peer.Proto.BlockAnnounce
@@ -27,6 +28,7 @@ import HBS2.Peer.Proto.PeerExchange
 import HBS2.Peer.Proto.RefLog
 import HBS2.Peer.Proto.RefChan hiding (Notify)
 import HBS2.Peer.Proto.AnyRef
+import HBS2.Peer.Proto.LWWRef
 
 import HBS2.Actors.Peer.Types
 import HBS2.Net.Messaging.Unix (UNIX)
@@ -146,6 +148,12 @@ instance HasProtocol L4Proto (RefChanNotify L4Proto) where
   -- возьмем пока 10 секунд
   requestPeriodLim = NoLimit
 
+instance ForLWWRefProto L4Proto => HasProtocol L4Proto (LWWRefProto L4Proto) where
+  type instance ProtocolId (LWWRefProto L4Proto) = 12001
+  type instance Encoded L4Proto = ByteString
+  decode = either (const Nothing) Just . deserialiseOrFail
+  encode = serialise
+  requestPeriodLim = ReqLimPerMessage 1
 
 instance Serialise (RefChanValidate UNIX) => HasProtocol UNIX (RefChanValidate UNIX) where
   type instance ProtocolId (RefChanValidate UNIX) = 0xFFFA0001

hbs2-peer/lib/HBS2/Peer/Proto/LWWRef.hs

@@ -0,0 +1,72 @@
+{-# Language UndecidableInstances #-}
+{-# Language AllowAmbiguousTypes #-}
+module HBS2.Peer.Proto.LWWRef where
+
+import HBS2.Prelude.Plated
+import HBS2.Base58
+import HBS2.Hash
+import HBS2.Data.Types.SignedBox
+import HBS2.Data.Types.Refs
+import HBS2.Net.Proto.Types
+import HBS2.Net.Auth.Schema()
+
+import Data.Hashable hiding (Hashed)
+import Data.Maybe
+import Data.Word
+
+type Epoch = Word64
+
+data LWWRefProtoReq e =
+    LWWProtoGet (LWWRefKey (Encryption e))
+  | LWWProtoSet (SignedBox (LWWRef e) e)
+  deriving stock Generic
+
+
+data LWWRefProto e =
+  LWWRefProto1 (LWWRefProtoReq e)
+  deriving stock (Generic)
+
+data LWWRef e =
+  LWWRef
+  { lwwEpoch :: Epoch
+  , lwwProof :: Maybe HashRef
+  , lwwValue :: HashRef
+  }
+  deriving stock (Generic)
+
+
+type ForLWWRefProto e = (ForSignedBox e, Serialise (LWWRefKey (Encryption e)))
+
+instance ForLWWRefProto e => Serialise (LWWRefProtoReq e)
+instance ForLWWRefProto e => Serialise (LWWRefProto e)
+instance ForLWWRefProto e => Serialise (LWWRef e)
+
+newtype LWWRefKey s =
+  LWWRefKey
+  { lwwRefKey :: PubKey 'Sign s
+  }
+  deriving stock (Generic)
+
+
+deriving stock instance IsRefPubKey s => Eq (LWWRefKey s)
+
+instance IsRefPubKey e => Serialise (LWWRefKey e)
+
+instance IsRefPubKey s => Hashable (LWWRefKey s) where
+  hashWithSalt s k = hashWithSalt s (hashObject @HbSync k)
+
+instance IsRefPubKey s => Hashed HbSync (LWWRefKey s) where
+  hashObject (LWWRefKey pk) = hashObject ("lwwrefkey|" <> serialise pk)
+
+instance IsRefPubKey s => FromStringMaybe (LWWRefKey s) where
+  fromStringMay s = LWWRefKey <$> fromStringMay s
+
+instance IsRefPubKey s =>  IsString (LWWRefKey s) where
+  fromString s = fromMaybe (error "bad public key base58") (fromStringMay s)
+
+instance Pretty (AsBase58 (PubKey 'Sign s )) => Pretty (AsBase58 (LWWRefKey s)) where
+  pretty (AsBase58 (LWWRefKey k)) = pretty (AsBase58 k)
+
+instance Pretty (AsBase58 (PubKey 'Sign s )) => Pretty (LWWRefKey s) where
+  pretty (LWWRefKey k) = pretty (AsBase58 k)
+

hbs2-peer/lib/HBS2/Peer/Proto/LWWRef/Internal.hs

@@ -0,0 +1,49 @@
+module HBS2.Peer.Proto.LWWRef.Internal
+  ( module HBS2.Peer.Proto.LWWRef.Internal
+  , module HBS2.Peer.Proto.LWWRef
+  ) where
+
+import HBS2.Prelude.Plated
+import HBS2.Peer.Proto.LWWRef
+
+import HBS2.Hash
+import HBS2.Clock
+import HBS2.Net.Proto
+import HBS2.Net.Auth.Credentials
+import HBS2.Base58
+import HBS2.Events
+import HBS2.Actors.Peer.Types
+import HBS2.Peer.Proto.Peer
+import HBS2.Net.Proto.Sessions
+import HBS2.Data.Types.Refs
+import HBS2.Misc.PrettyStuff
+
+import HBS2.System.Logger.Simple
+
+import Control.Monad.Trans.Maybe
+import Data.Maybe
+import Data.Hashable hiding (Hashed)
+import Data.ByteString (ByteString)
+import Type.Reflection (someTypeRep)
+import Lens.Micro.Platform
+
+
+lwwRefProto :: forall e s m proto . ( MonadIO m
+                                    , Request e proto m
+                                    , Response e proto m
+                                    , HasDeferred proto e m
+                                    , HasGossip e (LWWRefProto e) m
+                                    , IsPeerAddr e m
+                                    , Pretty (Peer e)
+                                    , Sessions e (KnownPeer e) m
+                                    , Signatures s
+                                    , Pretty (AsBase58 (PubKey 'Sign s))
+                                    , s ~ Encryption e
+                                    , proto ~ LWWRefProto e
+                                    )
+                  => LWWRefProto e -> m ()
+
+lwwRefProto req = do
+  debug $ yellow "lwwRefProto"
+  pure ()
+