mirror of https://github.com/voidlizard/hbs2
wip, removing obsolete code
This commit is contained in:
voidlizard
parent
5f08753132
commit
427115c42b
|
|
@ -25,6 +25,7 @@ import HBS2.Peer.RPC.API.Storage
|
|||
import HBS2.Peer.RPC.Client
|
||||
import HBS2.Peer.RPC.Client.Unix
|
||||
|
||||
import Data.ByteString.Lazy qualified as LBS
|
||||
import Data.Coerce
|
||||
import Data.Text qualified as Text
|
||||
import Control.Monad.Except
|
||||
|
|
@ -64,7 +65,22 @@ treeEntries = do
|
|||
_ -> throwIO (BadFormException @c nil)
|
||||
|
||||
|
||||
brief "reads merkle tree data from storage"
|
||||
brief "reads merkle tree data from storage to stdout"
|
||||
$ args [arg "string" "tree"]
|
||||
$ desc "hbs2:tree:read:stdout HASH"
|
||||
$ returns "nil" ""
|
||||
$ entry $ bindMatch "hbs2:tree:read:stdout" $ nil_ \case
|
||||
[ HashLike h ] -> lift do
|
||||
sto <- getStorage
|
||||
|
||||
runExceptT (getTreeContents sto h)
|
||||
>>= orThrowPassIO
|
||||
>>= liftIO . LBS.putStr
|
||||
|
||||
_ -> throwIO (BadFormException @c nil)
|
||||
|
||||
|
||||
brief "creates a 'grove' -- an annotated hashref list"
|
||||
$ args [arg "list of hashes" "trees"]
|
||||
$ desc [qc|hbs2:grove creates a 'grove' - merkle tree of list of hashes of merkle trees
|
||||
It's just an easy way to create a such thing, you may browse it by hbs2 cat -H
|
||||
|
|
|
|||
|
|
@ -99,7 +99,6 @@ library
|
|||
, HBS2.Merkle.MetaData
|
||||
, HBS2.Merkle.Walk
|
||||
, HBS2.Net.Auth.Schema
|
||||
, HBS2.Net.Auth.GroupKeyAsymm
|
||||
, HBS2.Net.Auth.GroupKeySymm
|
||||
, HBS2.Net.Auth.Credentials
|
||||
, HBS2.Net.Auth.Credentials.Sigil
|
||||
|
|
|
|||
|
|
@ -1,107 +0,0 @@
|
|||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# Language UndecidableInstances #-}
|
||||
{-# Language AllowAmbiguousTypes #-}
|
||||
{-# Language ConstraintKinds #-}
|
||||
module HBS2.Net.Auth.GroupKeyAsymm where
|
||||
|
||||
import HBS2.Base58
|
||||
import HBS2.Data.Types
|
||||
import HBS2.Data.Types.EncryptedBox
|
||||
import HBS2.Net.Auth.Credentials
|
||||
import HBS2.Prelude.Plated
|
||||
|
||||
import Codec.Serialise
|
||||
import Control.Monad ((<=<))
|
||||
import Crypto.Saltine.Core.Box qualified as Encrypt
|
||||
import Crypto.Saltine.Class qualified as Crypto
|
||||
import Data.ByteString.Lazy.Char8 qualified as LBS
|
||||
import Data.ByteString.Char8 qualified as B8
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import Data.List.Split (chunksOf)
|
||||
|
||||
|
||||
type ForAccessKey (s :: CryptoScheme) = ( Crypto.IsEncoding (PubKey 'Encrypt s)
|
||||
, Serialise (PubKey 'Encrypt s)
|
||||
, Serialise (PubKey 'Sign s)
|
||||
, Serialise (PrivKey 'Sign s)
|
||||
, Serialise (PrivKey 'Encrypt s)
|
||||
)
|
||||
|
||||
|
||||
|
||||
data family AccessKey ( s :: CryptoScheme )
|
||||
|
||||
newtype instance AccessKey (s :: CryptoScheme) =
|
||||
AccessKeyNaClAsymm
|
||||
{ permitted :: [(PubKey 'Encrypt s, EncryptedBox (KeyringEntry s))]
|
||||
}
|
||||
deriving stock (Generic)
|
||||
|
||||
instance ForAccessKey s => Serialise (AccessKey s)
|
||||
|
||||
---
|
||||
|
||||
|
||||
data instance GroupKey 'Asymm s =
|
||||
GroupKeyNaClAsymm
|
||||
{ recipientPk :: PubKey 'Encrypt s
|
||||
, accessKey :: AccessKey s
|
||||
}
|
||||
deriving stock (Generic)
|
||||
|
||||
instance ForAccessKey s => Serialise (GroupKey 'Asymm s)
|
||||
|
||||
---
|
||||
|
||||
|
||||
-- FIXME: integration-regression-test-for-groupkey
|
||||
-- Добавить тест: сгенерировали groupkey/распарсили groupkey
|
||||
|
||||
parseGroupKey :: forall s . ForAccessKey s
|
||||
=> AsGroupKeyFile ByteString -> Maybe (GroupKey 'Asymm s)
|
||||
parseGroupKey (AsGroupKeyFile bs) = parseSerialisableFromBase58 bs
|
||||
|
||||
instance ( Serialise (GroupKey 'Asymm s)
|
||||
)
|
||||
|
||||
=> Pretty (AsBase58 (GroupKey 'Asymm s)) where
|
||||
pretty (AsBase58 c) =
|
||||
pretty . B8.unpack . toBase58 . LBS.toStrict . serialise $ c
|
||||
|
||||
|
||||
instance ForAccessKey s => Pretty (AsGroupKeyFile (AsBase58 (GroupKey 'Asymm s))) where
|
||||
pretty (AsGroupKeyFile pc) = "# hbs2 groupkey file" <> line <> co
|
||||
where
|
||||
co = vcat $ fmap pretty
|
||||
$ chunksOf 60
|
||||
$ show
|
||||
$ pretty pc
|
||||
|
||||
|
||||
parsePubKeys :: forall s . ForAccessKey s
|
||||
=> ByteString
|
||||
-> Maybe [PubKey 'Encrypt s]
|
||||
|
||||
parsePubKeys = sequenceA . fmap (Crypto.decode <=< fromBase58) . B8.lines
|
||||
|
||||
|
||||
-- FIXME: public-key-type-hardcode
|
||||
-- Это нужно переместить в тайпкласс от s, аналогично Signatures
|
||||
mkEncryptedKey :: forall s . (ForAccessKey s, PubKey 'Encrypt s ~ Encrypt.PublicKey)
|
||||
=> KeyringEntry s
|
||||
-> PubKey 'Encrypt s
|
||||
-> IO (EncryptedBox (KeyringEntry s))
|
||||
|
||||
mkEncryptedKey kr pk = EncryptedBox <$> Encrypt.boxSeal pk ((LBS.toStrict . serialise) kr)
|
||||
|
||||
openEncryptedKey :: forall s . ( ForAccessKey s
|
||||
, PrivKey 'Encrypt s ~ Encrypt.SecretKey
|
||||
, PubKey 'Encrypt s ~ Encrypt.PublicKey
|
||||
)
|
||||
=> EncryptedBox (KeyringEntry s)
|
||||
-> KeyringEntry s
|
||||
-> Maybe (KeyringEntry s)
|
||||
|
||||
openEncryptedKey (EncryptedBox bs) kr =
|
||||
either (const Nothing) Just . deserialiseOrFail . LBS.fromStrict =<< Encrypt.boxSealOpen (_krPk kr) (_krSk kr) bs
|
||||
|
||||
31
hbs2/Main.hs
31
hbs2/Main.hs
|
|
@ -1,3 +1,4 @@
|
|||
{-# Language TypeOperators #-}
|
||||
module Main where
|
||||
|
||||
import HBS2.Base58
|
||||
|
|
@ -12,7 +13,6 @@ import HBS2.Peer.CLI.Detect
|
|||
import HBS2.Peer.RPC.Client.Unix
|
||||
import HBS2.Peer.RPC.API.Storage
|
||||
import HBS2.Peer.RPC.Client.StorageClient
|
||||
import HBS2.Net.Auth.GroupKeyAsymm as Asymm
|
||||
import HBS2.Net.Auth.GroupKeySymm qualified as Symm
|
||||
import HBS2.Net.Auth.GroupKeySymm
|
||||
import HBS2.Net.Auth.Credentials
|
||||
|
|
@ -374,34 +374,7 @@ runStore opts ss = runResourceT do
|
|||
Left e -> die (show e)
|
||||
Right h -> hPrint stdout (pretty h)
|
||||
|
||||
Just (EncAsymm gk) -> liftIO $ IO.withFile inputFile IO.ReadMode $ \ha -> do
|
||||
|
||||
accKeyh <- (putBlock ss . serialise . permitted . accessKey) gk
|
||||
`orDie` "can not store access key"
|
||||
|
||||
let rawChunks = readChunked ha (fromIntegral defBlockSize) -- FIXME: to settings!
|
||||
|
||||
let encryptedChunks = rawChunks
|
||||
& S.mapM (fmap LBS.fromStrict . Encrypt.boxSeal (recipientPk 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
|
||||
|
||||
hPrint stdout $ "merkle-ann-root: " <+> pretty mannh
|
||||
|
||||
runNewGroupKeyAsymm :: forall s . (s ~ 'HBS2Basic) => FilePath -> IO ()
|
||||
runNewGroupKeyAsymm pubkeysFile = do
|
||||
s <- BS.readFile pubkeysFile
|
||||
pubkeys <- pure (parsePubKeys @s s) `orDie` "bad pubkeys file"
|
||||
keypair <- newKeypair @s Nothing
|
||||
accesskey <- AccessKeyNaClAsymm @s <$> do
|
||||
List.sort pubkeys `forM` \pk -> (pk, ) <$> mkEncryptedKey keypair pk
|
||||
print $ pretty $ AsGroupKeyFile $ AsBase58 $ GroupKeyNaClAsymm (_krPk keypair) accesskey
|
||||
_ -> die "Unsupported (obsolete) encryption scheme"
|
||||
|
||||
runNewKey :: forall s . (s ~ 'HBS2Basic) => Int -> IO ()
|
||||
runNewKey n = do
|
||||
|
|
|
|||
Loading…
Reference in New Issue