{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      :  Network.Polkadot.Crypto
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Polkadot signing types and methods.
--

module Network.Polkadot.Crypto
  ( Pair(..)
  , Verify(..)
  , MultiPair(..)
  , Ed25519
  , Ecdsa
  ) where

import qualified Crypto.Ecdsa.Signature      as Ecdsa (pack, sign)
import           Crypto.Ecdsa.Utils          as Ecdsa (derivePubKey,
                                                       exportPubKeyCompress,
                                                       importKey)
import           Crypto.Error                (CryptoFailable (..))
import qualified Crypto.PubKey.ECC.ECDSA     as Ecdsa (PrivateKey (..),
                                                       PublicKey (..))
import qualified Crypto.PubKey.ECC.Generate  as Ecdsa (generate)
import           Crypto.PubKey.ECC.Types     (CurveName (SEC_p256k1),
                                              getCurveByName)
import qualified Crypto.PubKey.Ed25519       as Ed25519 (PublicKey, SecretKey,
                                                         generateSecretKey,
                                                         secretKey, sign,
                                                         toPublic)
import           Data.BigNum                 (H256, H512, h256, h512)
import           Data.ByteArray              (ByteArrayAccess, uncons)
import qualified Data.ByteArray              as BA (length)
import           Data.ByteString             (ByteString)
import qualified Data.ByteString             as BS (last, take)
import           Data.Maybe                  (fromJust)
import           Data.Text                   (Text)
import           Data.Word                   (Word8)

import           Network.Polkadot.Account    (IdentifyAccount (..))
import qualified Network.Polkadot.Primitives as P (MultiAddress (..),
                                                   MultiSignature (..),
                                                   MultiSigner (..))

-- | Class suitable for typical cryptographic PKI key pair type.
class Pair a where
    -- | The type which is used to encode a public key.
    type PublicKey a
    -- | The type used to represent a signature. Can be created from a key pair and a message
    -- and verified with the message and a public key.
    type Signature a
    -- | Generate new secure (random) key pair.
    generate :: IO a
    -- | Generate new key pair from the provided `seed`.
    from_seed :: ByteArrayAccess ba => ba -> Either String a
    -- | Generate key pair from given recovery phrase and password.
    from_phrase :: Text -> Maybe Text -> Either String a
    -- | Get a public key.
    public :: a -> PublicKey a
    -- | Sign a message.
    sign :: ByteArrayAccess ba => a -> ba -> Signature a

-- | Means of signature verification.
class Verify a where
    -- | Verify a message.
    verify :: (IdentifyAccount s, ByteArrayAccess ba)
           => a
           -- ^ Message signature.
           -> ba
           -- ^ Message content.
           -> s
           -- ^ Type of the signer.
           -> Bool
           -- ^ Returns `true` if signature is valid for the value.

-- | Multiple cryptographic type support.
class Pair a => MultiPair a where
    -- | Universal short representation of signer account.
    type MultiAddress a
    -- | Universal signer account identifier.
    type MultiSigner a
    -- | Universal signature representation.
    type MultiSignature a
    -- | Derive universal account address.
    multi_address :: a -> MultiAddress a
    -- | Derive universal signer account identifier.
    multi_signer :: a -> MultiSigner a
    -- | Sign message and derive universal signature.
    multi_sign :: ByteArrayAccess ba => a -> ba -> MultiSignature a

-- | Ed25519 cryptographic pair.
data Ed25519 = Ed25519 !Ed25519.PublicKey !Ed25519.SecretKey
  deriving Ed25519 -> Ed25519 -> Bool
(Ed25519 -> Ed25519 -> Bool)
-> (Ed25519 -> Ed25519 -> Bool) -> Eq Ed25519
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ed25519 -> Ed25519 -> Bool
== :: Ed25519 -> Ed25519 -> Bool
$c/= :: Ed25519 -> Ed25519 -> Bool
/= :: Ed25519 -> Ed25519 -> Bool
Eq

instance Show Ed25519 where
    show :: Ed25519 -> String
show = (String
"Ed25519 " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Ed25519 -> String) -> Ed25519 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H256 -> String
forall a. Show a => a -> String
show (H256 -> String) -> (Ed25519 -> H256) -> Ed25519 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ed25519 -> H256
Ed25519 -> PublicKey Ed25519
forall a. Pair a => a -> PublicKey a
public

instance Pair Ed25519 where
    type PublicKey Ed25519 = H256
    type Signature Ed25519 = H512
    generate :: IO Ed25519
generate = do
        SecretKey
sec <- IO SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Ed25519.generateSecretKey
        Ed25519 -> IO Ed25519
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ed25519 -> IO Ed25519) -> Ed25519 -> IO Ed25519
forall a b. (a -> b) -> a -> b
$ PublicKey -> SecretKey -> Ed25519
Ed25519 (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
sec) SecretKey
sec
    from_seed :: forall ba. ByteArrayAccess ba => ba -> Either String Ed25519
from_seed ba
seed = case ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ba
seed of
        CryptoPassed SecretKey
sec -> Ed25519 -> Either String Ed25519
forall a b. b -> Either a b
Right (Ed25519 -> Either String Ed25519)
-> Ed25519 -> Either String Ed25519
forall a b. (a -> b) -> a -> b
$ PublicKey -> SecretKey -> Ed25519
Ed25519 (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
sec) SecretKey
sec
        CryptoFailed CryptoError
e   -> String -> Either String Ed25519
forall a b. a -> Either a b
Left (CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e)
    from_phrase :: Text -> Maybe Text -> Either String Ed25519
from_phrase = Text -> Maybe Text -> Either String Ed25519
forall a. HasCallStack => a
undefined
    public :: Ed25519 -> PublicKey Ed25519
public (Ed25519 PublicKey
pub SecretKey
_) = Maybe H256 -> H256
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe H256 -> H256) -> Maybe H256 -> H256
forall a b. (a -> b) -> a -> b
$ PublicKey -> Maybe H256
forall a. ByteArrayAccess a => a -> Maybe H256
h256 PublicKey
pub
    sign :: forall ba. ByteArrayAccess ba => Ed25519 -> ba -> Signature Ed25519
sign (Ed25519 PublicKey
pub SecretKey
sec) ba
input = SecretKey -> PublicKey -> ba -> H512
forall a. ByteArrayAccess a => SecretKey -> PublicKey -> a -> H512
ed25519_sign SecretKey
sec PublicKey
pub ba
input

-- | ECDSA cryptographic pair.
data Ecdsa = Ecdsa !Ecdsa.PublicKey !Ecdsa.PrivateKey
  deriving Ecdsa -> Ecdsa -> Bool
(Ecdsa -> Ecdsa -> Bool) -> (Ecdsa -> Ecdsa -> Bool) -> Eq Ecdsa
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ecdsa -> Ecdsa -> Bool
== :: Ecdsa -> Ecdsa -> Bool
$c/= :: Ecdsa -> Ecdsa -> Bool
/= :: Ecdsa -> Ecdsa -> Bool
Eq

instance Show Ecdsa where
    show :: Ecdsa -> String
show = (String
"Ecdsa " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Ecdsa -> String) -> Ecdsa -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, H256) -> String
forall a. Show a => a -> String
show ((Word8, H256) -> String)
-> (Ecdsa -> (Word8, H256)) -> Ecdsa -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ecdsa -> (Word8, H256)
Ecdsa -> PublicKey Ecdsa
forall a. Pair a => a -> PublicKey a
public

instance Pair Ecdsa where
    type PublicKey Ecdsa = (Word8, H256)
    type Signature Ecdsa = (H512, Word8)
    generate :: IO Ecdsa
generate = (PublicKey -> PrivateKey -> Ecdsa)
-> (PublicKey, PrivateKey) -> Ecdsa
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PublicKey -> PrivateKey -> Ecdsa
Ecdsa ((PublicKey, PrivateKey) -> Ecdsa)
-> IO (PublicKey, PrivateKey) -> IO Ecdsa
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Curve -> IO (PublicKey, PrivateKey)
forall (m :: * -> *).
MonadRandom m =>
Curve -> m (PublicKey, PrivateKey)
Ecdsa.generate (CurveName -> Curve
getCurveByName CurveName
SEC_p256k1)
    from_seed :: forall ba. ByteArrayAccess ba => ba -> Either String Ecdsa
from_seed ba
seed
        | ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
seed Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = let sec :: PrivateKey
sec = ba -> PrivateKey
forall privateKey.
ByteArrayAccess privateKey =>
privateKey -> PrivateKey
Ecdsa.importKey ba
seed
                                  in Ecdsa -> Either String Ecdsa
forall a b. b -> Either a b
Right (Ecdsa -> Either String Ecdsa) -> Ecdsa -> Either String Ecdsa
forall a b. (a -> b) -> a -> b
$ PublicKey -> PrivateKey -> Ecdsa
Ecdsa (PrivateKey -> PublicKey
Ecdsa.derivePubKey PrivateKey
sec) PrivateKey
sec
        | Bool
otherwise = String -> Either String Ecdsa
forall a b. a -> Either a b
Left String
"Seed should be 32 byte length"
    from_phrase :: Text -> Maybe Text -> Either String Ecdsa
from_phrase = Text -> Maybe Text -> Either String Ecdsa
forall a. HasCallStack => a
undefined
    public :: Ecdsa -> PublicKey Ecdsa
public (Ecdsa PublicKey
pub PrivateKey
_) = Maybe (Word8, ByteString) -> (Word8, H256)
pack (Maybe (Word8, ByteString) -> (Word8, H256))
-> Maybe (Word8, ByteString) -> (Word8, H256)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (Word8, ByteString)
forall a. ByteArray a => a -> Maybe (Word8, a)
uncons (ByteString -> Maybe (Word8, ByteString))
-> ByteString -> Maybe (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString
forall publicKey. ByteArray publicKey => PublicKey -> publicKey
Ecdsa.exportPubKeyCompress PublicKey
pub
      where
        pack :: Maybe (Word8, ByteString) -> (Word8, H256)
        pack :: Maybe (Word8, ByteString) -> (Word8, H256)
pack (Just (Word8
px, ByteString
key)) = (Word8
px, Maybe H256 -> H256
forall a. HasCallStack => Maybe a -> a
fromJust (ByteString -> Maybe H256
forall a. ByteArrayAccess a => a -> Maybe H256
h256 ByteString
key))
        pack Maybe (Word8, ByteString)
_                = String -> (Word8, H256)
forall a. HasCallStack => String -> a
error String
"impossible branch"
    sign :: forall ba. ByteArrayAccess ba => Ecdsa -> ba -> Signature Ecdsa
sign (Ecdsa PublicKey
_ PrivateKey
sec) ba
input = PrivateKey -> ba -> (H512, Word8)
forall a. ByteArrayAccess a => PrivateKey -> a -> (H512, Word8)
ecdsa_sign PrivateKey
sec ba
input

ed25519_sign :: ByteArrayAccess a => Ed25519.SecretKey -> Ed25519.PublicKey -> a -> H512
ed25519_sign :: forall a. ByteArrayAccess a => SecretKey -> PublicKey -> a -> H512
ed25519_sign SecretKey
sec PublicKey
pub = Maybe H512 -> H512
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe H512 -> H512) -> (a -> Maybe H512) -> a -> H512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Maybe H512
forall a. ByteArrayAccess a => a -> Maybe H512
h512 (Signature -> Maybe H512) -> (a -> Signature) -> a -> Maybe H512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PublicKey -> a -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
sec PublicKey
pub

ecdsa_sign :: ByteArrayAccess a => Ecdsa.PrivateKey -> a -> (H512, Word8)
ecdsa_sign :: forall a. ByteArrayAccess a => PrivateKey -> a -> (H512, Word8)
ecdsa_sign PrivateKey
sec a
input = (Maybe H512 -> H512
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe H512 -> H512) -> Maybe H512 -> H512
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe H512
forall a. ByteArrayAccess a => a -> Maybe H512
h512 (ByteString -> Maybe H512) -> ByteString -> Maybe H512
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
64 ByteString
rsv, HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.last ByteString
rsv)
  where
    rsv :: ByteString
rsv = (Integer, Integer, Word8) -> ByteString
forall rsv. ByteArray rsv => (Integer, Integer, Word8) -> rsv
Ecdsa.pack (PrivateKey -> a -> (Integer, Integer, Word8)
forall bin.
ByteArrayAccess bin =>
PrivateKey -> bin -> (Integer, Integer, Word8)
Ecdsa.sign PrivateKey
sec a
input)

instance MultiPair Ed25519 where
    type MultiSigner Ed25519 = P.MultiSigner
    type MultiAddress Ed25519 = P.MultiAddress
    type MultiSignature Ed25519 = P.MultiSignature
    multi_signer :: Ed25519 -> MultiSigner Ed25519
multi_signer = H256 -> MultiSigner
P.Ed25519Signer (H256 -> MultiSigner)
-> (Ed25519 -> H256) -> Ed25519 -> MultiSigner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ed25519 -> H256
Ed25519 -> PublicKey Ed25519
forall a. Pair a => a -> PublicKey a
public
    multi_address :: Ed25519 -> MultiAddress Ed25519
multi_address = H256 -> MultiAddress
P.MaId (H256 -> MultiAddress)
-> (Ed25519 -> H256) -> Ed25519 -> MultiAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiSigner -> H256
MultiSigner -> AccountId MultiSigner
forall a. IdentifyAccount a => a -> AccountId a
into_account (MultiSigner -> H256)
-> (Ed25519 -> MultiSigner) -> Ed25519 -> H256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ed25519 -> MultiSigner
Ed25519 -> MultiSigner Ed25519
forall a. MultiPair a => a -> MultiSigner a
multi_signer
    multi_sign :: forall ba.
ByteArrayAccess ba =>
Ed25519 -> ba -> MultiSignature Ed25519
multi_sign = (H512 -> MultiSignature
P.Ed25519Signature (H512 -> MultiSignature) -> (ba -> H512) -> ba -> MultiSignature
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((ba -> H512) -> ba -> MultiSignature)
-> (Ed25519 -> ba -> H512) -> Ed25519 -> ba -> MultiSignature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ed25519 -> ba -> H512
Ed25519 -> ba -> Signature Ed25519
forall ba. ByteArrayAccess ba => Ed25519 -> ba -> Signature Ed25519
forall a ba. (Pair a, ByteArrayAccess ba) => a -> ba -> Signature a
sign

instance MultiPair Ecdsa where
    type MultiSigner Ecdsa = P.MultiSigner
    type MultiAddress Ecdsa = P.MultiAddress
    type MultiSignature Ecdsa = P.MultiSignature
    multi_signer :: Ecdsa -> MultiSigner Ecdsa
multi_signer = (Word8 -> H256 -> MultiSigner) -> (Word8, H256) -> MultiSigner
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word8 -> H256 -> MultiSigner
P.EcdsaSigner ((Word8, H256) -> MultiSigner)
-> (Ecdsa -> (Word8, H256)) -> Ecdsa -> MultiSigner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ecdsa -> (Word8, H256)
Ecdsa -> PublicKey Ecdsa
forall a. Pair a => a -> PublicKey a
public
    multi_address :: Ecdsa -> MultiAddress Ecdsa
multi_address = H256 -> MultiAddress
P.MaId (H256 -> MultiAddress) -> (Ecdsa -> H256) -> Ecdsa -> MultiAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiSigner -> H256
MultiSigner -> AccountId MultiSigner
forall a. IdentifyAccount a => a -> AccountId a
into_account (MultiSigner -> H256) -> (Ecdsa -> MultiSigner) -> Ecdsa -> H256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ecdsa -> MultiSigner
Ecdsa -> MultiSigner Ecdsa
forall a. MultiPair a => a -> MultiSigner a
multi_signer
    multi_sign :: forall ba.
ByteArrayAccess ba =>
Ecdsa -> ba -> MultiSignature Ecdsa
multi_sign = ((H512 -> Word8 -> MultiSignature)
-> (H512, Word8) -> MultiSignature
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry H512 -> Word8 -> MultiSignature
P.EcdsaSignature ((H512, Word8) -> MultiSignature)
-> (ba -> (H512, Word8)) -> ba -> MultiSignature
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((ba -> (H512, Word8)) -> ba -> MultiSignature)
-> (Ecdsa -> ba -> (H512, Word8)) -> Ecdsa -> ba -> MultiSignature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ecdsa -> ba -> (H512, Word8)
Ecdsa -> ba -> Signature Ecdsa
forall ba. ByteArrayAccess ba => Ecdsa -> ba -> Signature Ecdsa
forall a ba. (Pair a, ByteArrayAccess ba) => a -> ba -> Signature a
sign