-- | 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

  -- * 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 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

-- | 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

-- | 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

----------------------------------------------------------------------------
-- 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