wip, removing obsolete code

hbs2-cli/lib/HBS2/CLI/Run/Tree.hs

@@ -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

hbs2-core/hbs2-core.cabal

@@ -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

hbs2-core/lib/HBS2/Net/Auth/GroupKeyAsymm.hs

@@ -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
-

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
+        _ -> die "Unsupported (obsolete) encryption scheme"
-
-          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
 
 runNewKey :: forall s . (s ~ 'HBS2Basic) => Int -> IO ()
 runNewKey n = do