mirror of https://github.com/voidlizard/hbs2
105 lines
3.1 KiB
Haskell
105 lines
3.1 KiB
Haskell
{-# Language TemplateHaskell #-}
|
|
{-# Language UndecidableInstances #-}
|
|
module HBS2.Net.Auth.Credentials where
|
|
|
|
import HBS2.Prelude.Plated
|
|
import HBS2.Net.Proto.Types
|
|
import HBS2.Base58
|
|
|
|
import Codec.Serialise
|
|
import Crypto.Saltine.Core.Sign (Keypair(..))
|
|
import Crypto.Saltine.Core.Sign qualified as Sign
|
|
import Crypto.Saltine.Class qualified as Crypto
|
|
import Crypto.Saltine.Class (IsEncoding)
|
|
import Data.ByteString.Lazy.Char8 qualified as LBS
|
|
import Data.ByteString.Char8 qualified as B8
|
|
import Data.ByteString.Char8 (ByteString)
|
|
import Data.Function
|
|
import Data.List.Split (chunksOf)
|
|
import Data.Text (Text)
|
|
import Lens.Micro.Platform
|
|
import Prettyprinter
|
|
|
|
class HasCredentials e m where
|
|
getCredentials :: m (PeerCredentials e)
|
|
|
|
data KeyringEntry e =
|
|
KeyringEntry
|
|
{ _krPk :: PubKey 'Encrypt e
|
|
, _krSk :: PrivKey 'Encrypt e
|
|
, _krDesc :: Text
|
|
}
|
|
|
|
data PeerCredentials e =
|
|
PeerCredentials
|
|
{ _peerSignSk :: PrivKey 'Sign e
|
|
, _peerSignPk :: PubKey 'Sign e
|
|
, _peerKeyring :: [KeyringEntry e]
|
|
}
|
|
|
|
makeLenses 'KeyringEntry
|
|
makeLenses 'PeerCredentials
|
|
|
|
|
|
newtype AsCredFile a = AsCredFile a
|
|
|
|
newCredentials :: forall e m . ( MonadIO m
|
|
, Signatures e
|
|
, PrivKey 'Sign e ~ Sign.SecretKey
|
|
, PubKey 'Sign e ~ Sign.PublicKey
|
|
) => m (PeerCredentials e)
|
|
newCredentials = do
|
|
pair <- liftIO Sign.newKeypair
|
|
pure $ PeerCredentials @e (secretKey pair) (publicKey pair) mempty
|
|
|
|
|
|
parseCredentials :: forall e . ( Signatures e
|
|
, PrivKey 'Sign e ~ Sign.SecretKey
|
|
, PubKey 'Sign e ~ Sign.PublicKey
|
|
)
|
|
=> AsCredFile ByteString -> Maybe (PeerCredentials e)
|
|
|
|
parseCredentials (AsCredFile bs) = maybe1 b58_1 Nothing fromCbor
|
|
|
|
where
|
|
fromCbor s = deserialiseOrFail @(ByteString, ByteString) s
|
|
& either (const Nothing) fromPair
|
|
|
|
fromPair (s1,s2) = PeerCredentials <$> Crypto.decode s1
|
|
<*> Crypto.decode s2
|
|
<*> pure mempty
|
|
|
|
b58_1 = B8.lines bs & dropWhile hdr
|
|
& filter ( not . B8.null )
|
|
& B8.concat
|
|
& fromBase58
|
|
& fmap LBS.fromStrict
|
|
|
|
hdr s = B8.isPrefixOf "#" s || B8.null s
|
|
|
|
instance ( IsEncoding (PrivKey 'Sign e)
|
|
, IsEncoding (PubKey 'Sign e)
|
|
)
|
|
|
|
=> Pretty (AsBase58 (PeerCredentials e)) where
|
|
pretty (AsBase58 (PeerCredentials s p _)) = pretty $ B8.unpack (toBase58 bs)
|
|
where
|
|
sk = Crypto.encode s
|
|
pk = Crypto.encode p
|
|
bs = serialise (sk,pk) & LBS.toStrict
|
|
|
|
instance Pretty (AsBase58 Sign.PublicKey) where
|
|
pretty (AsBase58 pk) = pretty $ B8.unpack $ toBase58 (Crypto.encode pk)
|
|
|
|
instance Pretty (AsBase58 a) => Pretty (AsCredFile (AsBase58 a)) where
|
|
pretty (AsCredFile pc) = "# hbs2 credentials file" <> line
|
|
<> "# keep it private" <> line <> line
|
|
<> co
|
|
where
|
|
co = vcat $ fmap pretty
|
|
$ chunksOf 32
|
|
$ show
|
|
$ pretty pc
|
|
|
|
|