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

-- | Utilities shared by multiple cryptographic primitives.

module 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 Crypto.Error (CryptoError)
import Crypto.Number.Serialize (i2ospOf_, os2ip)
import Crypto.Number.ModArithmetic (squareRoot)
import Crypto.Random (ChaChaDRG, MonadPseudoRandom, drgNewSeed, seedFromInteger, withDRG)
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Generate as ECC.Generate
import Crypto.PubKey.ECC.Types
  (Curve(..), CurveCommon(..), CurvePrime(..), Point(..), curveSizeBits)
import qualified Data.Binary.Get as Get
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base58 as Base58
import qualified Data.ByteString.Lazy as LBS
import Fmt (Buildable, Builder, (+|), (|+), build, fmt, hexF)

import Tezos.Crypto.Hash
import 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 = NFData String => String -> ()
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
show

instance Buildable CryptoParseError where
  build :: CryptoParseError -> Builder
build =
    \case
      CryptoParseWrongBase58Check -> "Wrong base58check encoding of bytes"
      CryptoParseWrongTag tag :: ByteString
tag -> "Prefix is wrong tag: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
forall b. FromBuilder b => Builder -> b
fmt (ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
tag)
      CryptoParseCryptoError err :: CryptoError
err ->
        "Cryptographic library reported an error: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        String -> Builder
forall p. Buildable p => p -> Builder
build (CryptoError -> String
forall e. Exception e => e -> String
displayException CryptoError
err)
      CryptoParseUnexpectedLength what :: Builder
what l :: Int
l ->
        "Unexpected length of " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
what Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall p. Buildable p => p -> Builder
build Int
l
      CryptoParseBinaryError err :: Text
err -> "" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
err Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""

-- | 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 bs :: 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 :: Text
text = do
  ByteString
bytes <- Alphabet -> ByteString -> Maybe ByteString
Base58.decodeBase58 Alphabet
Base58.bitcoinAlphabet (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
text)
  let (payload :: ByteString
payload, chk :: 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
- 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 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 prefix :: ByteString
prefix text :: Text
text =
  case Text -> Maybe ByteString
decodeBase58Check Text
text of
    Nothing -> B58CheckWithPrefixError
-> Either B58CheckWithPrefixError ByteString
forall a b. a -> Either a b
Left B58CheckWithPrefixError
B58CheckWithPrefixWrongEncoding
    Just bs :: ByteString
bs ->
      let (actualPrefix :: ByteString
actualPrefix, payload :: 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 :: ByteString -> x -> Text
formatImpl tag :: 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 :: ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl expectedTag :: ByteString
expectedTag constructor :: ByteString -> Either CryptoParseError res
constructor text :: Text
text = do
  let convertErr :: B58CheckWithPrefixError -> CryptoParseError
      convertErr :: B58CheckWithPrefixError -> CryptoParseError
convertErr =
        \case B58CheckWithPrefixWrongPrefix prefix :: ByteString
prefix -> ByteString -> CryptoParseError
CryptoParseWrongTag ByteString
prefix
              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
text
  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 :: NonEmpty (Either e a) -> Either e a
firstRight (h :: Either e a
h :| rest :: [Either e a]
rest) =
  case Either e a
h of
    Left e :: 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 -> 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 :: ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic seed :: 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 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)

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

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

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

publicKeyLengthBytes_ :: Integral n => Curve -> n
publicKeyLengthBytes_ :: Curve -> n
publicKeyLengthBytes_ curve :: Curve
curve = 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
+ (Curve -> Int
curveSizeBytes Curve
curve)

-- | Make a '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_ :: Curve -> ba -> Either CryptoParseError PublicKey
mkPublicKey_ curve :: Curve
curve ba :: ba
ba
  | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Curve -> Int
forall n. Integral n => Curve -> n
publicKeyLengthBytes_ Curve
curve) = do
      (isYEven :: Bool
isYEven, x :: 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)
      (p :: Integer
p, a :: Integer
a, b :: 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
^ (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 "Could not find square root.")
      let (evenBeta :: Integer
evenBeta, oddBeta :: Integer
oddBeta) =
            if (Integer
beta Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` 2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0) 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 "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 p :: Integer
p (CurveCommon a :: Integer
a b :: Integer
b _ _ _)) -> (Integer, Integer, Integer)
-> Either CryptoParseError (Integer, Integer, Integer)
forall a b. b -> Either a b
Right (Integer
p, Integer
a, Integer
b)
      CurveF2m _ -> 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
        "Should not happen. Expect `curve` to be `CurveFP` but got `CurveF2m` instead."

    toCryptoEither :: Either (_a, _b, String) (_c, _d, a) -> Either CryptoParseError a
    toCryptoEither :: Either (_a, _b, String) (_c, _d, a) -> Either CryptoParseError a
toCryptoEither g :: Either (_a, _b, String) (_c, _d, a)
g =
      case Either (_a, _b, String) (_c, _d, a)
g of
        Right (_, _, a :: a
a) -> a -> Either CryptoParseError a
forall a b. b -> Either a b
Right a
a
        Left (_, _, err :: 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 'PublicKey' to raw bytes.
publicKeyToBytes_ :: forall ba. (BA.ByteArray ba, HasCallStack) => Curve -> ECDSA.PublicKey -> ba
publicKeyToBytes_ :: Curve -> PublicKey -> ba
publicKeyToBytes_ curve :: Curve
curve (ECDSA.PublicKey _ publicPoint :: Point
publicPoint) =
  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` Curve -> Integer -> ba
forall ba. ByteArray ba => Curve -> Integer -> ba
coordToBytes Curve
curve 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

-- | Convert a 'PublicKey' to raw bytes.
signatureToBytes_ :: BA.ByteArray ba => Curve -> ECDSA.Signature -> ba
signatureToBytes_ :: Curve -> Signature -> ba
signatureToBytes_ curve :: Curve
curve (ECDSA.Signature r :: Integer
r s :: 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 'PublicKey' to raw bytes.
secretKeyToBytes_ :: BA.ByteArray ba => ECDSA.KeyPair -> ba
secretKeyToBytes_ :: KeyPair -> ba
secretKeyToBytes_ (ECDSA.KeyPair c :: Curve
c _ s :: Integer
s) =
  Curve -> Integer -> ba
forall ba. ByteArray ba => Curve -> Integer -> ba
coordToBytes Curve
c Integer
s

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

-- | Make a 'SecretKey' from raw bytes.
mkSecretKey_ :: BA.ByteArray ba => Curve -> ba -> ECDSA.KeyPair
mkSecretKey_ :: Curve -> ba -> KeyPair
mkSecretKey_ c :: Curve
c ba :: 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