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

@@ -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

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
 

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)
+

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

@@ -57,24 +57,50 @@ type Weight = Integer
 
 data RefChanHeadBlock e =
   RefChanHeadBlockSmall
-  { _refChanHeadVersion     :: Integer
+   { _refChanHeadVersion     :: Integer
-  , _refChanHeadQuorum      :: Integer
+   , _refChanHeadQuorum      :: Integer
-  , _refChanHeadWaitAccept  :: Integer
+   , _refChanHeadWaitAccept  :: Integer
-  , _refChanHeadPeers       :: HashMap (PubKey 'Sign (Encryption e)) Weight
+   , _refChanHeadPeers       :: HashMap (PubKey 'Sign (Encryption e)) Weight
-  , _refChanHeadAuthors     :: HashSet (PubKey 'Sign (Encryption e))
+   , _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
+  fromStringMay str =
-                                          <*> wait
+    case readers of
-                                          <*> pure (HashMap.fromList peers)
+      [] -> RefChanHeadBlockSmall <$> version
-                                          <*> pure (HashSet.fromList authors)
+                                  <*> 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
                <>

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
+

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 ()
+
+

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
+
+
+
+
+