-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Utilities shared by multiple cryptographic primitives.

module Morley.Tezos.Crypto.Util
  ( CryptoParseError (..)
  , encodeBase58Check
  , decodeBase58Check
  , B58CheckWithPrefixError (..)
  , decodeBase58CheckWithPrefix
  , formatImpl
  , parseImpl
  , firstRight
  , deterministic

  -- * ECDSA Utils
  , rnfCurve
  , publicKeyLengthBytes_
  , mkSignature_
  , mkSecretKey_
  , secretKeyToBytes_
  , signatureToBytes_
  , mkPublicKey_
  , publicKeyToBytes_
  , signatureLengthBytes_
  ) where

import Debug qualified (show)

import Crypto.Error (CryptoError)
import Crypto.Number.ModArithmetic (squareRoot)
import Crypto.Number.Serialize (i2ospOf_, os2ip)
import Crypto.PubKey.ECC.ECDSA qualified as ECDSA
import Crypto.PubKey.ECC.Generate qualified as ECC.Generate
import Crypto.PubKey.ECC.Types
  (Curve(..), CurveCommon(..), CurvePrime(..), Point(..), curveSizeBits)
import Crypto.Random (ChaChaDRG, MonadPseudoRandom, drgNewSeed, seedFromInteger, withDRG)
import Data.Binary.Get qualified as Get
import Data.ByteArray qualified as BA
import Data.ByteString qualified as BS
import Data.ByteString.Base58 qualified as Base58
import Data.ByteString.Lazy qualified as LBS
import Fmt (Buildable, Builder, build, hexF)
import Text.PrettyPrint.Leijen.Text (int, textStrict, (<+>))

import Morley.Michelson.Printer.Util (RenderDoc(..), buildRenderDocExtended, renderAnyBuildable)
import Morley.Tezos.Crypto.Hash
import Morley.Util.Binary (getRemainingByteStringCopy)


-- | Error that can happen during parsing of cryptographic primitive types.
data CryptoParseError
  = CryptoParseWrongBase58Check
  | CryptoParseWrongTag ByteString
  | CryptoParseCryptoError CryptoError
  | CryptoParseUnexpectedLength Builder Int
  | CryptoParseBinaryError Text
  deriving stock (Int -> CryptoParseError -> ShowS
[CryptoParseError] -> ShowS
CryptoParseError -> String
(Int -> CryptoParseError -> ShowS)
-> (CryptoParseError -> String)
-> ([CryptoParseError] -> ShowS)
-> Show CryptoParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CryptoParseError] -> ShowS
$cshowList :: [CryptoParseError] -> ShowS
show :: CryptoParseError -> String
$cshow :: CryptoParseError -> String
showsPrec :: Int -> CryptoParseError -> ShowS
$cshowsPrec :: Int -> CryptoParseError -> ShowS
Show, CryptoParseError -> CryptoParseError -> Bool
(CryptoParseError -> CryptoParseError -> Bool)
-> (CryptoParseError -> CryptoParseError -> Bool)
-> Eq CryptoParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CryptoParseError -> CryptoParseError -> Bool
$c/= :: CryptoParseError -> CryptoParseError -> Bool
== :: CryptoParseError -> CryptoParseError -> Bool
$c== :: CryptoParseError -> CryptoParseError -> Bool
Eq)

instance NFData CryptoParseError where
  rnf :: CryptoParseError -> ()
rnf = forall a. NFData a => a -> ()
rnf @String (String -> ())
-> (CryptoParseError -> String) -> CryptoParseError -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoParseError -> String
forall b a. (Show a, IsString b) => a -> b
Debug.show

instance Buildable CryptoParseError where
  build :: CryptoParseError -> Builder
build = CryptoParseError -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDocExtended

instance RenderDoc CryptoParseError where
  renderDoc :: RenderContext -> CryptoParseError -> Doc
renderDoc RenderContext
_ = \case
    CryptoParseError
CryptoParseWrongBase58Check -> Doc
"Wrong base58check encoding of bytes"
    CryptoParseWrongTag ByteString
tag -> Doc
"Prefix is wrong tag:" Doc -> Doc -> Doc
<+> (Builder -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable (Builder -> Doc) -> Builder -> Doc
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
tag)
    CryptoParseCryptoError CryptoError
err ->
      Doc
"Cryptographic library reported an error: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        (String -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ (CryptoError -> String
forall e. Exception e => e -> String
displayException CryptoError
err))
    CryptoParseUnexpectedLength Builder
what Int
l ->
      Doc
"Unexpected length of" Doc -> Doc -> Doc
<+> Builder -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable Builder
what Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
":" Doc -> Doc -> Doc
<+> Int -> Doc
int Int
l
    CryptoParseBinaryError Text
err -> Text -> Doc
textStrict Text
err



-- | Encode a bytestring in Base58Check format.
encodeBase58Check :: ByteString -> Text
encodeBase58Check :: ByteString -> Text
encodeBase58Check =
  ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> ByteString -> ByteString
Base58.encodeBase58 Alphabet
Base58.bitcoinAlphabet (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
withCheckSum
  where
    withCheckSum :: ByteString -> ByteString
    withCheckSum :: ByteString -> ByteString
withCheckSum ByteString
bs = ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
checkSum ByteString
bs

-- | Decode a bytestring from Base58Check format.
decodeBase58Check :: Text -> Maybe ByteString
decodeBase58Check :: Text -> Maybe ByteString
decodeBase58Check Text
base58text = do
  ByteString
bytes <- Alphabet -> ByteString -> Maybe ByteString
Base58.decodeBase58 Alphabet
Base58.bitcoinAlphabet (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
base58text)
  let (ByteString
payload, ByteString
chk) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) ByteString
bytes
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString
chk ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
checkSum ByteString
payload
  return ByteString
payload

checkSum :: ByteString -> ByteString
checkSum :: ByteString -> ByteString
checkSum = Int -> ByteString -> ByteString
BS.take Int
4 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString
sha256 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
sha256)

data B58CheckWithPrefixError
  = B58CheckWithPrefixWrongPrefix ByteString
  | B58CheckWithPrefixWrongEncoding
  deriving stock (Int -> B58CheckWithPrefixError -> ShowS
[B58CheckWithPrefixError] -> ShowS
B58CheckWithPrefixError -> String
(Int -> B58CheckWithPrefixError -> ShowS)
-> (B58CheckWithPrefixError -> String)
-> ([B58CheckWithPrefixError] -> ShowS)
-> Show B58CheckWithPrefixError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [B58CheckWithPrefixError] -> ShowS
$cshowList :: [B58CheckWithPrefixError] -> ShowS
show :: B58CheckWithPrefixError -> String
$cshow :: B58CheckWithPrefixError -> String
showsPrec :: Int -> B58CheckWithPrefixError -> ShowS
$cshowsPrec :: Int -> B58CheckWithPrefixError -> ShowS
Show)

-- | Parse a base58check encoded value expecting some prefix. If the
-- actual prefix matches the expected one, it's stripped of and the
-- resulting payload is returned.
decodeBase58CheckWithPrefix ::
  ByteString -> Text -> Either B58CheckWithPrefixError ByteString
decodeBase58CheckWithPrefix :: ByteString -> Text -> Either B58CheckWithPrefixError ByteString
decodeBase58CheckWithPrefix ByteString
prefix Text
base58text =
  case Text -> Maybe ByteString
decodeBase58Check Text
base58text of
    Maybe ByteString
Nothing -> B58CheckWithPrefixError
-> Either B58CheckWithPrefixError ByteString
forall a b. a -> Either a b
Left B58CheckWithPrefixError
B58CheckWithPrefixWrongEncoding
    Just ByteString
bs ->
      let (ByteString
actualPrefix, ByteString
payload) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
prefix) ByteString
bs
       in if ByteString
actualPrefix ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
prefix
          then ByteString -> Either B58CheckWithPrefixError ByteString
forall a b. b -> Either a b
Right ByteString
payload
          else B58CheckWithPrefixError
-> Either B58CheckWithPrefixError ByteString
forall a b. a -> Either a b
Left (ByteString -> B58CheckWithPrefixError
B58CheckWithPrefixWrongPrefix ByteString
actualPrefix)

-- | Template for 'format*' functions.
formatImpl :: BA.ByteArrayAccess x => ByteString -> x -> Text
formatImpl :: forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl ByteString
tag = ByteString -> Text
encodeBase58Check (ByteString -> Text) -> (x -> ByteString) -> x -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend ByteString
tag (ByteString -> ByteString) -> (x -> ByteString) -> x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

-- | Template for 'parse*' functions.
parseImpl
  :: ByteString
  -> (ByteString -> Either CryptoParseError res)
  -> Text
  -> Either CryptoParseError res
parseImpl :: forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
expectedTag ByteString -> Either CryptoParseError res
constructor Text
textToParse = do
  let convertErr :: B58CheckWithPrefixError -> CryptoParseError
      convertErr :: B58CheckWithPrefixError -> CryptoParseError
convertErr =
        \case B58CheckWithPrefixWrongPrefix ByteString
prefix -> ByteString -> CryptoParseError
CryptoParseWrongTag ByteString
prefix
              B58CheckWithPrefixError
B58CheckWithPrefixWrongEncoding -> CryptoParseError
CryptoParseWrongBase58Check
  ByteString
payload <- (B58CheckWithPrefixError -> CryptoParseError)
-> Either B58CheckWithPrefixError ByteString
-> Either CryptoParseError ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first B58CheckWithPrefixError -> CryptoParseError
convertErr (Either B58CheckWithPrefixError ByteString
 -> Either CryptoParseError ByteString)
-> Either B58CheckWithPrefixError ByteString
-> Either CryptoParseError ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Text -> Either B58CheckWithPrefixError ByteString
decodeBase58CheckWithPrefix ByteString
expectedTag Text
textToParse
  ByteString -> Either CryptoParseError res
constructor ByteString
payload

-- | Returns first encountered 'Right' in a list. If there are none,
-- returns arbitrary 'Left'.
-- It is useful to implement parsing.
firstRight :: NonEmpty (Either e a) -> Either e a
firstRight :: forall e a. NonEmpty (Either e a) -> Either e a
firstRight (Either e a
h :| [Either e a]
rest) =
  case Either e a
h of
    Left e
e -> Either e a
-> (NonEmpty (Either e a) -> Either e a)
-> Maybe (NonEmpty (Either e a))
-> Either e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Either e a
forall a b. a -> Either a b
Left e
e) NonEmpty (Either e a) -> Either e a
forall e a. NonEmpty (Either e a) -> Either e a
firstRight (Maybe (NonEmpty (Either e a)) -> Either e a)
-> Maybe (NonEmpty (Either e a)) -> Either e a
forall a b. (a -> b) -> a -> b
$ [Either e a] -> Maybe (NonEmpty (Either e a))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Either e a]
rest
    Right a
a -> a -> Either e a
forall a b. b -> Either a b
Right a
a

-- | Do randomized action using specified seed.
deterministic :: ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic :: forall a. ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic ByteString
seed = (a, ChaChaDRG) -> a
forall a b. (a, b) -> a
fst ((a, ChaChaDRG) -> a)
-> (MonadPseudoRandom ChaChaDRG a -> (a, ChaChaDRG))
-> MonadPseudoRandom ChaChaDRG a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChaChaDRG -> MonadPseudoRandom ChaChaDRG a -> (a, ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG ChaChaDRG
chachaSeed
  where
    chachaSeed :: ChaChaDRG
chachaSeed = Seed -> ChaChaDRG
drgNewSeed (Seed -> ChaChaDRG)
-> (ByteString -> Seed) -> ByteString -> ChaChaDRG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Seed
seedFromInteger (Integer -> Seed) -> (ByteString -> Integer) -> ByteString -> Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (ByteString -> ChaChaDRG) -> ByteString -> ChaChaDRG
forall a b. (a -> b) -> a -> b
$ ByteString
seed

---------------------------------------------------------
-- Utilities shared by @Secp256k1@ and @P256@.
---------------------------------------------------------

rnfCurve :: Curve -> ()
rnfCurve :: Curve -> ()
rnfCurve Curve
cu =
  case Curve
cu of
    CurveF2m CurveBinary
c -> CurveBinary -> ()
forall a. NFData a => a -> ()
rnf CurveBinary
c
    CurveFP (CurvePrime Integer
i (CurveCommon Integer
a Integer
b Point
c Integer
d 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)

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

signatureLengthBytes_ :: (Integral n, CheckIntSubType Int n) => Curve -> n
signatureLengthBytes_ :: forall n. (Integral n, CheckIntSubType Int n) => Curve -> n
signatureLengthBytes_ Curve
curve = Int -> n
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (Int -> n) -> Int -> n
forall a b. (a -> b) -> a -> b
$ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Curve -> Int
curveSizeBytes Curve
curve)

coordToBytes :: BA.ByteArray ba => Curve -> Integer -> ba
coordToBytes :: forall ba. ByteArray ba => Curve -> Integer -> ba
coordToBytes Curve
curve = Int -> Integer -> ba
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ (Curve -> Int
curveSizeBytes Curve
curve)

publicKeyLengthBytes_ :: (Integral n, CheckIntSubType Int n) => Curve -> n
publicKeyLengthBytes_ :: forall n. (Integral n, CheckIntSubType Int n) => Curve -> n
publicKeyLengthBytes_ Curve
curve = Int -> n
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (Int -> n) -> Int -> n
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Curve -> Int
curveSizeBytes Curve
curve)

-- | Make a 'ECDSA.PublicKey' from raw bytes.
--
-- Raw bytes are in the format of Compressed SEC Format. Refer to this article on how this is parsed:
-- <https://www.oreilly.com/library/view/programming-bitcoin/9781492031482/ch04.html>
--
mkPublicKey_ :: BA.ByteArrayAccess ba => Curve -> ba -> Either CryptoParseError ECDSA.PublicKey
mkPublicKey_ :: forall ba.
ByteArrayAccess ba =>
Curve -> ba -> Either CryptoParseError PublicKey
mkPublicKey_ Curve
curve ba
ba
  | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Curve -> Int
forall n. (Integral n, CheckIntSubType Int n) => Curve -> n
publicKeyLengthBytes_ Curve
curve) = do
      (Bool
isYEven, Integer
x) <- Either
  (ByteString, ByteOffset, String)
  (ByteString, ByteOffset, (Bool, Integer))
-> Either CryptoParseError (Bool, Integer)
forall _a _b _c _d a.
Either (_a, _b, String) (_c, _d, a) -> Either CryptoParseError a
toCryptoEither (Either
   (ByteString, ByteOffset, String)
   (ByteString, ByteOffset, (Bool, Integer))
 -> Either CryptoParseError (Bool, Integer))
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, (Bool, Integer))
-> Either CryptoParseError (Bool, Integer)
forall a b. (a -> b) -> a -> b
$ Get (Bool, Integer)
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, (Bool, Integer))
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Get.runGetOrFail Get (Bool, Integer)
getX
          (ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
ba)
      (Integer
p, Integer
a, Integer
b) <- Curve -> Either CryptoParseError (Integer, Integer, Integer)
fromCurveFP Curve
curve
      let alpha :: Integer
alpha = Integer
x Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
3 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b
      Integer
beta <- Integer -> Integer -> Maybe Integer
squareRoot Integer
p Integer
alpha
                Maybe Integer
-> (Maybe Integer -> Either CryptoParseError Integer)
-> Either CryptoParseError Integer
forall a b. a -> (a -> b) -> b
& CryptoParseError
-> Maybe Integer -> Either CryptoParseError Integer
forall l r. l -> Maybe r -> Either l r
maybeToRight (Text -> CryptoParseError
CryptoParseBinaryError Text
"Could not find square root.")
      let (Integer
evenBeta, Integer
oddBeta) =
            if Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
beta then
              (Integer
beta, Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
beta)
            else
              (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
beta, Integer
beta)
      let y :: Integer
y = if Bool
isYEven then Integer
evenBeta
                         else Integer
oddBeta
      PublicKey -> Either CryptoParseError PublicKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> Either CryptoParseError PublicKey)
-> PublicKey -> Either CryptoParseError PublicKey
forall a b. (a -> b) -> a -> b
$ Curve -> Point -> PublicKey
ECDSA.PublicKey Curve
curve (Point -> PublicKey) -> Point -> PublicKey
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point Integer
x Integer
y
  | 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 Builder
"public key" Int
l
  where
    l :: Int
l = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
ba

    getX :: Get.Get (Bool, Integer)
    getX :: Get (Bool, Integer)
getX = do
      Word8
yPrefix <- Get Word8
Get.getWord8
      ByteString
xBytes <- Get ByteString
getRemainingByteStringCopy
      return (Word8 -> Bool
forall a. Integral a => a -> Bool
even Word8
yPrefix, ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
xBytes)

    fromCurveFP :: Curve -> Either CryptoParseError (Integer, Integer, Integer)
    fromCurveFP :: Curve -> Either CryptoParseError (Integer, Integer, Integer)
fromCurveFP = \case
      CurveFP (CurvePrime Integer
p (CurveCommon Integer
a Integer
b Point
_ Integer
_ Integer
_)) -> (Integer, Integer, Integer)
-> Either CryptoParseError (Integer, Integer, Integer)
forall a b. b -> Either a b
Right (Integer
p, Integer
a, Integer
b)
      CurveF2m CurveBinary
_ -> CryptoParseError
-> Either CryptoParseError (Integer, Integer, Integer)
forall a b. a -> Either a b
Left (CryptoParseError
 -> Either CryptoParseError (Integer, Integer, Integer))
-> CryptoParseError
-> Either CryptoParseError (Integer, Integer, Integer)
forall a b. (a -> b) -> a -> b
$ Text -> CryptoParseError
CryptoParseBinaryError
        Text
"Should not happen. Expect `curve` to be `CurveFP` but got `CurveF2m` instead."

    toCryptoEither :: Either (_a, _b, String) (_c, _d, a) -> Either CryptoParseError a
    toCryptoEither :: forall _a _b _c _d a.
Either (_a, _b, String) (_c, _d, a) -> Either CryptoParseError a
toCryptoEither Either (_a, _b, String) (_c, _d, a)
g =
      case Either (_a, _b, String) (_c, _d, a)
g of
        Right (_c
_, _d
_, a
a) -> a -> Either CryptoParseError a
forall a b. b -> Either a b
Right a
a
        Left (_a
_, _b
_, String
err) -> CryptoParseError -> Either CryptoParseError a
forall a b. a -> Either a b
Left (CryptoParseError -> Either CryptoParseError a)
-> CryptoParseError -> Either CryptoParseError a
forall a b. (a -> b) -> a -> b
$ Text -> CryptoParseError
CryptoParseBinaryError (Text -> CryptoParseError) -> Text -> CryptoParseError
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText String
err

-- | Convert a 'ECDSA.PublicKey' to raw bytes.
publicKeyToBytes_ :: forall ba. (BA.ByteArray ba, HasCallStack) => Curve -> ECDSA.PublicKey -> ba
publicKeyToBytes_ :: forall ba. (ByteArray ba, HasCallStack) => Curve -> PublicKey -> ba
publicKeyToBytes_ Curve
curve (ECDSA.PublicKey Curve
_ Point
publicPoint) =
  case Point
publicPoint of
    Point Integer
x Integer
y -> Integer -> ba
prefix Integer
y ba -> ba -> ba
forall bs. ByteArray bs => bs -> bs -> bs
`BA.append` Curve -> Integer -> ba
forall ba. ByteArray ba => Curve -> Integer -> ba
coordToBytes Curve
curve Integer
x
    Point
PointO -> Text -> ba
forall a. HasCallStack => Text -> a
error Text
"PublicKey somehow contains infinity point"
  where
    prefix :: Integer -> ba
    prefix :: Integer -> ba
prefix Integer
y
      | Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
y = Word8 -> ba
forall a. ByteArray a => Word8 -> a
BA.singleton Word8
0x03
      | Bool
otherwise = Word8 -> ba
forall a. ByteArray a => Word8 -> a
BA.singleton Word8
0x02

-- | Convert a 'ECDSA.PublicKey' to raw bytes.
signatureToBytes_ :: BA.ByteArray ba => Curve -> ECDSA.Signature -> ba
signatureToBytes_ :: forall ba. ByteArray ba => Curve -> Signature -> ba
signatureToBytes_ Curve
curve (ECDSA.Signature Integer
r Integer
s) =
  Curve -> Integer -> ba
forall ba. ByteArray ba => Curve -> Integer -> ba
coordToBytes Curve
curve Integer
r ba -> ba -> ba
forall a. Semigroup a => a -> a -> a
<> Curve -> Integer -> ba
forall ba. ByteArray ba => Curve -> Integer -> ba
coordToBytes Curve
curve Integer
s

-- | Convert a 'ECDSA.PublicKey' to raw bytes.
secretKeyToBytes_ :: BA.ByteArray ba => ECDSA.KeyPair -> ba
secretKeyToBytes_ :: forall ba. ByteArray ba => KeyPair -> ba
secretKeyToBytes_ (ECDSA.KeyPair Curve
c Point
_ Integer
s) =
  Curve -> Integer -> ba
forall ba. ByteArray ba => Curve -> Integer -> ba
coordToBytes Curve
c Integer
s

-- | Make a 'ECDSA.Signature' from raw bytes.
mkSignature_ :: BA.ByteArray ba => Curve -> ba -> Either CryptoParseError ECDSA.Signature
mkSignature_ :: forall ba.
ByteArray ba =>
Curve -> ba -> Either CryptoParseError Signature
mkSignature_ Curve
curve ba
ba
  | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Curve -> Int
forall n. (Integral n, CheckIntSubType Int n) => Curve -> n
signatureLengthBytes_ Curve
curve)
  , (ba
rBytes, ba
sBytes) <- Int -> ba -> (ba, ba)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
BA.splitAt (Curve -> Int
curveSizeBytes Curve
curve) 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
$ 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 Builder
"signature" Int
l
  where
    l :: Int
l = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
ba

-- | Make a 'ECDSA.KeyPair' from raw bytes representing a secret key.
mkSecretKey_ :: BA.ByteArray ba => Curve -> ba -> ECDSA.KeyPair
mkSecretKey_ :: forall ba. ByteArray ba => Curve -> ba -> KeyPair
mkSecretKey_ Curve
c ba
ba =
  let s :: Integer
s = ba -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ba
ba
      p :: Point
p = Curve -> Integer -> Point
ECC.Generate.generateQ Curve
c Integer
s
  in Curve -> Point -> Integer -> KeyPair
ECDSA.KeyPair Curve
c Point
p Integer
s