diff --git a/README.md b/README.md index 6a929d0f..c57d574a 100644 --- a/README.md +++ b/README.md @@ -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 <хэш> +``` diff --git a/docs/devlog.md b/docs/devlog.md index 6de2973c..03f9d686 100644 --- a/docs/devlog.md +++ b/docs/devlog.md @@ -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 diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal index d25c4957..0fe956ac 100644 --- a/hbs2-core/hbs2-core.cabal +++ b/hbs2-core/hbs2-core.cabal @@ -76,6 +76,7 @@ library , HBS2.Events , HBS2.Hash , HBS2.Merkle + , HBS2.Net.Auth.AccessKey , HBS2.Net.Auth.Credentials , HBS2.Net.IP.Addr , HBS2.Net.Messaging diff --git a/hbs2-core/lib/HBS2/Data/Detect.hs b/hbs2-core/lib/HBS2/Data/Detect.hs index 5e463cf8..ce0c8f95 100644 --- a/hbs2-core/lib/HBS2/Data/Detect.hs +++ b/hbs2-core/lib/HBS2/Data/Detect.hs @@ -9,18 +9,21 @@ import Codec.Serialise (deserialiseOrFail) import Data.ByteString.Lazy (ByteString) import Data.Either import Data.Function +import Data.Functor data BlobType = Merkle (Hash HbSync) + | MerkleAnn (MTreeAnn [HashRef]) | AnnRef (Hash HbSync) | Blob (Hash HbSync) deriving (Show,Data) tryDetect :: Hash HbSync -> ByteString -> BlobType -tryDetect hash obj = rights [mbLink, mbMerkle] & headDef orBlob +tryDetect hash obj = rights [mbAnn, mbLink, mbMerkle] & headDef orBlob where mbLink = deserialiseOrFail @AnnotatedHashRef obj >> pure (AnnRef hash) mbMerkle = deserialiseOrFail @(MTree [HashRef]) obj >> pure (Merkle hash) + mbAnn = deserialiseOrFail obj <&> MerkleAnn orBlob = Blob hash diff --git a/hbs2-core/lib/HBS2/Merkle.hs b/hbs2-core/lib/HBS2/Merkle.hs index a9692dbb..f8e3f36c 100644 --- a/hbs2-core/lib/HBS2/Merkle.hs +++ b/hbs2-core/lib/HBS2/Merkle.hs @@ -7,11 +7,12 @@ import HBS2.Hash import Codec.Serialise import Data.ByteString (ByteString) -import Data.ByteString.Lazy qualified as LBS import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as LBS import Data.Data -import Data.Foldable (traverse_) +import Data.Foldable (forM_, traverse_) import Data.List qualified as List +import Data.Text (Text) import GHC.Generics import Lens.Micro.Platform import Prettyprinter @@ -76,6 +77,30 @@ makeLenses ''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 deriving stock (Generic,Data,Show) @@ -159,3 +184,13 @@ walkMerkle root flookup sink = walkMerkle' root flookup withTree (Right (MNode _ _)) -> pure () 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 diff --git a/hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs b/hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs new file mode 100644 index 00000000..aebac865 --- /dev/null +++ b/hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs @@ -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 diff --git a/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs b/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs index 535d5508..1f0b88c9 100644 --- a/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs +++ b/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs @@ -125,11 +125,12 @@ parseCredentials :: forall e . ( Signatures e , SerialisedCredentials 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 - fromCbor s = deserialiseOrFail @(PeerCredentials e) s + fromCbor s = deserialiseOrFail s & either (const Nothing) Just b58_1 = B8.lines bs & dropWhile hdr diff --git a/hbs2-core/lib/HBS2/Net/Proto/Definition.hs b/hbs2-core/lib/HBS2/Net/Proto/Definition.hs index bf82e3b2..52a21c0c 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Definition.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/Definition.hs @@ -8,6 +8,7 @@ module HBS2.Net.Proto.Definition import HBS2.Clock import HBS2.Defaults +import HBS2.Merkle import HBS2.Net.Auth.Credentials import HBS2.Net.Messaging.UDP import HBS2.Net.Proto @@ -140,4 +141,10 @@ instance Signatures UDP where makeSign = Sign.signDetached verifySign = Sign.signVerifyDetached +instance Signatures MerkleEncryptionType where + type Signature MerkleEncryptionType = Sign.Signature + makeSign = Sign.signDetached + verifySign = Sign.signVerifyDetached + + diff --git a/hbs2-peer/app/BlockDownload.hs b/hbs2-peer/app/BlockDownload.hs index 269c70ac..b2e31dea 100644 --- a/hbs2-peer/app/BlockDownload.hs +++ b/hbs2-peer/app/BlockDownload.hs @@ -160,35 +160,49 @@ processBlock h = do 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 Nothing -> addDownload h 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 debug $ "GOT MERKLE. requesting nodes/leaves" <+> pretty h - walkMerkle h (liftIO . getBlock sto) $ \(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 - + walkMerkle h (liftIO . getBlock sto) handleHrr Just (Blob{}) -> do pure () diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs index 75ad3127..b09b9204 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple/Extra.hs @@ -43,6 +43,21 @@ instance SimpleStorageExtra Handle where & S.map (HashRef . hashObject) & 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 root <- makeMerkle 0 pt $ \(_,_,bs) -> void $ putBlock ss bs diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 38daee2f..d80096e6 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -5,6 +5,7 @@ import HBS2.Data.Detect import HBS2.Data.Types import HBS2.Defaults import HBS2.Merkle +import HBS2.Net.Auth.AccessKey import HBS2.Net.Auth.Credentials import HBS2.Net.Messaging.UDP (UDP) import HBS2.Net.Proto.Definition() @@ -15,16 +16,22 @@ import HBS2.Storage.Simple.Extra import HBS2.OrDie -import Data.ByteString.Lazy (ByteString) +import Control.Arrow ((&&&)) import Control.Concurrent.Async import Control.Monad import Control.Monad.IO.Class 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 qualified as BS +import Data.ByteString.Lazy (ByteString) import Data.Either import Data.Function 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.V4 qualified as UUID import Options.Applicative @@ -57,6 +64,14 @@ newtype CatHashesOnly = CatHashesOnly Bool 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 } deriving newtype (Eq,Ord,Pretty) deriving stock (Data,Generic) @@ -65,6 +80,7 @@ data StoreOpts = StoreOpts { storeInit :: Maybe OptInit , storeInputFile :: Maybe OptInputFile + , storeGroupkeyFile :: Maybe OptGroupkeyFile } deriving stock (Data) @@ -72,6 +88,7 @@ data CatOpts = CatOpts { catMerkleHash :: Maybe MerkleHash , catHashesOnly :: Maybe CatHashesOnly + , catPathToKeyring :: Maybe OptKeyringFile } deriving stock (Data) @@ -122,9 +139,54 @@ runCat opts ss = do Nothing -> die $ show $ "missed block: " <+> pretty hx 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 Blob h -> getBlock ss h >>= maybe (die "blob not found") LBS.putStr Merkle h -> walk h + MerkleAnn ann -> walkAnn ann AnnRef h -> do let lnk = deserialise @AnnotatedHashRef obj let mbHead = headMay [ h @@ -141,16 +203,49 @@ runStore opts ss | justInit = do where justInit = maybe False fromOptInit (uniLastMay @OptInit opts) - runStore opts ss = do let fname = uniLastMay @OptInputFile opts 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 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-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")) ) common = do @@ -250,13 +346,20 @@ main = join . customExecParser (prefs showHelpOnError) $ o <- common file <- optional $ strArgument ( metavar "FILE" ) 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 o <- common hash <- optional $ strArgument ( metavar "HASH" ) 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 o <- common @@ -280,7 +383,7 @@ main = join . customExecParser (prefs showHelpOnError) $ pKeyDel = do - s <- strArgument ( metavar "PUB-KEY-BAS58" ) + s <- strArgument ( metavar "PUB-KEY-BASE58" ) f <- strArgument ( metavar "KEYRING-FILE" ) pure (runKeyDel s f) diff --git a/hbs2/hbs2.cabal b/hbs2/hbs2.cabal index 70f8f29f..39b4e654 100644 --- a/hbs2/hbs2.cabal +++ b/hbs2/hbs2.cabal @@ -49,6 +49,7 @@ common shared-properties , MultiParamTypeClasses , OverloadedStrings , QuasiQuotes + , RecordWildCards , ScopedTypeVariables , StandaloneDeriving , TupleSections @@ -81,6 +82,7 @@ executable hbs2 , optparse-applicative , prettyprinter , safe + , saltine , serialise , streaming , text