-- | Key types and KeyPair abstraction for libp2p peer identity.
module Network.LibP2P.Crypto.Key
  ( KeyType (..)
  , KeyPair (..)
  , PublicKey (..)
  , PrivateKey (..)
  , publicKey
  , sign
  , verify
  ) where

import qualified Crypto.Error as CE
import qualified Crypto.PubKey.Ed25519 as Ed
import Data.ByteArray (convert)
import Data.ByteString (ByteString)

-- | Supported key types per the libp2p spec.
data KeyType
  = Ed25519
  deriving (Int -> KeyType -> ShowS
[KeyType] -> ShowS
KeyType -> String
(Int -> KeyType -> ShowS)
-> (KeyType -> String) -> ([KeyType] -> ShowS) -> Show KeyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyType -> ShowS
showsPrec :: Int -> KeyType -> ShowS
$cshow :: KeyType -> String
show :: KeyType -> String
$cshowList :: [KeyType] -> ShowS
showList :: [KeyType] -> ShowS
Show, KeyType -> KeyType -> Bool
(KeyType -> KeyType -> Bool)
-> (KeyType -> KeyType -> Bool) -> Eq KeyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyType -> KeyType -> Bool
== :: KeyType -> KeyType -> Bool
$c/= :: KeyType -> KeyType -> Bool
/= :: KeyType -> KeyType -> Bool
Eq, Eq KeyType
Eq KeyType =>
(KeyType -> KeyType -> Ordering)
-> (KeyType -> KeyType -> Bool)
-> (KeyType -> KeyType -> Bool)
-> (KeyType -> KeyType -> Bool)
-> (KeyType -> KeyType -> Bool)
-> (KeyType -> KeyType -> KeyType)
-> (KeyType -> KeyType -> KeyType)
-> Ord KeyType
KeyType -> KeyType -> Bool
KeyType -> KeyType -> Ordering
KeyType -> KeyType -> KeyType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KeyType -> KeyType -> Ordering
compare :: KeyType -> KeyType -> Ordering
$c< :: KeyType -> KeyType -> Bool
< :: KeyType -> KeyType -> Bool
$c<= :: KeyType -> KeyType -> Bool
<= :: KeyType -> KeyType -> Bool
$c> :: KeyType -> KeyType -> Bool
> :: KeyType -> KeyType -> Bool
$c>= :: KeyType -> KeyType -> Bool
>= :: KeyType -> KeyType -> Bool
$cmax :: KeyType -> KeyType -> KeyType
max :: KeyType -> KeyType -> KeyType
$cmin :: KeyType -> KeyType -> KeyType
min :: KeyType -> KeyType -> KeyType
Ord)

-- | A public key with its type.
data PublicKey = PublicKey
  { PublicKey -> KeyType
pkType :: KeyType
  , PublicKey -> ByteString
pkBytes :: ByteString
  }
  deriving (Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
(Int -> PublicKey -> ShowS)
-> (PublicKey -> String)
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKey -> ShowS
showsPrec :: Int -> PublicKey -> ShowS
$cshow :: PublicKey -> String
show :: PublicKey -> String
$cshowList :: [PublicKey] -> ShowS
showList :: [PublicKey] -> ShowS
Show, PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
/= :: PublicKey -> PublicKey -> Bool
Eq)

-- | A private key with its type.
data PrivateKey = PrivateKey
  { PrivateKey -> KeyType
skType :: KeyType
  , PrivateKey -> ByteString
skBytes :: ByteString
  }

-- | A key pair containing both public and private keys.
data KeyPair = KeyPair
  { KeyPair -> PublicKey
kpPublic :: PublicKey
  , KeyPair -> PrivateKey
kpPrivate :: PrivateKey
  }

-- | Extract the public key from a key pair.
publicKey :: KeyPair -> PublicKey
publicKey :: KeyPair -> PublicKey
publicKey = KeyPair -> PublicKey
kpPublic

-- | Sign a message with a private key.
-- Returns Left on invalid key bytes.
sign :: PrivateKey -> ByteString -> Either String ByteString
sign :: PrivateKey -> ByteString -> Either String ByteString
sign (PrivateKey KeyType
Ed25519 ByteString
skRaw) ByteString
msg =
  case CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed.secretKey ByteString
skRaw) of
    Left CryptoError
err -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String
"sign: invalid secret key: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CryptoError -> String
forall a. Show a => a -> String
show CryptoError
err
    Right SecretKey
sk ->
      let pk :: PublicKey
pk = SecretKey -> PublicKey
Ed.toPublic SecretKey
sk
          sig :: Signature
sig = SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed.sign SecretKey
sk PublicKey
pk ByteString
msg
       in ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert Signature
sig)

-- | Verify a signature against a public key and message.
verify :: PublicKey -> ByteString -> ByteString -> Bool
verify :: PublicKey -> ByteString -> ByteString -> Bool
verify (PublicKey KeyType
Ed25519 ByteString
pkRaw) ByteString
msg ByteString
sigRaw =
  case (CryptoFailable PublicKey -> Either CryptoError PublicKey
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed.publicKey ByteString
pkRaw), CryptoFailable Signature -> Either CryptoError Signature
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError (ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed.signature ByteString
sigRaw)) of
    (Right PublicKey
pk, Right Signature
sig) -> PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed.verify PublicKey
pk ByteString
msg Signature
sig
    (Either CryptoError PublicKey, Either CryptoError Signature)
_ -> Bool
False