Draft merkle wrapper for encryption (#1)

* Draft merkle wrapper for encryption

* wip encryption

* encryption to check

* Fixes by comments

* Drop keyring, pubkey opts from store command

* Fix wrong deserialise call

* Edit README.md. Add example of store encrypted file

* minor issues found

---------

Co-authored-by: Dmitry Zuikov <dzuikov@gmail.com>
This commit is contained in:
Sergey Ivanov 2023-02-16 09:49:40 +04:00 committed by GitHub
parent d7a41affb7
commit eb43510f23
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 377 additions and 35 deletions

View File

@ -10,3 +10,16 @@ hbs2-peer run -p .peers/1 -k .peers/1/key -l addr:port -r rpcaddr:rpcport
``` ```
## Как сохранять зашифрованный файл
```
keyring-new > kr
keyring-list kr
; создаём файл со списком публичных ключей
; строчки из выхлопа команды keyring-list
groupkey-new path/to/file/with/list/of/pubkeys > groupkey
store --groupkey groupkey file/to/store
; получаем хэш
cat --keyring kr <хэш>
```

View File

@ -1,3 +1,26 @@
## 2023-02-16
FIXME: group-key-is-public
```
cat ./group1.key
# hbs2 groupkey file
# keep it private
```
group key is actually public. it contains
encrypted records
FIXME: group-key-new-brokes-on-empty-line
```
cat pub
3YpCdSGw7BdTVTpaWUMxF1DbWcTwAsH6ai3wRXfvCYx6
./bin/hbs2 groupkey-new ./pub
bad pubkeys file
```
## 2023-02-15 ## 2023-02-15

View File

@ -76,6 +76,7 @@ library
, HBS2.Events , HBS2.Events
, HBS2.Hash , HBS2.Hash
, HBS2.Merkle , HBS2.Merkle
, HBS2.Net.Auth.AccessKey
, HBS2.Net.Auth.Credentials , HBS2.Net.Auth.Credentials
, HBS2.Net.IP.Addr , HBS2.Net.IP.Addr
, HBS2.Net.Messaging , HBS2.Net.Messaging

View File

@ -9,18 +9,21 @@ import Codec.Serialise (deserialiseOrFail)
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)
import Data.Either import Data.Either
import Data.Function import Data.Function
import Data.Functor
data BlobType = Merkle (Hash HbSync) data BlobType = Merkle (Hash HbSync)
| MerkleAnn (MTreeAnn [HashRef])
| AnnRef (Hash HbSync) | AnnRef (Hash HbSync)
| Blob (Hash HbSync) | Blob (Hash HbSync)
deriving (Show,Data) deriving (Show,Data)
tryDetect :: Hash HbSync -> ByteString -> BlobType tryDetect :: Hash HbSync -> ByteString -> BlobType
tryDetect hash obj = rights [mbLink, mbMerkle] & headDef orBlob tryDetect hash obj = rights [mbAnn, mbLink, mbMerkle] & headDef orBlob
where where
mbLink = deserialiseOrFail @AnnotatedHashRef obj >> pure (AnnRef hash) mbLink = deserialiseOrFail @AnnotatedHashRef obj >> pure (AnnRef hash)
mbMerkle = deserialiseOrFail @(MTree [HashRef]) obj >> pure (Merkle hash) mbMerkle = deserialiseOrFail @(MTree [HashRef]) obj >> pure (Merkle hash)
mbAnn = deserialiseOrFail obj <&> MerkleAnn
orBlob = Blob hash orBlob = Blob hash

View File

@ -7,11 +7,12 @@ import HBS2.Hash
import Codec.Serialise import Codec.Serialise
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as LBS
import Data.ByteString qualified as BS import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.Data import Data.Data
import Data.Foldable (traverse_) import Data.Foldable (forM_, traverse_)
import Data.List qualified as List import Data.List qualified as List
import Data.Text (Text)
import GHC.Generics import GHC.Generics
import Lens.Micro.Platform import Lens.Micro.Platform
import Prettyprinter import Prettyprinter
@ -76,6 +77,30 @@ makeLenses ''MNodeData
instance Serialise MNodeData instance Serialise MNodeData
data AnnMetaData = NoMetaData | ShortMetadata Text | AnnHashRef (Hash HbSync)
deriving stock (Generic,Data,Show)
instance Serialise AnnMetaData
data MTreeAnn a = MTreeAnn
{ _mtaMeta :: !AnnMetaData
, _mtaCrypt :: !MTreeEncryption
, _mtaTree :: !(MTree a)
}
deriving stock (Generic,Data,Show)
instance Serialise a => Serialise (MTreeAnn a)
data MerkleEncryptionType
deriving stock (Data)
data MTreeEncryption
= NullEncryption
| CryptAccessKeyNaClAsymm (Hash HbSync)
deriving stock (Generic,Data,Show)
instance Serialise MTreeEncryption
data MTree a = MNode MNodeData [Hash HbSync] | MLeaf a data MTree a = MNode MNodeData [Hash HbSync] | MLeaf a
deriving stock (Generic,Data,Show) deriving stock (Generic,Data,Show)
@ -159,3 +184,13 @@ walkMerkle root flookup sink = walkMerkle' root flookup withTree
(Right (MNode _ _)) -> pure () (Right (MNode _ _)) -> pure ()
Left hx -> sink (Left hx) Left hx -> sink (Left hx)
walkMerkleTree :: (Serialise (MTree a), Monad m)
=> MTree a
-> ( Hash HbSync -> m (Maybe LBS.ByteString) )
-> ( Either (Hash HbSync) a -> m () )
-> m ()
walkMerkleTree tree flookup sink = case tree of
(MLeaf s) -> sink (Right s)
(MNode _ hashes) -> forM_ hashes \h -> walkMerkle h flookup sink

View File

@ -0,0 +1,125 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# Language TemplateHaskell #-}
{-# Language UndecidableInstances #-}
{-# Language AllowAmbiguousTypes #-}
{-# Language ConstraintKinds #-}
module HBS2.Net.Auth.AccessKey where
import HBS2.Base58
import HBS2.Data.Detect
import HBS2.Data.Types
import HBS2.Defaults
import HBS2.Merkle
import HBS2.Net.Auth.Credentials
import HBS2.Net.Messaging.UDP (UDP)
import HBS2.Net.Proto.Definition()
import HBS2.Net.Proto.Types
import HBS2.OrDie
import HBS2.Prelude.Plated
import Codec.Serialise
import Control.Monad ((<=<))
import Crypto.Saltine.Core.Sign (Keypair(..))
import Crypto.Saltine.Core.Sign qualified as Sign
import Crypto.Saltine.Core.Box qualified as Encrypt
import Crypto.Saltine.Class qualified as Crypto
import Crypto.Saltine.Class (IsEncoding)
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.ByteString.Char8 qualified as B8
import Data.ByteString.Char8 (ByteString)
import Data.Function
import Data.List.Split (chunksOf)
import Data.Text (Text)
import Data.List qualified as List
import Lens.Micro.Platform
import Data.Kind
import Prettyprinter
newtype EncryptedBox = EncryptedBox { unEncryptedBox :: ByteString }
deriving stock (Generic)
instance Serialise EncryptedBox
data EncryptionSchema = NaClAsymm
---
data family AccessKey e ( s :: EncryptionSchema )
newtype instance AccessKey e 'NaClAsymm =
AccessKeyNaClAsymm
{ permitted :: [(PubKey 'Encrypt e, EncryptedBox)]
}
deriving stock (Generic)
instance Serialise (AccessKey e 'NaClAsymm)
---
data family GroupKey e ( s :: EncryptionSchema )
data instance GroupKey e 'NaClAsymm =
GroupKeyNaClAsymm
{ encryptionKey :: KeyringEntry e
, permittedPubKeys :: [PubKey 'Encrypt e]
}
deriving stock (Generic)
instance Serialise (GroupKey e 'NaClAsymm)
---
newtype AsGroupKeyFile a = AsGroupKeyFile a
-- FIXME: integration-regression-test-for-groupkey
-- Добавить тест: сгенерировали groupkey/распарсили groupkey
parseGroupKey :: forall e . ()
=> AsGroupKeyFile ByteString -> Maybe (GroupKey e 'NaClAsymm)
parseGroupKey (AsGroupKeyFile bs) = parseSerialisableFromBase58 bs
instance ( Serialise (GroupKey e s)
)
=> Pretty (AsBase58 (GroupKey e s)) where
pretty (AsBase58 c) =
pretty . B8.unpack . toBase58 . LBS.toStrict . serialise $ c
instance Pretty (AsBase58 a) => Pretty (AsGroupKeyFile (AsBase58 a)) where
pretty (AsGroupKeyFile pc) = "# hbs2 groupkey file" <> line
<> "# keep it private" <> line <> line
<> co
where
co = vcat $ fmap pretty
$ chunksOf 60
$ show
$ pretty pc
-- newtype ListGroupKeyKeys e s = ListGroupKeyKeys (GroupKey e s)
-- instance ()
-- => Pretty (ListGroupKeyKeys e 'NaClAsymm) where
-- pretty (ListGroupKeyKeys (GroupKeyNaClAsymm keypair pubkeys)) =
-- fill 10 "recipient public keys:"
-- <+> vcat (pretty . AsBase58 . Crypto.encode <$> pubkeys)
-- <> line
-- <> pretty keypair
---
parsePubKeys :: forall e . ()
=> ByteString -> Maybe [PubKey 'Encrypt e]
parsePubKeys = sequenceA . fmap (Crypto.decode <=< fromBase58) . B8.lines
---
mkEncryptedKey :: KeyringEntry MerkleEncryptionType -> PubKey 'Encrypt MerkleEncryptionType -> IO EncryptedBox
mkEncryptedKey kr pk = EncryptedBox <$> Encrypt.boxSeal pk ((LBS.toStrict . serialise) kr)
openEncryptedKey :: EncryptedBox -> KeyringEntry MerkleEncryptionType -> Maybe (KeyringEntry MerkleEncryptionType)
openEncryptedKey (EncryptedBox bs) kr =
either (const Nothing) Just . deserialiseOrFail . LBS.fromStrict =<< Encrypt.boxSealOpen (_krPk kr) (_krSk kr) bs

View File

@ -125,11 +125,12 @@ parseCredentials :: forall e . ( Signatures e
, SerialisedCredentials e , SerialisedCredentials e
) )
=> AsCredFile ByteString -> Maybe (PeerCredentials e) => AsCredFile ByteString -> Maybe (PeerCredentials e)
parseCredentials (AsCredFile bs) = parseSerialisableFromBase58 bs
parseCredentials (AsCredFile bs) = maybe1 b58_1 Nothing fromCbor parseSerialisableFromBase58 :: Serialise a => ByteString -> Maybe a
parseSerialisableFromBase58 bs = maybe1 b58_1 Nothing fromCbor
where where
fromCbor s = deserialiseOrFail @(PeerCredentials e) s fromCbor s = deserialiseOrFail s
& either (const Nothing) Just & either (const Nothing) Just
b58_1 = B8.lines bs & dropWhile hdr b58_1 = B8.lines bs & dropWhile hdr

View File

@ -8,6 +8,7 @@ module HBS2.Net.Proto.Definition
import HBS2.Clock import HBS2.Clock
import HBS2.Defaults import HBS2.Defaults
import HBS2.Merkle
import HBS2.Net.Auth.Credentials import HBS2.Net.Auth.Credentials
import HBS2.Net.Messaging.UDP import HBS2.Net.Messaging.UDP
import HBS2.Net.Proto import HBS2.Net.Proto
@ -140,4 +141,10 @@ instance Signatures UDP where
makeSign = Sign.signDetached makeSign = Sign.signDetached
verifySign = Sign.signVerifyDetached verifySign = Sign.signVerifyDetached
instance Signatures MerkleEncryptionType where
type Signature MerkleEncryptionType = Sign.Signature
makeSign = Sign.signDetached
verifySign = Sign.signVerifyDetached

View File

@ -160,35 +160,49 @@ processBlock h = do
when (isJust bt) (removeFromWip h) when (isJust bt) (removeFromWip h)
let handleHrr = \(hrr :: Either (Hash HbSync) [HashRef]) -> do
case hrr of
Left hx -> addDownload hx
Right hr -> do
for_ hr $ \(HashRef blk) -> do
-- debug $ pretty blk
here <- liftIO (hasBlock sto blk) <&> isJust
if here then do
pure ()
-- debug $ "block" <+> pretty blk <+> "is already here"
-- unless (h == blk) do
-- processBlock blk -- NOTE: хуже не стало
-- FIXME: fugure out if it's really required
else do
addDownload blk
case bt of case bt of
Nothing -> addDownload h Nothing -> addDownload h
Just (AnnRef{}) -> pure () Just (AnnRef{}) -> pure ()
Just (MerkleAnn ann) -> do
case (_mtaMeta ann) of
NoMetaData -> pure ()
ShortMetadata {} -> pure ()
AnnHashRef h -> addDownload h
case (_mtaCrypt ann) of
NullEncryption -> pure ()
CryptAccessKeyNaClAsymm h -> addDownload h
debug $ "GOT WRAPPED MERKLE. requesting nodes/leaves" <+> pretty h
walkMerkleTree (_mtaTree ann) (liftIO . getBlock sto) handleHrr
Just (Merkle{}) -> do Just (Merkle{}) -> do
debug $ "GOT MERKLE. requesting nodes/leaves" <+> pretty h debug $ "GOT MERKLE. requesting nodes/leaves" <+> pretty h
walkMerkle h (liftIO . getBlock sto) $ \(hrr :: Either (Hash HbSync) [HashRef]) -> do walkMerkle h (liftIO . getBlock sto) handleHrr
case hrr of
Left hx -> addDownload hx
Right hr -> do
for_ hr $ \(HashRef blk) -> do
-- debug $ pretty blk
here <- liftIO (hasBlock sto blk) <&> isJust
if here then do
pure ()
-- debug $ "block" <+> pretty blk <+> "is already here"
-- unless (h == blk) do
-- processBlock blk -- NOTE: хуже не стало
-- FIXME: fugure out if it's really required
else do
addDownload blk
Just (Blob{}) -> do Just (Blob{}) -> do
pure () pure ()

View File

@ -43,6 +43,21 @@ instance SimpleStorageExtra Handle where
& S.map (HashRef . hashObject) & S.map (HashRef . hashObject)
& S.toList_ & S.toList_
putAsMerkle ss hashes
instance SimpleStorageExtra (S.Stream (S.Of ByteString) IO ()) where
putAsMerkle ss streamChunks = do
hashes <- streamChunks
& S.mapM (\blk -> enqueueBlock ss blk >> pure blk)
& S.map (HashRef . hashObject)
& S.toList_
putAsMerkle ss hashes
instance SimpleStorageExtra [HashRef] where
putAsMerkle ss hashes = do
let pt = toPTree (MaxSize pieces) (MaxNum pieces) hashes -- FIXME: settings let pt = toPTree (MaxSize pieces) (MaxNum pieces) hashes -- FIXME: settings
root <- makeMerkle 0 pt $ \(_,_,bs) -> void $ putBlock ss bs root <- makeMerkle 0 pt $ \(_,_,bs) -> void $ putBlock ss bs

View File

@ -5,6 +5,7 @@ import HBS2.Data.Detect
import HBS2.Data.Types import HBS2.Data.Types
import HBS2.Defaults import HBS2.Defaults
import HBS2.Merkle import HBS2.Merkle
import HBS2.Net.Auth.AccessKey
import HBS2.Net.Auth.Credentials import HBS2.Net.Auth.Credentials
import HBS2.Net.Messaging.UDP (UDP) import HBS2.Net.Messaging.UDP (UDP)
import HBS2.Net.Proto.Definition() import HBS2.Net.Proto.Definition()
@ -15,16 +16,22 @@ import HBS2.Storage.Simple.Extra
import HBS2.OrDie import HBS2.OrDie
import Data.ByteString.Lazy (ByteString) import Control.Arrow ((&&&))
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Control.Monad.Trans.State.Strict
import Crypto.Saltine.Core.Box qualified as Encrypt
import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Lazy qualified as LBS
import Data.ByteString qualified as BS import Data.ByteString qualified as BS
import Data.ByteString.Lazy (ByteString)
import Data.Either import Data.Either
import Data.Function import Data.Function
import Data.Functor import Data.Functor
import Data.Map.Strict qualified as Map
import Data.Monoid qualified as Monoid
import Data.Text (Text)
import Data.UUID qualified as UUID import Data.UUID qualified as UUID
import Data.UUID.V4 qualified as UUID import Data.UUID.V4 qualified as UUID
import Options.Applicative import Options.Applicative
@ -57,6 +64,14 @@ newtype CatHashesOnly = CatHashesOnly Bool
deriving stock (Data,Generic) deriving stock (Data,Generic)
newtype OptKeyringFile = OptKeyringFile { unOptKeyringFile :: FilePath }
deriving newtype (Eq,Ord,IsString)
deriving stock (Data)
newtype OptGroupkeyFile = OptGroupkeyFile { unOptGroupkeyFile :: FilePath }
deriving newtype (Eq,Ord,IsString)
deriving stock (Data)
newtype OptInit = OptInit { fromOptInit :: Bool } newtype OptInit = OptInit { fromOptInit :: Bool }
deriving newtype (Eq,Ord,Pretty) deriving newtype (Eq,Ord,Pretty)
deriving stock (Data,Generic) deriving stock (Data,Generic)
@ -65,6 +80,7 @@ data StoreOpts =
StoreOpts StoreOpts
{ storeInit :: Maybe OptInit { storeInit :: Maybe OptInit
, storeInputFile :: Maybe OptInputFile , storeInputFile :: Maybe OptInputFile
, storeGroupkeyFile :: Maybe OptGroupkeyFile
} }
deriving stock (Data) deriving stock (Data)
@ -72,6 +88,7 @@ data CatOpts =
CatOpts CatOpts
{ catMerkleHash :: Maybe MerkleHash { catMerkleHash :: Maybe MerkleHash
, catHashesOnly :: Maybe CatHashesOnly , catHashesOnly :: Maybe CatHashesOnly
, catPathToKeyring :: Maybe OptKeyringFile
} }
deriving stock (Data) deriving stock (Data)
@ -122,9 +139,54 @@ runCat opts ss = do
Nothing -> die $ show $ "missed block: " <+> pretty hx Nothing -> die $ show $ "missed block: " <+> pretty hx
Just blk -> LBS.putStr blk Just blk -> LBS.putStr blk
let walkAnn :: MTreeAnn [HashRef] -> IO ()
walkAnn ann = do
bprocess :: Hash HbSync -> ByteString -> IO ByteString <- case (_mtaCrypt ann) of
NullEncryption -> pure (const pure)
CryptAccessKeyNaClAsymm crypth -> do
keyringFile <- pure (uniLastMay @OptKeyringFile opts <&> unOptKeyringFile)
`orDie` "block encrypted. keyring required"
s <- BS.readFile keyringFile
ourKeys <- _peerKeyring
<$> pure (parseCredentials @MerkleEncryptionType (AsCredFile s))
`orDie` "bad keyring file"
blkc <- getBlock ss crypth `orDie` (show $ "missed block: " <+> pretty crypth)
recipientKeys :: [(PubKey 'Encrypt MerkleEncryptionType, EncryptedBox)]
<- pure ((either (const Nothing) Just . deserialiseOrFail) blkc)
`orDie` "can not deserialise access key"
(ourkr, box)
<- pure (Monoid.getFirst
(foldMap (\kr@(KeyringEntry pk sk _)
-> Monoid.First ((kr, )
<$> Map.lookup pk (Map.fromList recipientKeys)))
ourKeys))
`orDie` "no available recipient key"
kr <- pure (openEncryptedKey box ourkr)
`orDie` "can not open sealed secret key with our key"
pure $ \hx blk ->
pure ((fmap LBS.fromStrict . Encrypt.boxSealOpen (_krPk kr) (_krSk kr) . LBS.toStrict) blk)
`orDie` (show $ "can not decode block: " <+> pretty hx)
walkMerkleTree (_mtaTree ann) (getBlock ss) $ \(hr :: Either (Hash HbSync) [HashRef]) -> do
case hr of
Left hx -> void $ hPrint stderr $ "missed block:" <+> pretty hx
Right (hrr :: [HashRef]) -> do
forM_ hrr $ \(HashRef hx) -> do
if honly then do
print $ pretty hx
else do
blk <- getBlock ss hx `orDie` (show $ "missed block: " <+> pretty hx)
LBS.putStr =<< bprocess hx blk
case q of case q of
Blob h -> getBlock ss h >>= maybe (die "blob not found") LBS.putStr Blob h -> getBlock ss h >>= maybe (die "blob not found") LBS.putStr
Merkle h -> walk h Merkle h -> walk h
MerkleAnn ann -> walkAnn ann
AnnRef h -> do AnnRef h -> do
let lnk = deserialise @AnnotatedHashRef obj let lnk = deserialise @AnnotatedHashRef obj
let mbHead = headMay [ h let mbHead = headMay [ h
@ -141,16 +203,49 @@ runStore opts ss | justInit = do
where where
justInit = maybe False fromOptInit (uniLastMay @OptInit opts) justInit = maybe False fromOptInit (uniLastMay @OptInit opts)
runStore opts ss = do runStore opts ss = do
let fname = uniLastMay @OptInputFile opts let fname = uniLastMay @OptInputFile opts
handle <- maybe (pure stdin) (flip openFile ReadMode . unOptFile) fname handle <- maybe (pure stdin) (flip openFile ReadMode . unOptFile) fname
root <- putAsMerkle ss handle case (uniLastMay @OptGroupkeyFile opts) of
Nothing -> do
root <- putAsMerkle ss handle
print $ "merkle-root: " <+> pretty root
Just gkfile -> do
gk :: GroupKey MerkleEncryptionType 'NaClAsymm
<- (parseGroupKey . AsGroupKeyFile <$> BS.readFile (unOptGroupkeyFile gkfile))
`orDie` "bad groupkey file"
print $ "merkle-root: " <+> pretty root accKeyh <- maybe (die "can not store access key") pure
=<< (putBlock ss . serialise @[(PubKey 'Encrypt MerkleEncryptionType, EncryptedBox)])
=<< (permittedPubKeys gk `forM` \pk -> (pk, ) <$> mkEncryptedKey (encryptionKey gk) pk)
let rawChunks :: S.Stream (S.Of ByteString) IO ()
rawChunks = readChunked handle (fromIntegral defBlockSize) -- FIXME: to settings!
encryptedChunks :: S.Stream (S.Of ByteString) IO ()
encryptedChunks = rawChunks
& S.mapM (fmap LBS.fromStrict . Encrypt.boxSeal ((_krPk . encryptionKey) gk) . LBS.toStrict)
mhash <- putAsMerkle ss encryptedChunks
mtree <- ((either (const Nothing) Just . deserialiseOrFail =<<) <$> getBlock ss (fromMerkleHash mhash))
`orDie` "merkle tree was not stored properly with `putAsMerkle`"
mannh <- maybe (die "can not store MerkleAnn") pure
=<< (putBlock ss . serialise @(MTreeAnn [HashRef])) do
MTreeAnn NoMetaData (CryptAccessKeyNaClAsymm accKeyh) mtree
print $ "merkle-ann-root: " <+> pretty mannh
runNewGroupkey :: FilePath -> IO ()
runNewGroupkey pubkeysFile = do
s <- BS.readFile pubkeysFile
pubkeys <- pure (parsePubKeys s) `orDie` "bad pubkeys file"
keypair <- newKeypair @MerkleEncryptionType Nothing
print $ pretty $ AsGroupKeyFile $ AsBase58
$ GroupKeyNaClAsymm keypair pubkeys
runNewRef :: Data opts => opts -> MerkleHash -> SimpleStorage HbSync -> IO () runNewRef :: Data opts => opts -> MerkleHash -> SimpleStorage HbSync -> IO ()
runNewRef opts mhash ss = do runNewRef opts mhash ss = do
@ -234,6 +329,7 @@ main = join . customExecParser (prefs showHelpOnError) $
<> command "keyring-key-add" (info pKeyAdd (progDesc "adds a new keypair into the 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 "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 "show-peer-key" (info pShowPeerKey (progDesc "show peer key from credential file"))
<> command "groupkey-new" (info pNewGroupkey (progDesc "generates a new groupkey"))
) )
common = do common = do
@ -250,13 +346,20 @@ main = join . customExecParser (prefs showHelpOnError) $
o <- common o <- common
file <- optional $ strArgument ( metavar "FILE" ) file <- optional $ strArgument ( metavar "FILE" )
init <- optional $ flag' True ( long "init" <> help "just init storage") <&> OptInit init <- optional $ flag' True ( long "init" <> help "just init storage") <&> OptInit
pure $ withStore o (runStore ( StoreOpts init file )) groupkeyFile <- optional $ strOption ( long "groupkey" <> help "path to groupkey file" )
pure $ withStore o (runStore ( StoreOpts init file (OptGroupkeyFile <$> groupkeyFile) ))
pCat = do pCat = do
o <- common o <- common
hash <- optional $ strArgument ( metavar "HASH" ) hash <- optional $ strArgument ( metavar "HASH" )
onlyh <- optional $ flag' True ( short 'H' <> long "hashes-only" <> help "list only block hashes" ) onlyh <- optional $ flag' True ( short 'H' <> long "hashes-only" <> help "list only block hashes" )
pure $ withStore o $ runCat $ CatOpts hash (CatHashesOnly <$> onlyh) keyringFile <- optional $ strOption ( long "keyring" <> help "path to keyring file" )
pure $ withStore o $ runCat
$ CatOpts hash (CatHashesOnly <$> onlyh) (OptKeyringFile <$> keyringFile)
pNewGroupkey = do
pubkeysFile <- strArgument ( metavar "FILE" <> help "path to a file with a list of recipient public keys" )
pure $ runNewGroupkey pubkeysFile
pHash = do pHash = do
o <- common o <- common
@ -280,7 +383,7 @@ main = join . customExecParser (prefs showHelpOnError) $
pKeyDel = do pKeyDel = do
s <- strArgument ( metavar "PUB-KEY-BAS58" ) s <- strArgument ( metavar "PUB-KEY-BASE58" )
f <- strArgument ( metavar "KEYRING-FILE" ) f <- strArgument ( metavar "KEYRING-FILE" )
pure (runKeyDel s f) pure (runKeyDel s f)

View File

@ -49,6 +49,7 @@ common shared-properties
, MultiParamTypeClasses , MultiParamTypeClasses
, OverloadedStrings , OverloadedStrings
, QuasiQuotes , QuasiQuotes
, RecordWildCards
, ScopedTypeVariables , ScopedTypeVariables
, StandaloneDeriving , StandaloneDeriving
, TupleSections , TupleSections
@ -81,6 +82,7 @@ executable hbs2
, optparse-applicative , optparse-applicative
, prettyprinter , prettyprinter
, safe , safe
, saltine
, serialise , serialise
, streaming , streaming
, text , text