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

-- | Secp256k1 cryptographic primitives.

module Tezos.Crypto.Secp256k1
  ( -- * 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
  , sign
  , checkSignature
  ) where

import Crypto.Hash (Blake2b_256(..))
import Crypto.Number.Serialize (i2ospOf_, os2ip)
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Generate as ECC.Generate
import Crypto.PubKey.ECC.Types
  (Curve(..), CurveCommon(..), CurveName(..), CurvePrime(..), Point(..), curveSizeBits,
  getCurveByName)
import Crypto.Random (MonadRandom, drgNewSeed, seedFromInteger, withDRG)
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

curve :: Curve
curve :: Curve
curve = CurveName -> Curve
getCurveByName CurveName
SEC_p256k1

curveSizeBytes :: Int
curveSizeBytes :: Int
curveSizeBytes = Curve -> Int
curveSizeBits Curve
curve Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 8

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

-- | Secp256k1 public cryptographic key.
data PublicKey = PublicKey
  { PublicKey -> PublicKey
unPublicKey :: ECDSA.PublicKey
  , PublicKey -> Maybe ByteString
pkBytes :: Maybe ByteString
  -- ^ This is the hack we use to make serialization correct.
  -- Decoding is currently not implemented, so when we have to
  -- decode bytes we remember these bytes and produce some random
  -- public key.
  --
  -- TODO (#18) remove it.
  } 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, (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)

-- TODO (#18): derive it instead once the above hack is removed.
instance Eq PublicKey where
  pk1 :: PublicKey
pk1 == :: PublicKey -> PublicKey -> Bool
== pk2 :: PublicKey
pk2 = PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes @ByteString PublicKey
pk1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes PublicKey
pk2

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

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

rnfCurve :: Curve -> ()
rnfCurve :: Curve -> ()
rnfCurve cu :: Curve
cu =
  case Curve
cu of
    CurveF2m c :: CurveBinary
c -> CurveBinary -> ()
forall a. NFData a => a -> ()
rnf CurveBinary
c
    CurveFP (CurvePrime i :: Integer
i (CurveCommon a :: Integer
a b :: Integer
b c :: Point
c d :: Integer
d e :: Integer
e)) ->
      (Integer, Integer, Integer, Point, Integer, Integer) -> ()
forall a. NFData a => a -> ()
rnf (Integer
i, Integer
a, Integer
b, Point
c, Integer
d, Integer
e)

instance NFData PublicKey where
  rnf :: PublicKey -> ()
rnf (PublicKey (ECDSA.PublicKey cu :: Curve
cu q :: Point
q) bytes :: Maybe ByteString
bytes)
    = Curve -> ()
rnfCurve Curve
cu () -> () -> ()
forall a b. a -> b -> b
`seq` (Maybe ByteString, Point) -> ()
forall a. NFData a => a -> ()
rnf (Maybe ByteString
bytes, Point
q)

-- | Secp256k1 secret cryptographic key.
newtype SecretKey = SecretKey
  { SecretKey -> KeyPair
unSecretKey :: ECDSA.KeyPair
  } 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 where
  rnf :: SecretKey -> ()
rnf (SecretKey (ECDSA.KeyPair cu :: Curve
cu pp :: Point
pp pn :: Integer
pn)) =
    Curve -> ()
rnfCurve Curve
cu () -> () -> ()
forall a b. a -> b -> b
`seq` (Point, Integer) -> ()
forall a. NFData a => a -> ()
rnf (Point
pp, Integer
pn)

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

detSecretKeyDo :: MonadRandom m => m SecretKey
detSecretKeyDo :: m SecretKey
detSecretKeyDo = KeyPair -> SecretKey
SecretKey (KeyPair -> SecretKey) -> m KeyPair -> m SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  (publicKey :: PublicKey
publicKey, privateKey :: PrivateKey
privateKey) <- Curve -> m (PublicKey, PrivateKey)
forall (m :: * -> *).
MonadRandom m =>
Curve -> m (PublicKey, PrivateKey)
ECC.Generate.generate Curve
curve
  KeyPair -> m KeyPair
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> m KeyPair) -> KeyPair -> m KeyPair
forall a b. (a -> b) -> a -> b
$
    Curve -> Point -> Integer -> KeyPair
ECDSA.KeyPair Curve
curve (PublicKey -> Point
ECDSA.public_q PublicKey
publicKey) (PrivateKey -> Integer
ECDSA.private_d PrivateKey
privateKey)

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 =
  (PublicKey -> Maybe ByteString -> PublicKey)
-> Maybe ByteString -> PublicKey -> PublicKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip PublicKey -> Maybe ByteString -> PublicKey
PublicKey Maybe ByteString
forall a. Maybe a
Nothing (PublicKey -> PublicKey)
-> (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Curve -> Point -> PublicKey
ECDSA.PublicKey Curve
curve (Point -> PublicKey)
-> (SecretKey -> Point) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(ECDSA.KeyPair _ pp :: Point
pp _) -> Point
pp) (KeyPair -> Point) -> (SecretKey -> KeyPair) -> SecretKey -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> KeyPair
unSecretKey

-- | Secp256k1 cryptographic signature.
newtype Signature = Signature
  { Signature -> Signature
unSignature :: ECDSA.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 Arbitrary Signature where
  arbitrary :: Gen Signature
arbitrary = do
    ChaChaDRG
seed <- Seed -> ChaChaDRG
drgNewSeed (Seed -> ChaChaDRG) -> (Integer -> Seed) -> Integer -> ChaChaDRG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Seed
seedFromInteger (Integer -> ChaChaDRG) -> Gen Integer -> Gen ChaChaDRG
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
    Word8
byteToSign <- Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
    return $ (Signature, ChaChaDRG) -> Signature
forall a b. (a, b) -> a
fst ((Signature, ChaChaDRG) -> Signature)
-> (Signature, ChaChaDRG) -> Signature
forall a b. (a -> b) -> a -> b
$ ChaChaDRG
-> MonadPseudoRandom ChaChaDRG Signature -> (Signature, ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG ChaChaDRG
seed (MonadPseudoRandom ChaChaDRG Signature -> (Signature, ChaChaDRG))
-> MonadPseudoRandom ChaChaDRG Signature -> (Signature, ChaChaDRG)
forall a b. (a -> b) -> a -> b
$ do
      SecretKey
sk <- MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
detSecretKeyDo
      SecretKey -> ByteString -> MonadPseudoRandom ChaChaDRG Signature
forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
sign SecretKey
sk (OneItem ByteString -> ByteString
forall x. One x => OneItem x -> x
one Word8
OneItem ByteString
byteToSign)

instance NFData Signature where
  rnf :: Signature -> ()
rnf (Signature (ECDSA.Signature a :: Integer
a b :: Integer
b)) = Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
a () -> () -> ()
forall a b. a -> b -> b
`seq` Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
b

genSignature :: MonadGen m => m Signature
genSignature :: m Signature
genSignature = do
  ChaChaDRG
seed <- Seed -> ChaChaDRG
drgNewSeed (Seed -> ChaChaDRG) -> (Integer -> Seed) -> Integer -> ChaChaDRG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Seed
seedFromInteger (Integer -> ChaChaDRG) -> m Integer -> m ChaChaDRG
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Integer -> m Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Integer -> Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> a -> Range a
Range.linearFrom 0 -1000 1000)
  Word8
byteToSign <- Range Word8 -> m Word8
forall (m :: * -> *). MonadGen m => Range Word8 -> m Word8
Gen.word8 Range Word8
forall a. (Bounded a, Integral a) => Range a
Range.linearBounded
  return $ (Signature, ChaChaDRG) -> Signature
forall a b. (a, b) -> a
fst ((Signature, ChaChaDRG) -> Signature)
-> (Signature, ChaChaDRG) -> Signature
forall a b. (a -> b) -> a -> b
$ ChaChaDRG
-> MonadPseudoRandom ChaChaDRG Signature -> (Signature, ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG ChaChaDRG
seed (MonadPseudoRandom ChaChaDRG Signature -> (Signature, ChaChaDRG))
-> MonadPseudoRandom ChaChaDRG Signature -> (Signature, ChaChaDRG)
forall a b. (a -> b) -> a -> b
$ do
    SecretKey
sk <- MonadPseudoRandom ChaChaDRG SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
detSecretKeyDo
    SecretKey -> ByteString -> MonadPseudoRandom ChaChaDRG Signature
forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
sign SecretKey
sk (OneItem ByteString -> ByteString
forall x. One x => OneItem x -> x
one Word8
OneItem ByteString
byteToSign)

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

-- | Convert a 'PublicKey' to raw bytes.
--
-- TODO (#18): apparently it uses compressed SEC format as described in
-- <https://www.oreilly.com/library/view/programming-bitcoin/9781492031482/ch04.html>
-- However, it is not tested yet.
publicKeyToBytes :: forall ba. ByteArray ba => PublicKey -> ba
publicKeyToBytes :: PublicKey -> ba
publicKeyToBytes (PublicKey _ (Just bytes :: ByteString
bytes)) = ByteString -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
bytes
publicKeyToBytes (PublicKey (ECDSA.PublicKey _ publicPoint :: Point
publicPoint) Nothing) =
  case Point
publicPoint of
    Point x :: Integer
x y :: Integer
y -> Integer -> ba
prefix Integer
y ba -> ba -> ba
forall bs. ByteArray bs => bs -> bs -> bs
`BA.append` Integer -> ba
forall ba. ByteArray ba => Integer -> ba
coordToBytes Integer
x
    PointO -> Text -> ba
forall a. HasCallStack => Text -> a
error "PublicKey somehow contains infinity point"
  where
    prefix :: Integer -> ba
    prefix :: Integer -> ba
prefix y :: Integer
y
      | Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
y = Word8 -> ba
forall a. ByteArray a => Word8 -> a
BA.singleton 0x03
      | Bool
otherwise = Word8 -> ba
forall a. ByteArray a => Word8 -> a
BA.singleton 0x02

-- | Make a 'PublicKey' from raw bytes.
--
-- TODO (#18): it should decode from compressed SEC format, but it's left
-- for a future task, so for now we return a constant.
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
$ PublicKey -> Maybe ByteString -> PublicKey
PublicKey (Curve -> Point -> PublicKey
ECDSA.PublicKey Curve
curve (Point -> PublicKey) -> Point -> PublicKey
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point 11 12) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ 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 = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> n) -> Int -> n
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
curveSizeBytes

-- | Convert a 'PublicKey' to raw bytes.
--
-- TODO (#18): apparently a signature always has 64 bytes, so this
-- format might be correct, but it is not tested.
signatureToBytes :: ByteArray ba => Signature -> ba
signatureToBytes :: Signature -> ba
signatureToBytes (Signature (ECDSA.Signature r :: Integer
r s :: Integer
s)) =
  Integer -> ba
forall ba. ByteArray ba => Integer -> ba
coordToBytes Integer
r ba -> ba -> ba
forall a. Semigroup a => a -> a -> a
<> Integer -> ba
forall ba. ByteArray ba => Integer -> ba
coordToBytes Integer
s

-- | Make a 'Signature' from raw bytes.
--
-- TODO (#18): apparently a signature always has 64 bytes, so this
-- format might be correct, but it is not tested.
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
  , (rBytes :: ba
rBytes, sBytes :: ba
sBytes) <- Int -> ba -> (ba, ba)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
BA.splitAt Int
curveSizeBytes ba
ba =
    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
$ Signature -> Signature
Signature (Integer -> Integer -> Signature
ECDSA.Signature (ba -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ba
rBytes) (ba -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ba
sBytes))
  | 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 = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> n) -> Int -> n
forall a b. (a -> b) -> a -> b
$ Int
curveSizeBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
curveSizeBytes

-- TODO (#18): maybe this function doesn't make sense.
-- We are using `i2ospOf_` because `curveSizeBits` ensures that
-- the number won't have more than that many bytes.
coordToBytes :: ByteArray ba => Integer -> ba
coordToBytes :: Integer -> ba
coordToBytes = Int -> Integer -> ba
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
curveSizeBytes

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

publicKeyTag :: ByteString
publicKeyTag :: ByteString
publicKeyTag = "\003\254\226\086"

signatureTag :: ByteString
signatureTag :: ByteString
signatureTag = "\013\115\101\019\063"

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

-- | Sign a message using the secret key.
sign :: MonadRandom m => SecretKey -> ByteString -> m Signature
sign :: SecretKey -> ByteString -> m Signature
sign (SecretKey keyPair :: KeyPair
keyPair) =
  (Signature -> Signature) -> m Signature -> m Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Signature -> Signature
Signature (m Signature -> m Signature)
-> (ByteString -> m Signature) -> ByteString -> m Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> Blake2b_256 -> ByteString -> m Signature
forall msg hash (m :: * -> *).
(ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m) =>
PrivateKey -> hash -> msg -> m Signature
ECDSA.sign (KeyPair -> PrivateKey
ECDSA.toPrivateKey KeyPair
keyPair) Blake2b_256
Blake2b_256

-- | 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) =
  Blake2b_256 -> PublicKey -> Signature -> ByteString -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify Blake2b_256
Blake2b_256 PublicKey
pk Signature
sig