voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

groupkey without secret (#2)

This commit is contained in:
Sergey Ivanov 2023-02-17 08:27:17 +04:00 committed by GitHub
parent 5af01af090
commit 809a78e49a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs
View File

@ -61,8 +61,8 @@ data family GroupKey e ( s :: EncryptionSchema )
data instance GroupKey e 'NaClAsymm = data instance GroupKey e 'NaClAsymm =
GroupKeyNaClAsymm GroupKeyNaClAsymm
{ encryptionKey :: KeyringEntry e { recipientPk :: PubKey 'Encrypt e
, permittedPubKeys :: [PubKey 'Encrypt e] , accessKey :: AccessKey e 'NaClAsymm
} }
deriving stock (Generic) deriving stock (Generic)
@ -88,9 +88,7 @@ instance ( Serialise (GroupKey e s)
instance Pretty (AsBase58 a) => Pretty (AsGroupKeyFile (AsBase58 a)) where instance Pretty (AsBase58 a) => Pretty (AsGroupKeyFile (AsBase58 a)) where
pretty (AsGroupKeyFile pc) = "# hbs2 groupkey file" <> line pretty (AsGroupKeyFile pc) = "# hbs2 groupkey file" <> line <> co
<> "# keep it private" <> line <> line
<> co
where where
co = vcat $ fmap pretty co = vcat $ fmap pretty
$ chunksOf 60 $ chunksOf 60

13
hbs2/Main.hs
View File

@ -29,6 +29,7 @@ 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.List qualified as List
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
import Data.Monoid qualified as Monoid import Data.Monoid qualified as Monoid
import Data.Text (Text) import Data.Text (Text)
@ -218,16 +219,15 @@ runStore opts ss = do
<- (parseGroupKey . AsGroupKeyFile <$> BS.readFile (unOptGroupkeyFile gkfile)) <- (parseGroupKey . AsGroupKeyFile <$> BS.readFile (unOptGroupkeyFile gkfile))
`orDie` "bad groupkey file" `orDie` "bad groupkey file"
accKeyh <- maybe (die "can not store access key") pure accKeyh <- (putBlock ss . serialise . permitted . accessKey) gk
=<< (putBlock ss . serialise @[(PubKey 'Encrypt MerkleEncryptionType, EncryptedBox)]) `orDie` "can not store access key"
=<< (permittedPubKeys gk `forM` \pk -> (pk, ) <$> mkEncryptedKey (encryptionKey gk) pk)
let rawChunks :: S.Stream (S.Of ByteString) IO () let rawChunks :: S.Stream (S.Of ByteString) IO ()
rawChunks = readChunked handle (fromIntegral defBlockSize) -- FIXME: to settings! rawChunks = readChunked handle (fromIntegral defBlockSize) -- FIXME: to settings!
encryptedChunks :: S.Stream (S.Of ByteString) IO () encryptedChunks :: S.Stream (S.Of ByteString) IO ()
encryptedChunks = rawChunks 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 mhash <- putAsMerkle ss encryptedChunks
mtree <- ((either (const Nothing) Just . deserialiseOrFail =<<) <$> getBlock ss (fromMerkleHash mhash)) mtree <- ((either (const Nothing) Just . deserialiseOrFail =<<) <$> getBlock ss (fromMerkleHash mhash))
@ -244,8 +244,9 @@ runNewGroupkey pubkeysFile = do
s <- BS.readFile pubkeysFile s <- BS.readFile pubkeysFile
pubkeys <- pure (parsePubKeys s) `orDie` "bad pubkeys file" pubkeys <- pure (parsePubKeys s) `orDie` "bad pubkeys file"
keypair <- newKeypair @MerkleEncryptionType Nothing keypair <- newKeypair @MerkleEncryptionType Nothing
print $ pretty $ AsGroupKeyFile $ AsBase58 accesskey <- AccessKeyNaClAsymm <$> do
$ GroupKeyNaClAsymm keypair pubkeys 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 :: Data opts => opts -> MerkleHash -> SimpleStorage HbSync -> IO ()
runNewRef opts mhash ss = do runNewRef opts mhash ss = do