-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Ed25519 cryptographic primitives.

module Tezos.Crypto.Ed25519
  ( -- * Cryptographic primitive types
    PublicKey (..)
  , SecretKey
  , Signature (..)
  , detSecretKey
  , toPublic

  -- * Raw bytes (no checksums, tags or anything)
  , publicKeyToBytes
  , mkPublicKey
  , publicKeyLengthBytes
  , signatureToBytes
  , mkSignature
  , signatureLengthBytes

  -- * Formatting and parsing
  , formatPublicKey
  , mformatPublicKey
  , parsePublicKey
  , formatSecretKey
  , parseSecretKey
  , formatSignature
  , mformatSignature
  , parseSignature

  -- * Signing
  , sign
  , checkSignature
  ) where

import Crypto.Error (onCryptoFailure)
import qualified Crypto.PubKey.Ed25519 as Ed25519
import Data.ByteArray (ByteArray, ByteArrayAccess, convert)
import Fmt (Buildable, build)

import Michelson.Text
import Tezos.Crypto.Hash
import Tezos.Crypto.Util

----------------------------------------------------------------------------
-- Types, instances, conversions
----------------------------------------------------------------------------

-- | ED25519 public cryptographic key.
newtype PublicKey = PublicKey
  { PublicKey -> PublicKey
unPublicKey :: Ed25519.PublicKey
  } deriving stock (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
showList :: [PublicKey] -> ShowS
$cshowList :: [PublicKey] -> ShowS
show :: PublicKey -> String
$cshow :: PublicKey -> String
showsPrec :: Int -> PublicKey -> ShowS
$cshowsPrec :: Int -> PublicKey -> ShowS
Show, PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c== :: PublicKey -> PublicKey -> Bool
Eq, (forall x. PublicKey -> Rep PublicKey x)
-> (forall x. Rep PublicKey x -> PublicKey) -> Generic PublicKey
forall x. Rep PublicKey x -> PublicKey
forall x. PublicKey -> Rep PublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PublicKey x -> PublicKey
$cfrom :: forall x. PublicKey -> Rep PublicKey x
Generic)

instance NFData PublicKey

-- | ED25519 secret cryptographic key.
newtype SecretKey = SecretKey
  { SecretKey -> SecretKey
unSecretKey :: Ed25519.SecretKey
  } deriving stock (Int -> SecretKey -> ShowS
[SecretKey] -> ShowS
SecretKey -> String
(Int -> SecretKey -> ShowS)
-> (SecretKey -> String)
-> ([SecretKey] -> ShowS)
-> Show SecretKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretKey] -> ShowS
$cshowList :: [SecretKey] -> ShowS
show :: SecretKey -> String
$cshow :: SecretKey -> String
showsPrec :: Int -> SecretKey -> ShowS
$cshowsPrec :: Int -> SecretKey -> ShowS
Show, SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c== :: SecretKey -> SecretKey -> Bool
Eq, (forall x. SecretKey -> Rep SecretKey x)
-> (forall x. Rep SecretKey x -> SecretKey) -> Generic SecretKey
forall x. Rep SecretKey x -> SecretKey
forall x. SecretKey -> Rep SecretKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SecretKey x -> SecretKey
$cfrom :: forall x. SecretKey -> Rep SecretKey x
Generic)

instance NFData SecretKey

-- | Deterministicaly generate a secret key from seed.
detSecretKey :: ByteString -> SecretKey
detSecretKey :: ByteString -> SecretKey
detSecretKey seed :: ByteString
seed = SecretKey -> SecretKey
SecretKey (SecretKey -> SecretKey) -> SecretKey -> SecretKey
forall a b. (a -> b) -> a -> b
$ ByteString -> MonadPseudoRandom ChaChaDRG SecretKey -> SecretKey
forall a. ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic ByteString
seed MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Ed25519.generateSecretKey

-- | Create a public key from a secret key.
toPublic :: SecretKey -> PublicKey
toPublic :: SecretKey -> PublicKey
toPublic = PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey)
-> (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PublicKey
Ed25519.toPublic (SecretKey -> PublicKey)
-> (SecretKey -> SecretKey) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> SecretKey
unSecretKey

-- | ED25519 cryptographic signature.
newtype Signature = Signature
  { Signature -> Signature
unSignature :: Ed25519.Signature
  } deriving stock (Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show, Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c== :: Signature -> Signature -> Bool
Eq, (forall x. Signature -> Rep Signature x)
-> (forall x. Rep Signature x -> Signature) -> Generic Signature
forall x. Rep Signature x -> Signature
forall x. Signature -> Rep Signature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Signature x -> Signature
$cfrom :: forall x. Signature -> Rep Signature x
Generic)

instance NFData Signature

----------------------------------------------------------------------------
-- Conversion to/from raw bytes (no checksums, tags or anything)
----------------------------------------------------------------------------

-- | Convert a 'PublicKey' to raw bytes.
publicKeyToBytes :: ByteArray ba => PublicKey -> ba
publicKeyToBytes :: PublicKey -> ba
publicKeyToBytes = PublicKey -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (PublicKey -> ba) -> (PublicKey -> PublicKey) -> PublicKey -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PublicKey
unPublicKey

-- | Make a 'PublicKey' from raw bytes.
mkPublicKey :: ByteArrayAccess ba => ba -> Either CryptoParseError PublicKey
mkPublicKey :: ba -> Either CryptoParseError PublicKey
mkPublicKey =
  (CryptoError -> Either CryptoParseError PublicKey)
-> (PublicKey -> Either CryptoParseError PublicKey)
-> CryptoFailable PublicKey
-> Either CryptoParseError PublicKey
forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure (CryptoParseError -> Either CryptoParseError PublicKey
forall a b. a -> Either a b
Left (CryptoParseError -> Either CryptoParseError PublicKey)
-> (CryptoError -> CryptoParseError)
-> CryptoError
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> CryptoParseError
CryptoParseCryptoError) (PublicKey -> Either CryptoParseError PublicKey
forall a b. b -> Either a b
Right (PublicKey -> Either CryptoParseError PublicKey)
-> (PublicKey -> PublicKey)
-> PublicKey
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PublicKey
PublicKey) (CryptoFailable PublicKey -> Either CryptoParseError PublicKey)
-> (ba -> CryptoFailable PublicKey)
-> ba
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ba -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey

publicKeyLengthBytes :: Integral n => n
publicKeyLengthBytes :: n
publicKeyLengthBytes = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Ed25519.publicKeySize

-- | Convert a 'Signature' to raw bytes.
signatureToBytes :: ByteArray ba => Signature -> ba
signatureToBytes :: Signature -> ba
signatureToBytes = Signature -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Signature -> ba) -> (Signature -> Signature) -> Signature -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Signature
unSignature

-- | Make a 'Signature' from raw bytes.
mkSignature :: ByteArrayAccess ba => ba -> Either CryptoParseError Signature
mkSignature :: ba -> Either CryptoParseError Signature
mkSignature =
  (CryptoError -> Either CryptoParseError Signature)
-> (Signature -> Either CryptoParseError Signature)
-> CryptoFailable Signature
-> Either CryptoParseError Signature
forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure (CryptoParseError -> Either CryptoParseError Signature
forall a b. a -> Either a b
Left (CryptoParseError -> Either CryptoParseError Signature)
-> (CryptoError -> CryptoParseError)
-> CryptoError
-> Either CryptoParseError Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> CryptoParseError
CryptoParseCryptoError) (Signature -> Either CryptoParseError Signature
forall a b. b -> Either a b
Right (Signature -> Either CryptoParseError Signature)
-> (Signature -> Signature)
-> Signature
-> Either CryptoParseError Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Signature
Signature) (CryptoFailable Signature -> Either CryptoParseError Signature)
-> (ba -> CryptoFailable Signature)
-> ba
-> Either CryptoParseError Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ba -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature

signatureLengthBytes :: Integral n => n
signatureLengthBytes :: n
signatureLengthBytes = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Ed25519.signatureSize

mkSecretKey :: ByteArrayAccess ba => ba -> Either CryptoParseError SecretKey
mkSecretKey :: ba -> Either CryptoParseError SecretKey
mkSecretKey = (CryptoError -> Either CryptoParseError SecretKey)
-> (SecretKey -> Either CryptoParseError SecretKey)
-> CryptoFailable SecretKey
-> Either CryptoParseError SecretKey
forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure (CryptoParseError -> Either CryptoParseError SecretKey
forall a b. a -> Either a b
Left (CryptoParseError -> Either CryptoParseError SecretKey)
-> (CryptoError -> CryptoParseError)
-> CryptoError
-> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> CryptoParseError
CryptoParseCryptoError) (SecretKey -> Either CryptoParseError SecretKey
forall a b. b -> Either a b
Right (SecretKey -> Either CryptoParseError SecretKey)
-> (SecretKey -> SecretKey)
-> SecretKey
-> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> SecretKey
SecretKey) (CryptoFailable SecretKey -> Either CryptoParseError SecretKey)
-> (ba -> CryptoFailable SecretKey)
-> ba
-> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ba -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey

----------------------------------------------------------------------------
-- Magic bytes
----------------------------------------------------------------------------

publicKeyTag :: ByteString
publicKeyTag :: ByteString
publicKeyTag = "\13\15\37\217"

secretKeyTag :: ByteString
secretKeyTag :: ByteString
secretKeyTag = "\13\15\58\7"

signatureTag :: ByteString
signatureTag :: ByteString
signatureTag = "\9\245\205\134\18"

----------------------------------------------------------------------------
-- Formatting
----------------------------------------------------------------------------

formatPublicKey :: PublicKey -> Text
formatPublicKey :: PublicKey -> Text
formatPublicKey = ByteString -> PublicKey -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl ByteString
publicKeyTag (PublicKey -> Text)
-> (PublicKey -> PublicKey) -> PublicKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PublicKey
unPublicKey

mformatPublicKey :: PublicKey -> MText
mformatPublicKey :: PublicKey -> MText
mformatPublicKey = HasCallStack => Text -> MText
Text -> MText
mkMTextUnsafe (Text -> MText) -> (PublicKey -> Text) -> PublicKey -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Text
formatPublicKey

instance Buildable PublicKey where
  build :: PublicKey -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (PublicKey -> Text) -> PublicKey -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Text
formatPublicKey

parsePublicKey :: Text -> Either CryptoParseError PublicKey
parsePublicKey :: Text -> Either CryptoParseError PublicKey
parsePublicKey = ByteString
-> (ByteString -> Either CryptoParseError PublicKey)
-> Text
-> Either CryptoParseError PublicKey
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
publicKeyTag ByteString -> Either CryptoParseError PublicKey
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError PublicKey
mkPublicKey

formatSecretKey :: SecretKey -> Text
formatSecretKey :: SecretKey -> Text
formatSecretKey = ByteString -> SecretKey -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl ByteString
secretKeyTag (SecretKey -> Text)
-> (SecretKey -> SecretKey) -> SecretKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> SecretKey
unSecretKey

instance Buildable SecretKey where
  build :: SecretKey -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (SecretKey -> Text) -> SecretKey -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> Text
formatSecretKey

parseSecretKey :: Text -> Either CryptoParseError SecretKey
parseSecretKey :: Text -> Either CryptoParseError SecretKey
parseSecretKey = ByteString
-> (ByteString -> Either CryptoParseError SecretKey)
-> Text
-> Either CryptoParseError SecretKey
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
secretKeyTag ByteString -> Either CryptoParseError SecretKey
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError SecretKey
mkSecretKey

formatSignature :: Signature -> Text
formatSignature :: Signature -> Text
formatSignature = ByteString -> Signature -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl ByteString
signatureTag (Signature -> Text)
-> (Signature -> Signature) -> Signature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Signature
unSignature

mformatSignature :: Signature -> MText
mformatSignature :: Signature -> MText
mformatSignature = HasCallStack => Text -> MText
Text -> MText
mkMTextUnsafe (Text -> MText) -> (Signature -> Text) -> Signature -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
formatSignature

instance Buildable Signature where
  build :: Signature -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (Signature -> Text) -> Signature -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
formatSignature

parseSignature :: Text -> Either CryptoParseError Signature
parseSignature :: Text -> Either CryptoParseError Signature
parseSignature = ByteString
-> (ByteString -> Either CryptoParseError Signature)
-> Text
-> Either CryptoParseError Signature
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
signatureTag ByteString -> Either CryptoParseError Signature
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError Signature
mkSignature

----------------------------------------------------------------------------
-- Signing
----------------------------------------------------------------------------

-- | Sign a message using the secret key.
sign :: SecretKey -> ByteString -> Signature
sign :: SecretKey -> ByteString -> Signature
sign sk :: SecretKey
sk =
  Signature -> Signature
Signature (Signature -> Signature)
-> (ByteString -> Signature) -> ByteString -> Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign (SecretKey -> SecretKey
unSecretKey SecretKey
sk) (PublicKey -> PublicKey
unPublicKey (SecretKey -> PublicKey
toPublic SecretKey
sk)) (ByteString -> Signature)
-> (ByteString -> ByteString) -> ByteString -> Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
blake2b

-- | Check that a sequence of bytes has been signed with a given key.
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature (PublicKey pk :: PublicKey
pk) (Signature sig :: Signature
sig) bytes :: ByteString
bytes =
  PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
pk (ByteString -> ByteString
blake2b ByteString
bytes) Signature
sig