mirror of https://github.com/voidlizard/hbs2
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
This commit is contained in:
Dmitry Zuikov
parent
6ed1605841
commit
79efb093bf
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -87,6 +87,8 @@ instance SerialisedCredentials e => Serialise (PeerCredentials e)
|
|||
|
||||
newtype AsCredFile a = AsCredFile a
|
||||
|
||||
|
||||
|
||||
-- FIXME: integration-regression-test-for-keyring
|
||||
-- Добавить тест: сгенерировали keypair/распарсили keypair
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
@ -63,18 +63,44 @@ data RefChanHeadBlock e =
|
|||
, _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
|
||||
|
||||
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
|
||||
<>
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
||||
|
||||
38
hbs2/Main.hs
38
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue