voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

fixed FHMMGPm8Kh hbs2-create-acb

This commit is contained in:
Dmitry Zuikov 2023-02-17 13:35:21 +03:00
parent f21e79a8d7
commit 124ad73b1f
13 changed files with 440 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.fixme/log
View File

@ -176,4 +176,7 @@ fixme-set "workflow" "wip" "HEsUhP3CJN"
fixme-set "assigned" "voidlizard" "HEsUhP3CJN"
fixme-set "workflow" "test" "DZyVAuBYzB"
fixme-set "workflow" "wip" "FHMMGPm8Kh"
fixme-set "assigned" "voidlizard" "FHMMGPm8Kh"
fixme-set "assigned" "voidlizard" "FHMMGPm8Kh"
fixme-set "workflow" "backlog" "85K2wQFt2z"
fixme-set "workflow" "backlog" "HwCVP8sL7m"
fixme-set "workflow" "test" "FHMMGPm8Kh"

14
docs/devlog.md
View File

@ -1,6 +1,20 @@
## 2023-02-17
TODO: extract-hbs2-core
```
$$$ (set workflow backlog)
```
Оставить в hbs2-core только реализацию
Messaging и Peer.
Сам протокол вынести в отдельный пакет,
так, что бы на hbs2-core можно было реализовывать
самые различные протоколы.
TODO: hbs2-print-acb
TODO: hbs2-create-acb

65
docs/drafts/pep-02-acb.md
View File

@ -25,28 +25,18 @@ Curve25519 (?), т.е ключевую пару асимметричного ш
```
-- PubKey 'Sign e ;;; ключ подписи Ed25519
data family ACB ( s :: EncryptionSchema ) e
data ACBSchema = NaClAsymm
data family ACB e (schema :: ACBSchema) :: Type
data family AccessKey e schema :: Type
data instance ACB e 'NaClAsymm =
ACBNaClAsymm
{ acbParent :: HashRef -- указатель на предыдущий ACB
, acbRoot :: PubKey 'Sign e -- корневой владелец
, acbOwners :: [PubKey 'Sign e] -- ключи владельцев
, acbRead :: [(PubKey 'Sign e, PubKey 'Encrypt e)]
-- при чтении нужно расшифровывать и идентифицировать ключ
, acbWrite :: [(PubKey 'Sign e)]
-- при публикации нужно проверять подпись
data instance ACB 'NaClAsymm e =
ACB1
{ _acbRoot :: !(Maybe (PubKey 'Sign e))
, _acbOwners :: ![PubKey 'Sign e]
, _acbReaders :: ![PubKey 'Encrypt e]
, _acbWriters :: ![PubKey 'Sign e]
, _acbPrev :: !(Maybe HashRef)
}
```
Что бы подписчик мог что-то публиковать (write), мы должны знать его
@ -62,18 +52,6 @@ ACB не является закрытой информацией и может
подписи.
```
-- EncryptedBox - обертка вокруг ключа ассиметричного шифрования
-- (KeyPAir)
newtype instance AccessKey e 'NaClAsymm =
AccessKeyNaClAsymm
{ permitted :: [(PubKey 'Sign e, EncryptedBox)]
}
```
Список пар (ключ подписи пользователя, ключ шифрования).
Пара необходима, что бы пользователи за O(1) найти и
расшифровать свой ключ.
@ -111,3 +89,28 @@ newtype instance AccessKey e 'NaClAsymm =
- Расшифровывать этим ключом блоки
## Текстовый формат ACB
Конфигурационный файл следующего вида:
```
define-acb a1 ;; определить acb с идентификатором a1
;; добавить root с ключом "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
acb-root a1 "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
;; добавить owner с ключом "EJgvBg9bL2yKXk3GvZaYJgqpHy5kvpXdtEnAgoi4B5DN"
acb-owner a1 "EJgvBg9bL2yKXk3GvZaYJgqpHy5kvpXdtEnAgoi4B5DN"
;; добавить читателя с ключом
acb-reader a1 "5k9rLmFdXCP4RncG9WHEaXXEjxvnxmBvvMUqcKkoY45q"
;; добавить писателя с ключом
acb-writer a1 "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
```

59
docs/notes/hbs2-create-acb.txt Normal file
View File

@ -0,0 +1,59 @@
NOTE: hbs2-create-acb
Config example:
---------------
```
define-acb a1
acb-root a1 "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
acb-owner a1 "EJgvBg9bL2yKXk3GvZaYJgqpHy5kvpXdtEnAgoi4B5DN"
acb-owner a1 "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
acb-reader a1 "5k9rLmFdXCP4RncG9WHEaXXEjxvnxmBvvMUqcKkoY45q"
acb-reader a1 "FpZbzEbdFBztGUSXy5yCoWgkYUbJYDuCmSVxFTTrHx7D"
acb-writer a1 "EJgvBg9bL2yKXk3GvZaYJgqpHy5kvpXdtEnAgoi4B5DN"
acb-writer a1 "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
```
Usage example:
--------------
```
cat > test-acb.cfg
define-acb a1
acb-root a1 "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
acb-owner a1 "EJgvBg9bL2yKXk3GvZaYJgqpHy5kvpXdtEnAgoi4B5DN"
acb-owner a1 "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
acb-reader a1 "5k9rLmFdXCP4RncG9WHEaXXEjxvnxmBvvMUqcKkoY45q"
acb-reader a1 "FpZbzEbdFBztGUSXy5yCoWgkYUbJYDuCmSVxFTTrHx7D"
acb-writer a1 "EJgvBg9bL2yKXk3GvZaYJgqpHy5kvpXdtEnAgoi4B5DN"
acb-writer a1 "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
^D
hbs2 acb-gen ./test-acb.cfg > acb.bin
hbs2 acb-dump ./acb.bin
```
Config syntax
-------------
```
define-acb xxx ;; defines an acb with local id xxx
acb-root xxx key ;; adds key as root's key for acb xxx
acb-owner xxx key ;; adds key as owner's key for acb xxx
acb-reader xxx key ;; adds reader
acb-writer xxx key ;; adds writer
acb-prev xxx hash ;; sets hash as prev. acb for acb xxx
```
Note, that xxx is only a local id. It does not make any
sense outside the acb config file

2
hbs2-core/hbs2-core.cabal
View File

@ -85,6 +85,7 @@ library
, HBS2.Net.PeerLocator
, HBS2.Net.PeerLocator.Static
, HBS2.Net.Proto
, HBS2.Net.Proto.ACB
, HBS2.Net.Proto.BlockAnnounce
, HBS2.Net.Proto.BlockChunks
, HBS2.Net.Proto.BlockInfo
@ -140,6 +141,7 @@ library
, split
, stm
, stm-chans
, suckless-conf
, temporary
, text
, transformers

10
hbs2-core/lib/HBS2/Data/Types.hs
View File

@ -1,12 +1,18 @@
module HBS2.Data.Types
( module HBS2.Hash
, module HBS2.Data.Types.Refs
, module HBS2.Data.Types.Crypto
-- , module HBS2.Data.Types.Crypto
, AsSyntax(..)
)
where
import HBS2.Hash
import HBS2.Data.Types.Refs
import HBS2.Data.Types.Crypto
-- import HBS2.Data.Types.Crypto
-- import Data.Config.Suckless
-- newtype FromSyntax c = FromSyntax [Syntax c]
newtype AsSyntax c = AsSyntax c

9
hbs2-core/lib/HBS2/Data/Types/Refs.hs
View File

@ -3,7 +3,9 @@ module HBS2.Data.Types.Refs
, serialise
) where
import HBS2.Prelude
import HBS2.Hash
import HBS2.Base58
import Codec.Serialise(serialise)
import Data.Data
@ -16,6 +18,13 @@ newtype HashRef = HashRef { fromHashRef :: Hash HbSync }
deriving stock (Data,Generic,Show)
instance Pretty (AsBase58 HashRef) where
pretty (AsBase58 x) = pretty x
-- TODO: should be instance Pretty (AsBase58 (Hash HbSync))
instance FromStringMaybe HashRef where
fromStringMay = fmap HashRef . fromStringMay
data HashRefObject = HashRefObject HashRef (Maybe HashRefMetadata)
deriving stock (Data,Show,Generic)

6
hbs2-core/lib/HBS2/Hash.hs
View File

@ -6,6 +6,7 @@ module HBS2.Hash
where
import HBS2.Base58
import HBS2.Prelude (FromStringMaybe(..))
import Codec.Serialise
import Crypto.Hash hiding (SHA1)
@ -69,6 +70,11 @@ instance IsString (Hash HbSync) where
where
doDecode = fromBase58 (BS8.pack s)
instance FromStringMaybe (Hash HbSync) where
fromStringMay s= HbSyncHash <$> doDecode
where
doDecode = fromBase58 (BS8.pack s)
instance Pretty (Hash HbSync) where
pretty (HbSyncHash s) = pretty @String [qc|{toBase58 s}|]

9
hbs2-core/lib/HBS2/Net/Auth/Credentials.hs
View File

@ -153,6 +153,9 @@ instance ( Serialise (PeerCredentials e)
instance Pretty (AsBase58 Sign.PublicKey) where
pretty (AsBase58 pk) = pretty $ B8.unpack $ toBase58 (Crypto.encode pk)
instance Pretty (AsBase58 Encrypt.PublicKey) where
pretty (AsBase58 pk) = pretty $ B8.unpack $ toBase58 (Crypto.encode pk)
-- FIXME: test-from-string-maybe-sign-pub-key
--
instance FromStringMaybe Sign.PublicKey where
@ -161,6 +164,12 @@ instance FromStringMaybe Sign.PublicKey where
de = bs >>= Crypto.decode
bs = fromBase58 (fromString s)
instance FromStringMaybe Encrypt.PublicKey where
fromStringMay s = de
where
de = bs >>= Crypto.decode
bs = fromBase58 (fromString s)
instance Pretty (AsBase58 a) => Pretty (AsCredFile (AsBase58 a)) where
pretty (AsCredFile pc) = "# hbs2 credentials file" <> line
<> "# keep it private" <> line <> line

139
hbs2-core/lib/HBS2/Net/Proto/ACB.hs Normal file
View File

@ -0,0 +1,139 @@
{-# Language TemplateHaskell #-}
{-# Language PatternSynonyms #-}
{-# Language UndecidableInstances #-}
module HBS2.Net.Proto.ACB where
import HBS2.Prelude.Plated
import HBS2.Net.Auth.Credentials
import HBS2.Data.Types.Refs (HashRef)
import HBS2.Base58
import HBS2.Data.Types
import HBS2.Net.Proto.Definition
import HBS2.Net.Auth.AccessKey
import Data.Config.Suckless
import Control.Applicative
import Lens.Micro.Platform
import Codec.Serialise()
import Prettyprinter
import Data.List qualified as L
import Data.Text qualified as Text
import Data.Text (Text)
import Data.Maybe
import Data.Either
data family ACB ( s :: EncryptionSchema ) e
data DefineACB s e = DefineACB Text (ACB s e)
type ACBSimple = ACB 'NaClAsymm
data instance ACB 'NaClAsymm e =
ACB1
{ _acbRoot :: !(Maybe (PubKey 'Sign e)) -- it's monoid. no choice but Maybe
, _acbOwners :: ![PubKey 'Sign e]
, _acbReaders :: ![PubKey 'Encrypt e]
, _acbWriters :: ![PubKey 'Sign e]
, _acbPrev :: !(Maybe HashRef)
}
deriving stock (Generic)
makeLenses 'ACB1
type IsACB e = ( Serialise (PubKey 'Sign e)
, Serialise (PubKey 'Encrypt e)
, Eq (PubKey 'Sign e)
, Eq (PubKey 'Encrypt e)
)
deriving instance IsACB e => Eq (ACBSimple e)
instance IsACB e => Serialise (ACBSimple e)
instance IsACB e => Monoid (ACBSimple e) where
mempty = ACB1 Nothing mempty mempty mempty Nothing
instance IsACB e => Semigroup (ACBSimple e) where
(<>) a b = ACB1 (view acbRoot a <|> view acbRoot b)
(L.nub (view acbOwners a <> view acbOwners b))
(L.nub (view acbReaders a <> view acbReaders b))
(L.nub (view acbWriters a <> view acbWriters b))
(view acbPrev a <|> view acbPrev b)
instance ( Pretty (AsBase58 (PubKey 'Sign e))
, Pretty (AsBase58 (PubKey 'Encrypt e) )
) => Pretty (AsSyntax (DefineACB 'NaClAsymm e)) where
pretty (AsSyntax (DefineACB nacb' acb)) = vcat [
"define-acb" <+> nacb
, prev
, root
, owners
, readers
, writers
, line
]
where
nacb = pretty nacb'
wacb = (<+> nacb)
prev = maybe mempty (dquotes . pretty . AsBase58) (view acbPrev acb)
root = maybe mempty ( (acbR <+>) . dquotes . pretty . AsBase58 ) (view acbRoot acb)
owners = vcat $ fmap owner (view acbOwners acb)
acbR = "acb-root" <+> nacb
readers = vcat $ fmap reader (view acbReaders acb)
writers = vcat $ fmap writer (view acbWriters acb)
owner = (wacb "acb-owner" <+>) . dquotes . pretty . AsBase58
reader = (wacb "acb-reader" <+>) . dquotes . pretty . AsBase58
writer = (wacb "acb-writer" <+>) . dquotes . pretty . AsBase58
pattern Key :: forall {c}. Id -> [Syntax c] -> [Syntax c]
pattern Key n ns <- SymbolVal n : ns
instance FromStringMaybe (ACB 'NaClAsymm e) where
fromStringMay s = Just $ ACB1 root owners readers writers prev
where
parsed = parseTop s & fromRight mempty
defAcb = headMay [ acb | (ListVal (Key "define-acb" [SymbolVal acb]) ) <- parsed ]
root = lastMay $ catMaybes $
[ fromStringMay (Text.unpack e)
| (ListVal (Key "acb-root" [SymbolVal a, LitStrVal e]) ) <- parsed
, Just a == defAcb
]
owners = catMaybes
[ fromStringMay (Text.unpack e)
| (ListVal (Key "acb-owner" [SymbolVal a, LitStrVal e]) ) <- parsed
, Just a == defAcb
]
readers = catMaybes
[ fromStringMay (Text.unpack e)
| (ListVal (Key "acb-reader" [SymbolVal a, LitStrVal e]) ) <- parsed
, Just a == defAcb
]
writers = catMaybes
[ fromStringMay (Text.unpack e)
| (ListVal (Key "acb-writer" [SymbolVal a, LitStrVal e]) ) <- parsed
, Just a == defAcb
]
prev =lastMay $ catMaybes $
[ fromStringMay (Text.unpack e)
| (ListVal (Key "acb-prev" [SymbolVal a, LitStrVal e]) ) <- parsed
, Just a == defAcb
]

50
hbs2-tests/hbs2-tests.cabal
View File

@ -40,6 +40,7 @@ common common-deps
, split
, stm
, streaming
, suckless-conf
, tasty
, tasty-hunit
, temporary
@ -255,3 +256,52 @@ executable test-saltine
, vector
, fast-logger
test-suite test-acb
import: shared-properties
import: common-deps
default-language: Haskell2010
ghc-options:
-- -prof
-- -fprof-auto
other-modules:
-- other-extensions:
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: TestACB.hs
build-depends:
base, hbs2-core
-- , async
-- , attoparsec
-- , bytestring
-- , cache
-- , clock
, containers
-- , data-default
-- , data-textual
-- , directory
-- , hashable
-- , microlens-platform
-- , mtl
-- , mwc-random
-- , network
-- , network-ip
-- , prettyprinter
-- , random
-- , safe
-- , serialise
-- , stm
-- , streaming
-- , saltine
, text
-- , transformers
-- , uniplate
-- , vector
-- , fast-logger

67
hbs2-tests/test/TestACB.hs Normal file
View File

@ -0,0 +1,67 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# Language PatternSynonyms #-}
module Main where
import HBS2.Prelude
import HBS2.Net.Proto.ACB
import HBS2.Data.Types
import HBS2.Net.Auth.Credentials
import HBS2.Net.Proto.Definition
import HBS2.OrDie
-- import HBS2.Net.Messaging.UDP
import Test.Tasty.HUnit
import Data.Config.Suckless
import Data.Maybe
import Prettyprinter
import System.IO
import Lens.Micro.Platform
import Data.Either
import Data.Text qualified as Text
import Safe
data T
type SK = PubKey 'Sign T
main :: IO ()
main = do
let pek1 = fromStringMay "5k9rLmFdXCP4RncG9WHEaXXEjxvnxmBvvMUqcKkoY45q"
let pek2 = fromStringMay "FpZbzEbdFBztGUSXy5yCoWgkYUbJYDuCmSVxFTTrHx7D"
let root = fromStringMay @SK "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
let owners = catMaybes [ fromStringMay "EJgvBg9bL2yKXk3GvZaYJgqpHy5kvpXdtEnAgoi4B5DN" ]
let acb = set acbRoot root
. set acbOwners ( owners <> maybeToList root )
. set acbWriters ( owners <> maybeToList root )
. set acbReaders ( catMaybes [pek1, pek2 ] )
$ mempty :: ACBSimple T
let s = show $ pretty (AsSyntax (DefineACB "a1" acb))
putStrLn s
let macb2 = fromStringMay s :: Maybe (ACBSimple T)
acb2 <- pure macb2 `orDie` "can't load ACB"
print $ pretty (AsSyntax (DefineACB "a1" acb2))
assertBool "1" $ view acbRoot acb == view acbRoot acb2
assertBool "2" $ view acbOwners acb == view acbOwners acb2
assertBool "3" $ view acbReaders acb == view acbReaders acb2
assertBool "4" $ view acbWriters acb == view acbWriters acb2
assertBool "5" $ view acbPrev acb == view acbPrev acb2
assertBool "6" $ acb == acb2
-- TODO: acbPrev test
pure ()

49
hbs2/Main.hs
View File

@ -14,6 +14,7 @@ import HBS2.Prelude.Plated
import HBS2.Storage.Simple
import HBS2.Storage.Simple.Extra
import HBS2.OrDie
import HBS2.Net.Proto.ACB
import Control.Arrow ((&&&))
@ -295,6 +296,24 @@ runShowPeerKey fp = do
maybe1 cred' exitFailure $ \cred -> do
print $ pretty $ AsBase58 (view peerSignPk cred)
runGenACB :: Maybe FilePath -> Maybe FilePath -> IO ()
runGenACB inFile outFile = do
inf <- maybe (pure stdin) (`openFile` ReadMode) inFile
s <- hGetContents inf
acb <- pure (fromStringMay s :: Maybe (ACBSimple UDP)) `orDie` "invalid ACB syntax"
let bin = serialise acb
out <- maybe (pure stdout) (`openFile` WriteMode) outFile
LBS.hPutStr out bin
hClose out
hClose inf
runDumpACB :: Maybe FilePath -> IO ()
runDumpACB inFile = do
inf <- maybe (pure stdin) (`openFile` ReadMode) inFile
acb <- LBS.hGetContents inf <&> deserialise @(ACBSimple UDP)
print $ pretty (AsSyntax (DefineACB "a1" acb))
withStore :: Data opts => opts -> ( SimpleStorage HbSync -> IO () ) -> IO ()
withStore opts f = do
xdg <- getXdgDirectory XdgData defStorePath <&> fromString
@ -321,16 +340,18 @@ main = join . customExecParser (prefs showHelpOnError) $
)
where
parser :: Parser (IO ())
parser = hsubparser ( command "store" (info pStore (progDesc "store block"))
<> command "new-ref" (info pNewRef (progDesc "creates reference"))
<> command "cat" (info pCat (progDesc "cat block"))
<> command "hash" (info pHash (progDesc "calculates hash"))
<> command "keyring-new" (info pNewKey (progDesc "generates a new keyring"))
<> 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 "show-peer-key" (info pShowPeerKey (progDesc "show peer key from credential file"))
<> command "groupkey-new" (info pNewGroupkey (progDesc "generates a new groupkey"))
parser = hsubparser ( command "store" (info pStore (progDesc "store block"))
<> command "new-ref" (info pNewRef (progDesc "creates reference"))
<> command "cat" (info pCat (progDesc "cat block"))
<> command "hash" (info pHash (progDesc "calculates hash"))
<> command "keyring-new" (info pNewKey (progDesc "generates a new keyring"))
<> 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 "show-peer-key" (info pShowPeerKey (progDesc "show peer key from credential file"))
<> 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"))
)
common = do
@ -388,3 +409,11 @@ main = join . customExecParser (prefs showHelpOnError) $
f <- strArgument ( metavar "KEYRING-FILE" )
pure (runKeyDel s f)
pACBGen = do
f <- optional $ strArgument ( metavar "ACB-FILE-INPUT" )
o <- optional $ strArgument ( metavar "ACB-FILE-OUTPUT" )
pure (runGenACB f o)
pACBDump = do
f <- optional $ strArgument ( metavar "ACB-FILE-INPUT" )
pure (runDumpACB f)