From e7686c44f5f702a264cfc346472d2f5b3194e0b0 Mon Sep 17 00:00:00 2001 From: Sergey Ivanov Date: Tue, 21 Feb 2023 02:38:27 +0400 Subject: [PATCH] wip --- hbs2-core/lib/HBS2/Data/Types/Refs.hs | 78 ++++++++++++++++++++++++++- hbs2-core/lib/HBS2/Prelude.hs | 1 + hbs2/Main.hs | 60 ++++++++++++++++++++- 3 files changed, 136 insertions(+), 3 deletions(-) diff --git a/hbs2-core/lib/HBS2/Data/Types/Refs.hs b/hbs2-core/lib/HBS2/Data/Types/Refs.hs index afd63b5f..b114d535 100644 --- a/hbs2-core/lib/HBS2/Data/Types/Refs.hs +++ b/hbs2-core/lib/HBS2/Data/Types/Refs.hs @@ -1,14 +1,19 @@ +{-# Language DuplicateRecordFields #-} +{-# Language UndecidableInstances #-} module HBS2.Data.Types.Refs ( module HBS2.Data.Types.Refs , serialise ) where -import HBS2.Prelude -import HBS2.Hash import HBS2.Base58 +import HBS2.Hash +import HBS2.Merkle +import HBS2.Net.Auth.Credentials +import HBS2.Prelude import Codec.Serialise(serialise) import Data.Data +import Data.Functor.Identity import Data.String(IsString) import GHC.Generics import Prettyprinter @@ -54,3 +59,72 @@ instance Serialise HashRefObject instance Serialise HashRefPrevState instance Serialise HashRefType +--- + +data RefGenesis e = RefGenesis + { refOwner :: !(PubKey 'Sign e) + , refName :: !Text + , refMeta :: !AnnMetaData + } + +data RefForm + = LinearRef + +--- + +data family Refs e ( f :: RefForm ) + +newtype instance Refs e 'LinearRef + -- List of hashes of stored RefGenesis + = LinearRefs { unLinearRefs :: [Hash HbSync] } + deriving stock (Generic) + +instance Serialise (Refs e 'LinearRef) + +--- + +data family MutableRef e ( f :: RefForm ) + +data instance MutableRef e 'LinearRef + = LinearMutableRef + { lrefId :: !(Hash HbSync) + , lrefHeight :: !Int + -- , lrefMTree :: !(MTreeAnn [Hash HbSync]) + , lrefVal :: !(Hash HbSync) + } + deriving stock (Generic) + +instance Serialise (MutableRef e 'LinearRef) + +--- + +data SignPhase = SignaturePresent | SignatureVerified + +data family Signed ( p :: SignPhase ) a + +data instance Signed SignaturePresent (MutableRef e 'LinearRef) + = LinearMutableRefSigned + { signature :: Signature e + , signedRef :: MutableRef e 'LinearRef + } + deriving stock (Generic) + +instance Serialise (Signature e) => + Serialise (Signed 'SignaturePresent (MutableRef e 'LinearRef)) + +data instance Signed 'SignatureVerified (MutableRef e 'LinearRef) + = LinearMutableRefSignatureVerified + { signature :: Signature e + , signer :: PubKey 'Sign e + , signedRef :: MutableRef e 'LinearRef + } + deriving stock (Generic) + +--- + +nodeLinearRefsRef :: PubKey 'Sign e -> RefGenesis e +nodeLinearRefsRef pk = RefGenesis + { refOwner = pk + , refName = "List of node linear refs" + , refMeta = NoMetaData + } diff --git a/hbs2-core/lib/HBS2/Prelude.hs b/hbs2-core/lib/HBS2/Prelude.hs index 115def9c..16edc920 100644 --- a/hbs2-core/lib/HBS2/Prelude.hs +++ b/hbs2-core/lib/HBS2/Prelude.hs @@ -11,6 +11,7 @@ module HBS2.Prelude , FromStringMaybe(..) , none , module Prettyprinter + , Text.Text ) where import Data.String (IsString(..)) diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 75753377..9f87d900 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -33,7 +33,7 @@ import Data.Functor import Data.List qualified as List import Data.Map.Strict qualified as Map import Data.Monoid qualified as Monoid -import Data.Text (Text) +import Data.Set qualified as Set import Data.UUID qualified as UUID import Data.UUID.V4 qualified as UUID import Options.Applicative @@ -314,6 +314,55 @@ runDumpACB inFile = do acb <- LBS.hGetContents inf <&> deserialise @(ACBSimple UDP) print $ pretty (AsSyntax (DefineACB "a1" acb)) +runNewLRef :: FilePath -> FilePath -> Text -> IO () +runNewLRef nf uf refName = do + hPrint stderr $ "adding a new linear ref" <+> pretty nf <+> pretty uf + nodeCred <- (parseCredentials @UDP . AsCredFile <$> BS.readFile nf) + `orDie` "bad node keyring file" + ownerCred <- (parseCredentials @MerkleEncryptionType . AsCredFile <$> BS.readFile uf) + `orDie` "bad ref owner keyring file" + + -- FIXME: + -- lrh <- создать блок с nodeLinearRefsRef (_ nodeCred) + -- полученный хэш будет хэшем ссылки на список референсов ноды + -- попытаться прочитать эту ссылку + -- h <- создать блок с RefGenesis (_ ownerCred) refName NoMetaData + -- полученный хэш будет хэшем ссылки - канала владельца cownerCred + -- modifyNodeLiearRefList lrh nodeCred $ Set.toList . Set.insert h . Set.fromList + + undefined + +-- modifyNodeLiearRefList :: Hash HbSync -> PeerCredentials e -> ([Hash HbSync] -> [Hash HbSync]) -> IO () +-- modifyNodeLiearRefList h kr f = modifyLinearRef h kr (writeBlock . serialiseList . f . parseList =<< readBlock) + -- = LinearMutableRefSigned + -- { signature :: Signature e + -- , signedRef :: MutableRef e 'LinearRef + +modifyLinearRef :: Hash HbSync -> PeerCredentials e -> (Hash HbSync -> IO (Hash HbSync)) -> IO () +modifyLinearRef h kr modIO = do + -- FIXME: + -- read genesis by h + -- check that owner match pubkey of keyring + -- read reference with simpleReadLinkRaw + -- parse ref as Signed 'SignaturePresent (MutableRef e 'LinearRef) + + -- given + -- LinearMutableRefSigned + -- { signature :: Signature e + -- , signedRef = --:: MutableRef e 'LinearRef + -- LinearMutableRef + -- { lrefId :: !(Hash HbSync) + -- , lrefHeight :: !Int + -- , lrefVal :: !(Hash HbSync) + -- } + -- guard lrefId == h + -- update lrefVal with modIO + -- increment lrefHeight + -- wrap it with LinearMutableRefSigned + -- write with simpleWriteLinkRaw h $ serialise + + undefined + withStore :: Data opts => opts -> ( SimpleStorage HbSync -> IO () ) -> IO () withStore opts f = do xdg <- getXdgDirectory XdgData defStorePath <&> fromString @@ -352,6 +401,10 @@ main = join . customExecParser (prefs showHelpOnError) $ <> command "groupkey-new" (info pNewGroupkey (progDesc "generates a new groupkey")) <> command "acb-gen" (info pACBGen (progDesc "generates binary ACB from text config")) <> command "acb-dump" (info pACBDump (progDesc "dumps binary ACB to text config")) + <> command "lref-new" (info pNewLRef (progDesc "generates a new linear ref")) + -- <> command "lref-add" (info pAddLRef (progDesc "generates a new linear ref")) + -- <> command "lref-list" (info pListLRef (progDesc "list node linear refs")) + -- <> command "lref-del" (info pDelLRef (progDesc "removes a linear ref from node linear ref list")) ) common = do @@ -418,3 +471,8 @@ main = join . customExecParser (prefs showHelpOnError) $ f <- optional $ strArgument ( metavar "ACB-FILE-INPUT" ) pure (runDumpACB f) + pNewLRef = do + nf <- strArgument ( metavar "NODE-KEYRING-FILE" ) + uf <- strArgument ( metavar "REF-OWNER-KEYRING-FILE" ) + refName <- strArgument ( metavar "REF-NAME" ) + pure (runNewLRef nf uf refName)