From 79efb093bf5977e1481f85be70b66c69315f66d5 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Fri, 24 Nov 2023 05:35:47 +0300 Subject: [PATCH] refchan head with reades - added readers field into refchan head - introduced "sigil" PUBLIC artefact (sign-pk, (encrypt-pk, metadata)) - partial ccompatibility (new version reads older heads, old version wan't read new heads with readers (but will read new heads without readers) - RefChanHeadBlockSmall is to delete in nearest future - RefChanHeadBlock1 is to be a single RefChanHeadBlock - Yes, absense of readers initially was a fuckup - Object's versioning approaches are in their way of tries and failes --- hbs2-core/hbs2-core.cabal | 1 + hbs2-core/lib/HBS2/Net/Auth/Credentials.hs | 2 + .../lib/HBS2/Net/Auth/Credentials/Sigil.hs | 122 ++++++++++++++++++ hbs2-core/lib/HBS2/Net/Proto/RefChan.hs | 64 +++++++-- hbs2-tests/hbs2-tests.cabal | 43 ++++++ hbs2-tests/test/playground/Main.hs | 69 ++++++++++ hbs2/Main.hs | 38 ++++++ 7 files changed, 328 insertions(+), 11 deletions(-) create mode 100644 hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs create mode 100644 hbs2-tests/test/playground/Main.hs diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal index 9b9f9c7c..c0e2fea3 100644 --- a/hbs2-core/hbs2-core.cabal +++ b/hbs2-core/hbs2-core.cabal @@ -96,6 +96,7 @@ library , HBS2.Net.Auth.GroupKeyAsymm , HBS2.Net.Auth.GroupKeySymm , HBS2.Net.Auth.Credentials + , HBS2.Net.Auth.Credentials.Sigil , HBS2.Net.IP.Addr , HBS2.Net.Messaging , HBS2.Net.Messaging.Fake diff --git a/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs b/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs index a7db92a9..8d7fbcd5 100644 --- a/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs +++ b/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs @@ -87,6 +87,8 @@ instance SerialisedCredentials e => Serialise (PeerCredentials e) newtype AsCredFile a = AsCredFile a + + -- FIXME: integration-regression-test-for-keyring -- Добавить тест: сгенерировали keypair/распарсили keypair diff --git a/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs b/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs new file mode 100644 index 00000000..2f08a989 --- /dev/null +++ b/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs @@ -0,0 +1,122 @@ +{-# Language UndecidableInstances #-} +module HBS2.Net.Auth.Credentials.Sigil where + +import HBS2.Prelude +import HBS2.Base58 +import HBS2.Data.Types.Refs +import HBS2.Data.Types.SignedBox +import HBS2.Net.Proto.Types +import Data.List.Split (chunksOf) +import HBS2.Net.Auth.Credentials + +import Codec.Serialise +import Crypto.Saltine.Class qualified as Crypto +import Crypto.Saltine.Class (IsEncoding(..)) +import Control.Monad.Identity +import Control.Monad.Trans.Maybe +import Data.ByteString.Char8 (ByteString) +import Data.ByteString.Char8 qualified as B8 +import Data.ByteString.Lazy.Char8 qualified as LBS +import Data.Maybe +import Lens.Micro.Platform + + +-- | The Sigil data, representing a user identifier in the system. +-- +-- Contains an encryption public key, optional additional information, +-- and a possible reference to an additional information block. + +data SigilData e = + SigilData + { sigilDataEncKey :: PubKey 'Encrypt (Encryption e) + , sigilDataInfo :: Maybe Text + , sigilDataExt :: Maybe HashRef + } + deriving stock (Generic) + + +-- | The 'Sigil' structure, representing an identification artifact in the system. +-- +-- Includes a signature public key and signed 'SigilData', +-- ensuring user authentication and verification. + +data Sigil e = + Sigil + { sigilSignPk :: PubKey 'Sign (Encryption e) + , sigilData :: SignedBox (SigilData e) e + } + deriving stock (Generic) + + +type ForSigil e = ( Serialise (PubKey 'Encrypt (Encryption e)) + , Serialise (PubKey 'Sign (Encryption e)) + , Serialise (Signature (Encryption e)) + , Signatures (Encryption e) + , Hashable (PubKey 'Sign (Encryption e)) + , IsEncoding (PubKey 'Encrypt (Encryption e)) + , Eq (PubKey 'Encrypt (Encryption e)) + , FromStringMaybe (PubKey 'Sign (Encryption e)) + ) + +type ForPrettySigil e = + ( IsEncoding (PubKey 'Encrypt (Encryption e)) + , Pretty (AsBase58 (PubKey 'Sign (Encryption e))) + ) + +instance ForSigil e => Serialise (SigilData e) +instance ForSigil e => Serialise (Sigil e) + + +instance ForPrettySigil e => Pretty (SigilData e) where + pretty s = vcat $ [ parens ("encrypt-pubkey" <+> dquotes epk) + ] <> catMaybes [pinfo, pext] + where + epk = pretty (AsBase58 (Crypto.encode $ sigilDataEncKey s)) + pinfo = sigilDataInfo s >>= \x -> pure $ parens ("info" <+> dquotes (pretty x)) + pext = sigilDataExt s >>= \x -> pure $ parens ("ext" <+> dquotes (pretty x)) + +instance ForPrettySigil e => Pretty (Sigil e) where + pretty s = vcat + [ parens ("sign-pubkey" <+> psk) + ] + where + psk = dquotes (pretty (AsBase58 (sigilSignPk s))) + +-- Nothing, если ключ отсутствует в Credentials +makeSigilFromCredentials :: forall e . ForSigil e + => PeerCredentials (Encryption e) + -> PubKey 'Encrypt (Encryption e) + -> Maybe Text + -> Maybe HashRef + -> Maybe (Sigil e) + +makeSigilFromCredentials cred pk i ha = runIdentity $ runMaybeT do + + let ppk = view peerSignPk cred + let psk = view peerSignSk cred + + ke <- MaybeT $ pure $ headMay [ view krPk x + | x <- view peerKeyring cred + , view krPk x == pk + ] + + let sd = SigilData ke i ha + + let box = makeSignedBox @e ppk psk sd + + let sigil = Sigil + { sigilSignPk = view peerSignPk cred + , sigilData = box + } + + pure sigil + + +instance ForSigil e => Pretty (AsBase58 (Sigil e)) where + pretty (AsBase58 s) = "# sigil file. public data" <> line <> sd + where + sd = vcat $ fmap pretty + $ chunksOf 60 + $ B8.unpack + $ toBase58 (LBS.toStrict $ serialise s) + diff --git a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs index ba795c06..95edca36 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs @@ -57,24 +57,50 @@ type Weight = Integer data RefChanHeadBlock e = RefChanHeadBlockSmall - { _refChanHeadVersion :: Integer - , _refChanHeadQuorum :: Integer - , _refChanHeadWaitAccept :: Integer - , _refChanHeadPeers :: HashMap (PubKey 'Sign (Encryption e)) Weight - , _refChanHeadAuthors :: HashSet (PubKey 'Sign (Encryption e)) + { _refChanHeadVersion :: Integer + , _refChanHeadQuorum :: Integer + , _refChanHeadWaitAccept :: Integer + , _refChanHeadPeers :: HashMap (PubKey 'Sign (Encryption e)) Weight + , _refChanHeadAuthors :: HashSet (PubKey 'Sign (Encryption e)) + } + | RefChanHeadBlock1 + { _refChanHeadVersion :: Integer + , _refChanHeadQuorum :: Integer + , _refChanHeadWaitAccept :: Integer + , _refChanHeadPeers :: HashMap (PubKey 'Sign (Encryption e)) Weight + , _refChanHeadAuthors :: HashSet (PubKey 'Sign (Encryption e)) + , _refChanHeadReaders' :: HashSet (PubKey 'Encrypt (Encryption e)) + , _refChanHeadExt :: ByteString } deriving stock (Generic) -makeLenses 'RefChanHeadBlockSmall +makeLenses ''RefChanHeadBlock + + type ForRefChans e = ( Serialise ( PubKey 'Sign (Encryption e)) , Pretty (AsBase58 (PubKey 'Sign (Encryption e))) , FromStringMaybe (PubKey 'Sign (Encryption e)) + , FromStringMaybe (PubKey 'Encrypt (Encryption e)) , Signatures (Encryption e) , Serialise (Signature (Encryption e)) + , Serialise (PubKey 'Encrypt (Encryption e)) + , Hashable (PubKey 'Encrypt (Encryption e)) , Hashable (PubKey 'Sign (Encryption e)) ) +refChanHeadReaders :: ForRefChans e => Lens (RefChanHeadBlock e) + (RefChanHeadBlock e) + (HashSet (PubKey 'Encrypt (Encryption e))) + (HashSet (PubKey 'Encrypt (Encryption e))) + +refChanHeadReaders = lens g s + where + g (RefChanHeadBlockSmall{}) = mempty + g (RefChanHeadBlock1{..}) = _refChanHeadReaders' + s v@(RefChanHeadBlock1{}) x = v { _refChanHeadReaders' = x } + s x _ = x + instance ForRefChans e => Serialise (RefChanHeadBlock e) type instance SessionData e (RefChanHeadBlock e) = RefChanHeadBlock e @@ -915,11 +941,23 @@ makeProposeTran creds chan box1 = do instance ForRefChans e => FromStringMaybe (RefChanHeadBlock e) where - fromStringMay str = RefChanHeadBlockSmall <$> version - <*> quorum - <*> wait - <*> pure (HashMap.fromList peers) - <*> pure (HashSet.fromList authors) + + fromStringMay str = + case readers of + [] -> RefChanHeadBlockSmall <$> version + <*> quorum + <*> wait + <*> pure (HashMap.fromList peers) + <*> pure (HashSet.fromList authors) + + rs -> RefChanHeadBlock1 <$> version + <*> quorum + <*> wait + <*> pure (HashMap.fromList peers) + <*> pure (HashSet.fromList authors) + <*> pure (HashSet.fromList rs) + <*> pure mempty + where parsed = parseTop str & fromRight mempty version = lastMay [ n | (ListVal [SymbolVal "version", LitIntVal n] ) <- parsed ] @@ -934,6 +972,10 @@ instance ForRefChans e => FromStringMaybe (RefChanHeadBlock e) where | (ListVal [SymbolVal "author", LitStrVal s] ) <- parsed ] + readers = catMaybes [ fromStringMay @(PubKey 'Encrypt (Encryption e)) (Text.unpack s) + | (ListVal [SymbolVal "reader", LitStrVal s] ) <- parsed + ] + instance (ForRefChans e, Pretty (AsBase58 (PubKey 'Sign (Encryption e)))) => Pretty (RefChanHeadBlock e) where pretty blk = parens ("version" <+> pretty (view refChanHeadVersion blk)) <> line <> diff --git a/hbs2-tests/hbs2-tests.cabal b/hbs2-tests/hbs2-tests.cabal index 47b664c8..4f3c6776 100644 --- a/hbs2-tests/hbs2-tests.cabal +++ b/hbs2-tests/hbs2-tests.cabal @@ -903,3 +903,46 @@ executable test-notify , resourcet +executable test-playground + import: shared-properties + default-language: Haskell2010 + + -- other-extensions: + + type: exitcode-stdio-1.0 + hs-source-dirs: test/playground + main-is: Main.hs + build-depends: + base, hbs2-core + , async + , bytestring + , cache + , containers + , directory + , hashable + , microlens-platform + , mtl + , prettyprinter + , QuickCheck + , quickcheck-instances + , random + , safe + , serialise + , stm + , streaming + , tasty + , tasty-quickcheck + , tasty-hunit + , tasty-quickcheck + , transformers + , uniplate + , vector + , saltine + , simple-logger + , string-conversions + , filepath + , temporary + , unliftio + , unordered-containers + , resourcet + diff --git a/hbs2-tests/test/playground/Main.hs b/hbs2-tests/test/playground/Main.hs new file mode 100644 index 00000000..32b37fd5 --- /dev/null +++ b/hbs2-tests/test/playground/Main.hs @@ -0,0 +1,69 @@ +{-# Language RecordWildCards #-} +module Main where + +import HBS2.Prelude +import HBS2.Base58 +import HBS2.OrDie + +import Data.ByteString.Lazy qualified as LBS +import Data.ByteString qualified as BS +import Codec.Serialise +import Lens.Micro.Platform + +-- желаемое поведение: добавить в новую версию A какое-нибудь поле так, +-- что бы предыдущие записи продолжали десериализоваться без этого поля, +-- а новое поле было бы пустым, если его нет -- в новой версии. + + +data A0 = + A0 { a0Int :: Int } + deriving stock (Generic,Show) + +instance Serialise A0 + +data A1 = + A11 { a1Int :: Int } + | A12 { a1Int :: Int, _a1Str :: Maybe String } + deriving stock (Generic,Show) + + +instance Serialise A1 + +a1Str :: Lens A1 A1 (Maybe String) (Maybe String) +a1Str = lens g s + where + g (A11{}) = Nothing + g (A12{..}) = _a1Str + + s x@(A11{}) _ = x + s x@(A12{}) w = x { _a1Str = w } + +-- меняем тип: +-- старая версия ломается точно, голова остаётся той версии, которая была +-- новая версия: должна понимать и старую, и новую голову. +-- + +main :: IO () +main = do + print "1" + let a1 = serialise (A0 22) & deserialiseOrFail @A1 + let a2 = serialise (A11 22) & deserialiseOrFail @A0 + let a3 = serialise (A12 22 (Just "X1")) & deserialiseOrFail @A0 + let a4 = serialise (A12 22 (Just "X1")) & deserialiseOrFail @A1 + + -- let a0bs = serialise (A0 22) :: LBS.ByteString + -- let a1bs = serialise (A1 22) -- & LBS.toStrict & toBase58 + -- let a1 = deserialise @A a1bs + -- let a0 = deserialise @A0 a0bs + + print a1 + print $ a1 <&> view a1Str + print $ a4 <&> view a1Str + print a2 + print a3 + print $ a1 <&> set a1Str (Just "JOPAKITA") + print $ a4 <&> set a1Str (Just "JOPAKITA") + + pure () + + diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 11bd18ca..79e47290 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -4,6 +4,7 @@ import HBS2.Base58 import HBS2.Data.Detect import HBS2.Data.Types import HBS2.Data.Types.EncryptedBox +import HBS2.Data.Types.SignedBox import HBS2.Defaults import HBS2.Merkle import HBS2.Net.Proto.Types @@ -12,6 +13,7 @@ import HBS2.Net.Auth.GroupKeySymm qualified as Symm import HBS2.Net.Auth.GroupKeySymm -- (ToEncrypt(..)) import HBS2.Net.Auth.Credentials +import HBS2.Net.Auth.Credentials.Sigil import HBS2.Net.Proto.Definition() import HBS2.Net.Proto.RefLog(RefLogKey(..)) import HBS2.Net.Proto.AnyRef(AnyRefKey(..)) @@ -538,6 +540,7 @@ main = join . customExecParser (prefs showHelpOnError) $ <> command "keyring-list" (info pKeyList (progDesc "list public keys from keyring")) <> command "keyring-key-add" (info pKeyAdd (progDesc "adds a new keypair into the keyring")) <> command "keyring-key-del" (info pKeyDel (progDesc "removes a keypair from the keyring")) + <> command "sigil" (info pSigil (progDesc "sigil functions")) <> command "show-peer-key" (info pShowPeerKey (progDesc "show peer key from credential file")) <> command "groupkey" (info pGroupKey (progDesc "group key commands")) <> command "reflog" (info pReflog (progDesc "reflog commands")) @@ -837,4 +840,39 @@ main = join . customExecParser (prefs showHelpOnError) $ printHash = void . print . pretty . fst + pSigil = hsubparser ( command "create" (info pCreateSigil (progDesc "create sigil")) + <> command "check" (info pCheckSigil (progDesc "check sigil")) + ) + + pCheckSigil = do + _ <- common + fn <- optional $ strArgument ( metavar "SIGIL-FILE" ) + pure $ do + handle <- maybe1 fn (pure stdin) (flip openFile ReadMode) + sigil <- (BS.hGetContents handle <&> parseSerialisableFromBase58 @(Sigil L4Proto)) + `orDie` "parse sigil failed" + (_,sd) <- pure (unboxSignedBox0 @(SigilData L4Proto) (sigilData sigil)) + `orDie` "signature check failed" + print $ parens ("sigil" <> line <> indent 2 (vcat $ [pretty sigil, pretty sd])) + + pCreateSigil = do + _ <- common + krf <- strOption (long "keyring" <> short 'k' <> help "keyring") + txt <- optional $ strOption ( long "description" <> short 'm' <> help "short sigil information") + href <- optional $ option phref ( long "metadata-ref" <> help "reference to metadata" ) + pk <- argument ppk (metavar "PUBKEY") + pure $ do + sc <- BS.readFile krf + creds <- pure (parseCredentials @(Encryption L4Proto) (AsCredFile sc)) `orDie` "bad keyring file" + sigil <- pure (makeSigilFromCredentials @L4Proto creds pk txt href) + `orDie` "public key not found in credentials file" + print $ pretty (AsBase58 sigil) + + ppk = maybeReader fromStringMay + phref = maybeReader fromStringMay + + + + +