mirror of https://github.com/voidlizard/hbs2
113 lines
3.4 KiB
Haskell
113 lines
3.4 KiB
Haskell
{-# 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.Merkle
|
|
import HBS2.Net.Auth.Credentials
|
|
import HBS2.Net.Proto.Definition
|
|
import HBS2.Net.Proto.Types
|
|
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 = ( 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
|
|
|
|
newtype instance AccessKey s =
|
|
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
|
|
|