From 809a78e49af7c092e0d50fa4d8311f92f1dfb728 Mon Sep 17 00:00:00 2001
From: Sergey Ivanov <ivanovs-4@yandex.ru>
Date: Fri, 17 Feb 2023 08:27:17 +0400
Subject: [PATCH] groupkey without secret (#2)

---
 hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs |  8 +++-----
 hbs2/Main.hs                             | 13 +++++++------
 2 files changed, 10 insertions(+), 11 deletions(-)

diff --git a/hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs b/hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs
index aebac865..adb9c37c 100644
--- a/hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs
+++ b/hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs
@@ -61,8 +61,8 @@ data family GroupKey e ( s :: EncryptionSchema )
 
 data instance GroupKey e 'NaClAsymm =
   GroupKeyNaClAsymm
-  { encryptionKey :: KeyringEntry e
-  , permittedPubKeys :: [PubKey 'Encrypt e]
+  { recipientPk :: PubKey 'Encrypt e
+  , accessKey :: AccessKey e 'NaClAsymm
   }
   deriving stock (Generic)
 
@@ -88,9 +88,7 @@ instance ( Serialise  (GroupKey e s)
 
 
 instance Pretty (AsBase58 a) => Pretty (AsGroupKeyFile (AsBase58 a)) where
-  pretty (AsGroupKeyFile pc) =  "# hbs2 groupkey file" <> line
-                         <> "# keep it private" <> line <> line
-                         <> co
+  pretty (AsGroupKeyFile pc) =  "# hbs2 groupkey file" <> line <> co
     where
       co = vcat $ fmap pretty
                 $ chunksOf 60
diff --git a/hbs2/Main.hs b/hbs2/Main.hs
index d80096e6..a47a2fb0 100644
--- a/hbs2/Main.hs
+++ b/hbs2/Main.hs
@@ -29,6 +29,7 @@ import Data.ByteString.Lazy (ByteString)
 import Data.Either
 import Data.Function
 import Data.Functor
+import Data.List qualified as List
 import Data.Map.Strict qualified as Map
 import Data.Monoid qualified as Monoid
 import Data.Text (Text)
@@ -218,16 +219,15 @@ runStore opts ss = do
             <- (parseGroupKey . AsGroupKeyFile <$> BS.readFile (unOptGroupkeyFile gkfile))
             `orDie` "bad groupkey file"
 
-        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)
+        accKeyh <- (putBlock ss . serialise . permitted . accessKey) gk
+            `orDie` "can not store access key"
 
         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)
+                & 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))
@@ -244,8 +244,9 @@ 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
+  accesskey <- AccessKeyNaClAsymm <$> do
+      List.sort pubkeys `forM` \pk -> (pk, ) <$> mkEncryptedKey keypair pk
+  print $ pretty $ AsGroupKeyFile $ AsBase58 $ GroupKeyNaClAsymm (_krPk keypair) accesskey
 
 runNewRef :: Data opts => opts -> MerkleHash -> SimpleStorage HbSync -> IO ()
 runNewRef opts mhash ss = do