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

-- | P256 cryptographic primitives.
--
-- This module is mostly a stub, it doesn't implement actual crypto.
-- TODO (#18) implement crypto properly.

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

  -- * Generators
  , genPublicKey
  , genSecretKey
  , genSignature

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

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

  -- * Signing
  , checkSignature
  ) where

import Crypto.Random (getRandomBytes)
import Data.ByteArray (ByteArray, ByteArrayAccess)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Fmt (Buildable, build)
import Hedgehog (MonadGen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.QuickCheck (Arbitrary(..), vector)

import Michelson.Text
import Tezos.Crypto.Util

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

-- | P256 public cryptographic key.
newtype PublicKey = PublicKey
  { PublicKey -> ByteString
unPublicKey :: ByteString
  } 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 Arbitrary PublicKey where
  arbitrary :: Gen PublicKey
arbitrary = SecretKey -> PublicKey
toPublic (SecretKey -> PublicKey) -> Gen SecretKey -> Gen PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SecretKey
forall a. Arbitrary a => Gen a
arbitrary

instance NFData PublicKey

genPublicKey :: MonadGen m => m PublicKey
genPublicKey :: m PublicKey
genPublicKey = SecretKey -> PublicKey
toPublic (SecretKey -> PublicKey) -> m SecretKey -> m PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SecretKey
forall (m :: * -> *). MonadGen m => m SecretKey
genSecretKey

-- | P256 secret cryptographic key.
newtype SecretKey = SecretKey
  { SecretKey -> ByteString
unSecretKey :: ByteString
  } 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 =
  ByteString -> SecretKey
SecretKey (ByteString -> SecretKey) -> ByteString -> SecretKey
forall a b. (a -> b) -> a -> b
$ ByteString -> MonadPseudoRandom ChaChaDRG ByteString -> ByteString
forall a. ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic ByteString
seed (MonadPseudoRandom ChaChaDRG ByteString -> ByteString)
-> MonadPseudoRandom ChaChaDRG ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> MonadPseudoRandom ChaChaDRG ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
forall n. Integral n => n
publicKeyLengthBytes

instance Arbitrary SecretKey where
  arbitrary :: Gen SecretKey
arbitrary = ByteString -> SecretKey
detSecretKey (ByteString -> SecretKey)
-> ([Word8] -> ByteString) -> [Word8] -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> SecretKey) -> Gen [Word8] -> Gen SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector 32

genSecretKey :: MonadGen m => m SecretKey
genSecretKey :: m SecretKey
genSecretKey = ByteString -> SecretKey
detSecretKey (ByteString -> SecretKey) -> m ByteString -> m SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Range Int
forall a. a -> Range a
Range.singleton 32)

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

-- | P256 cryptographic signature.
newtype Signature = Signature
  { Signature -> ByteString
unSignature :: ByteString
  } 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 Arbitrary Signature where
  arbitrary :: Gen Signature
arbitrary = ByteString -> Signature
Signature (ByteString -> Signature)
-> ([Word8] -> ByteString) -> [Word8] -> Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Signature) -> Gen [Word8] -> Gen Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
forall n. Integral n => n
signatureLengthBytes Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

instance NFData Signature

genSignature :: MonadGen m => m Signature
genSignature :: m Signature
genSignature = ByteString -> Signature
Signature (ByteString -> Signature) -> m ByteString -> m Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Range Int
forall a. a -> Range a
Range.singleton Int
forall n. Integral n => n
signatureLengthBytes)

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

-- | Convert a 'PublicKey' to raw bytes.
--
-- TODO (#18): implement properly.
publicKeyToBytes :: forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes :: PublicKey -> ba
publicKeyToBytes = ByteString -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> ba) -> (PublicKey -> ByteString) -> PublicKey -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ByteString
unPublicKey

-- | Make a 'PublicKey' from raw bytes.
--
-- TODO (#18): implement properly.
mkPublicKey :: ByteArrayAccess ba => ba -> Either CryptoParseError PublicKey
mkPublicKey :: ba -> Either CryptoParseError PublicKey
mkPublicKey ba :: ba
ba
  | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall n. Integral n => n
publicKeyLengthBytes =
    PublicKey -> Either CryptoParseError PublicKey
forall a b. b -> Either a b
Right (PublicKey -> Either CryptoParseError PublicKey)
-> PublicKey -> Either CryptoParseError PublicKey
forall a b. (a -> b) -> a -> b
$ ByteString -> PublicKey
PublicKey (ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
ba)
  | Bool
otherwise =
    CryptoParseError -> Either CryptoParseError PublicKey
forall a b. a -> Either a b
Left (CryptoParseError -> Either CryptoParseError PublicKey)
-> CryptoParseError -> Either CryptoParseError PublicKey
forall a b. (a -> b) -> a -> b
$ Builder -> Int -> CryptoParseError
CryptoParseUnexpectedLength "public key" Int
l
  where
    l :: Int
l = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
ba

publicKeyLengthBytes :: Integral n => n
publicKeyLengthBytes :: n
publicKeyLengthBytes = 33

-- | Convert a 'PublicKey' to raw bytes.
--
-- TODO (#18): implement properly.
signatureToBytes :: ByteArray ba => Signature -> ba
signatureToBytes :: Signature -> ba
signatureToBytes = ByteString -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> ba) -> (Signature -> ByteString) -> Signature -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
unSignature

-- | Make a 'Signature' from raw bytes.
--
-- TODO (#18): implement properly.
mkSignature :: ByteArray ba => ba -> Either CryptoParseError Signature
mkSignature :: ba -> Either CryptoParseError Signature
mkSignature ba :: ba
ba
  | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall n. Integral n => n
signatureLengthBytes =
    Signature -> Either CryptoParseError Signature
forall a b. b -> Either a b
Right (Signature -> Either CryptoParseError Signature)
-> Signature -> Either CryptoParseError Signature
forall a b. (a -> b) -> a -> b
$ ByteString -> Signature
Signature (ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
ba)
  | Bool
otherwise =
    CryptoParseError -> Either CryptoParseError Signature
forall a b. a -> Either a b
Left (CryptoParseError -> Either CryptoParseError Signature)
-> CryptoParseError -> Either CryptoParseError Signature
forall a b. (a -> b) -> a -> b
$ Builder -> Int -> CryptoParseError
CryptoParseUnexpectedLength "signature" Int
l
  where
    l :: Int
l = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
ba

signatureLengthBytes :: Integral n => n
signatureLengthBytes :: n
signatureLengthBytes = 64

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

publicKeyTag :: ByteString
publicKeyTag :: ByteString
publicKeyTag = "\003\178\139\127"

signatureTag :: ByteString
signatureTag :: ByteString
signatureTag = "\054\240\044\052"

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

formatPublicKey :: PublicKey -> Text
formatPublicKey :: PublicKey -> Text
formatPublicKey = ByteString -> ByteString -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl @ByteString ByteString
publicKeyTag (ByteString -> Text)
-> (PublicKey -> ByteString) -> PublicKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes

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

formatSignature :: Signature -> Text
formatSignature :: Signature -> Text
formatSignature = ByteString -> ByteString -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl @ByteString ByteString
signatureTag (ByteString -> Text)
-> (Signature -> ByteString) -> Signature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
forall ba. ByteArray ba => Signature -> ba
signatureToBytes

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. ByteArray ba => ba -> Either CryptoParseError Signature
mkSignature

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

-- | Check that a sequence of bytes has been signed with a given key.
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature _ _ _ = Bool
False