{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- Needed to ensure that our hash is the right size
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-- According to the documentation for unsafePerformIO:
--
-- > Make sure that the either you switch off let-floating
-- > (-fno-full-laziness), or that the call to unsafePerformIO cannot float
-- > outside a lambda.
--
-- If we do not switch off let-floating, our calls to unsafeDupablePerformIO for
-- FFI functions become nondeterministic in their behaviour when run with
-- parallelism enabled (such as -with-rtsopts=-N), possibly yielding wrong
-- answers on a range of tasks, including serialization.
{-# OPTIONS_GHC -fno-full-laziness #-}

module Cardano.Crypto.DSIGN.EcdsaSecp256k1 (
  MessageHash,
  toMessageHash,
  fromMessageHash,
  hashAndPack,
  EcdsaSecp256k1DSIGN,
  VerKeyDSIGN (..),
  SignKeyDSIGN (..),
  SigDSIGN (..),
) where

import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (encodedSizeExpr, toCBOR))
import Cardano.Crypto.DSIGN.Class (
  DSIGNAlgorithm (
    SeedSizeDSIGN,
    SigDSIGN,
    SignKeyDSIGN,
    Signable,
    SizeSigDSIGN,
    SizeSignKeyDSIGN,
    SizeVerKeyDSIGN,
    VerKeyDSIGN,
    algorithmNameDSIGN,
    deriveVerKeyDSIGN,
    genKeyDSIGN,
    rawDeserialiseSigDSIGN,
    rawDeserialiseSignKeyDSIGN,
    rawDeserialiseVerKeyDSIGN,
    rawSerialiseSigDSIGN,
    rawSerialiseSignKeyDSIGN,
    rawSerialiseVerKeyDSIGN,
    signDSIGN,
    verifyDSIGN
  ),
  decodeSigDSIGN,
  decodeSignKeyDSIGN,
  decodeVerKeyDSIGN,
  encodeSigDSIGN,
  encodeSignKeyDSIGN,
  encodeVerKeyDSIGN,
  encodedSigDSIGNSizeExpr,
  encodedSignKeyDSIGNSizeExpr,
  encodedVerKeyDSIGNSizeExpr,
 )
import Cardano.Crypto.Hash.Class (HashAlgorithm (SizeHash, digest))
import Cardano.Crypto.PinnedSizedBytes (
  PinnedSizedBytes,
  psbCreateLen,
  psbCreateSized,
  psbCreateSizedResult,
  psbFromByteStringCheck,
  psbToByteString,
  psbUseAsCPtrLen,
  psbUseAsSizedPtr,
 )
import Cardano.Crypto.SECP256K1.C (
  secpCtxPtr,
  secpEcCompressed,
  secpEcPubkeyCreate,
  secpEcPubkeyParse,
  secpEcPubkeySerialize,
  secpEcdsaSign,
  secpEcdsaSignatureParseCompact,
  secpEcdsaSignatureSerializeCompact,
  secpEcdsaVerify,
 )
import Cardano.Crypto.SECP256K1.Constants (
  SECP256K1_ECDSA_MESSAGE_BYTES,
  SECP256K1_ECDSA_PRIVKEY_BYTES,
  SECP256K1_ECDSA_PUBKEY_BYTES,
  SECP256K1_ECDSA_PUBKEY_BYTES_INTERNAL,
  SECP256K1_ECDSA_SIGNATURE_BYTES,
  SECP256K1_ECDSA_SIGNATURE_BYTES_INTERNAL,
 )
import Cardano.Crypto.Seed (runMonadRandomWithSeed)
import Control.DeepSeq (NFData)
import Control.Monad (unless, void, when)
import Crypto.Random (getRandomBytes)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Data.Proxy (Proxy)
import Foreign.C.Types (CSize)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.Storable (peek, poke)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import System.IO.Unsafe (unsafeDupablePerformIO)

-- | As ECDSA signatures on the SECP256k1 curve sign 32-byte hashes, rather than
-- whole messages, we provide a helper (opaque) newtype to ensure that the size
-- of the input for signing and verification is strictly bounded.
--
-- = Important note
--
-- If you are verifying a message using the algorithm provided here, you should
-- hash the message yourself before verifying. Specifically, the sender should
-- give you the message itself to verify, rather than the hash of the message
-- used to compute the signature.
newtype MessageHash = MH (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
  deriving (MessageHash -> MessageHash -> Bool
(MessageHash -> MessageHash -> Bool)
-> (MessageHash -> MessageHash -> Bool) -> Eq MessageHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageHash -> MessageHash -> Bool
== :: MessageHash -> MessageHash -> Bool
$c/= :: MessageHash -> MessageHash -> Bool
/= :: MessageHash -> MessageHash -> Bool
Eq) via (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
  deriving stock (Int -> MessageHash -> ShowS
[MessageHash] -> ShowS
MessageHash -> String
(Int -> MessageHash -> ShowS)
-> (MessageHash -> String)
-> ([MessageHash] -> ShowS)
-> Show MessageHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageHash -> ShowS
showsPrec :: Int -> MessageHash -> ShowS
$cshow :: MessageHash -> String
show :: MessageHash -> String
$cshowList :: [MessageHash] -> ShowS
showList :: [MessageHash] -> ShowS
Show)

-- | Take a blob of bytes (which is presumed to be a 32-byte hash), verify its
-- length, and package it into a 'MessageHash' if that length is exactly 32.
toMessageHash :: ByteString -> Maybe MessageHash
toMessageHash :: ByteString -> Maybe MessageHash
toMessageHash ByteString
bs = PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES -> MessageHash
MH (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES -> MessageHash)
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
-> Maybe MessageHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (PinnedSizedBytes n)
psbFromByteStringCheck ByteString
bs

-- | Turn a 'MessageHash' into its bytes without a length marker.
fromMessageHash :: MessageHash -> ByteString
fromMessageHash :: MessageHash -> ByteString
fromMessageHash (MH PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb) = PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb

-- | A helper to use with the 'HashAlgorithm' API, as this can ensure sizing.
hashAndPack ::
  forall (h :: Type).
  (HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
  Proxy h -> ByteString -> MessageHash
hashAndPack :: forall h.
(HashAlgorithm h, SizeHash h ~ SECP256K1_ECDSA_MESSAGE_BYTES) =>
Proxy h -> ByteString -> MessageHash
hashAndPack Proxy h
p ByteString
bs = case ByteString
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (PinnedSizedBytes n)
psbFromByteStringCheck (ByteString
 -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES))
-> (ByteString -> ByteString)
-> ByteString
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy h -> ByteString -> ByteString
forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
forall (proxy :: * -> *). proxy h -> ByteString -> ByteString
digest Proxy h
p (ByteString
 -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES))
-> ByteString
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
forall a b. (a -> b) -> a -> b
$ ByteString
bs of
  Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
Nothing ->
    String -> MessageHash
forall a. HasCallStack => String -> a
error (String -> MessageHash) -> String -> MessageHash
forall a b. (a -> b) -> a -> b
$
      String
"hashAndPack: unexpected mismatch of guaranteed hash length\n"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Please report this, it's a bug!"
  Just PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb -> PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES -> MessageHash
MH PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb

data EcdsaSecp256k1DSIGN

instance DSIGNAlgorithm EcdsaSecp256k1DSIGN where
  type SeedSizeDSIGN EcdsaSecp256k1DSIGN = SECP256K1_ECDSA_PRIVKEY_BYTES
  type SizeSigDSIGN EcdsaSecp256k1DSIGN = SECP256K1_ECDSA_SIGNATURE_BYTES
  type SizeSignKeyDSIGN EcdsaSecp256k1DSIGN = SECP256K1_ECDSA_PRIVKEY_BYTES
  type SizeVerKeyDSIGN EcdsaSecp256k1DSIGN = SECP256K1_ECDSA_PUBKEY_BYTES
  type Signable EcdsaSecp256k1DSIGN = ((~) MessageHash)
  newtype VerKeyDSIGN EcdsaSecp256k1DSIGN
    = VerKeyEcdsaSecp256k1 (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES_INTERNAL)
    deriving newtype (VerKeyDSIGN EcdsaSecp256k1DSIGN
-> VerKeyDSIGN EcdsaSecp256k1DSIGN -> Bool
(VerKeyDSIGN EcdsaSecp256k1DSIGN
 -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> Bool)
-> (VerKeyDSIGN EcdsaSecp256k1DSIGN
    -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> Bool)
-> Eq (VerKeyDSIGN EcdsaSecp256k1DSIGN)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerKeyDSIGN EcdsaSecp256k1DSIGN
-> VerKeyDSIGN EcdsaSecp256k1DSIGN -> Bool
== :: VerKeyDSIGN EcdsaSecp256k1DSIGN
-> VerKeyDSIGN EcdsaSecp256k1DSIGN -> Bool
$c/= :: VerKeyDSIGN EcdsaSecp256k1DSIGN
-> VerKeyDSIGN EcdsaSecp256k1DSIGN -> Bool
/= :: VerKeyDSIGN EcdsaSecp256k1DSIGN
-> VerKeyDSIGN EcdsaSecp256k1DSIGN -> Bool
Eq, VerKeyDSIGN EcdsaSecp256k1DSIGN -> ()
(VerKeyDSIGN EcdsaSecp256k1DSIGN -> ())
-> NFData (VerKeyDSIGN EcdsaSecp256k1DSIGN)
forall a. (a -> ()) -> NFData a
$crnf :: VerKeyDSIGN EcdsaSecp256k1DSIGN -> ()
rnf :: VerKeyDSIGN EcdsaSecp256k1DSIGN -> ()
NFData)
    deriving stock (Int -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> ShowS
[VerKeyDSIGN EcdsaSecp256k1DSIGN] -> ShowS
VerKeyDSIGN EcdsaSecp256k1DSIGN -> String
(Int -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> ShowS)
-> (VerKeyDSIGN EcdsaSecp256k1DSIGN -> String)
-> ([VerKeyDSIGN EcdsaSecp256k1DSIGN] -> ShowS)
-> Show (VerKeyDSIGN EcdsaSecp256k1DSIGN)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> ShowS
showsPrec :: Int -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> ShowS
$cshow :: VerKeyDSIGN EcdsaSecp256k1DSIGN -> String
show :: VerKeyDSIGN EcdsaSecp256k1DSIGN -> String
$cshowList :: [VerKeyDSIGN EcdsaSecp256k1DSIGN] -> ShowS
showList :: [VerKeyDSIGN EcdsaSecp256k1DSIGN] -> ShowS
Show, (forall x.
 VerKeyDSIGN EcdsaSecp256k1DSIGN
 -> Rep (VerKeyDSIGN EcdsaSecp256k1DSIGN) x)
-> (forall x.
    Rep (VerKeyDSIGN EcdsaSecp256k1DSIGN) x
    -> VerKeyDSIGN EcdsaSecp256k1DSIGN)
-> Generic (VerKeyDSIGN EcdsaSecp256k1DSIGN)
forall x.
Rep (VerKeyDSIGN EcdsaSecp256k1DSIGN) x
-> VerKeyDSIGN EcdsaSecp256k1DSIGN
forall x.
VerKeyDSIGN EcdsaSecp256k1DSIGN
-> Rep (VerKeyDSIGN EcdsaSecp256k1DSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
VerKeyDSIGN EcdsaSecp256k1DSIGN
-> Rep (VerKeyDSIGN EcdsaSecp256k1DSIGN) x
from :: forall x.
VerKeyDSIGN EcdsaSecp256k1DSIGN
-> Rep (VerKeyDSIGN EcdsaSecp256k1DSIGN) x
$cto :: forall x.
Rep (VerKeyDSIGN EcdsaSecp256k1DSIGN) x
-> VerKeyDSIGN EcdsaSecp256k1DSIGN
to :: forall x.
Rep (VerKeyDSIGN EcdsaSecp256k1DSIGN) x
-> VerKeyDSIGN EcdsaSecp256k1DSIGN
Generic)
    deriving anyclass (Context -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
Proxy (VerKeyDSIGN EcdsaSecp256k1DSIGN) -> String
(Context
 -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo))
-> (Context
    -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo))
-> (Proxy (VerKeyDSIGN EcdsaSecp256k1DSIGN) -> String)
-> NoThunks (VerKeyDSIGN EcdsaSecp256k1DSIGN)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
noThunks :: Context -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> VerKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (VerKeyDSIGN EcdsaSecp256k1DSIGN) -> String
showTypeOf :: Proxy (VerKeyDSIGN EcdsaSecp256k1DSIGN) -> String
NoThunks)
  newtype SignKeyDSIGN EcdsaSecp256k1DSIGN
    = SignKeyEcdsaSecp256k1 (PinnedSizedBytes SECP256K1_ECDSA_PRIVKEY_BYTES)
    deriving newtype (SignKeyDSIGN EcdsaSecp256k1DSIGN
-> SignKeyDSIGN EcdsaSecp256k1DSIGN -> Bool
(SignKeyDSIGN EcdsaSecp256k1DSIGN
 -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> Bool)
-> (SignKeyDSIGN EcdsaSecp256k1DSIGN
    -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> Bool)
-> Eq (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignKeyDSIGN EcdsaSecp256k1DSIGN
-> SignKeyDSIGN EcdsaSecp256k1DSIGN -> Bool
== :: SignKeyDSIGN EcdsaSecp256k1DSIGN
-> SignKeyDSIGN EcdsaSecp256k1DSIGN -> Bool
$c/= :: SignKeyDSIGN EcdsaSecp256k1DSIGN
-> SignKeyDSIGN EcdsaSecp256k1DSIGN -> Bool
/= :: SignKeyDSIGN EcdsaSecp256k1DSIGN
-> SignKeyDSIGN EcdsaSecp256k1DSIGN -> Bool
Eq, SignKeyDSIGN EcdsaSecp256k1DSIGN -> ()
(SignKeyDSIGN EcdsaSecp256k1DSIGN -> ())
-> NFData (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall a. (a -> ()) -> NFData a
$crnf :: SignKeyDSIGN EcdsaSecp256k1DSIGN -> ()
rnf :: SignKeyDSIGN EcdsaSecp256k1DSIGN -> ()
NFData)
    deriving stock (Int -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> ShowS
[SignKeyDSIGN EcdsaSecp256k1DSIGN] -> ShowS
SignKeyDSIGN EcdsaSecp256k1DSIGN -> String
(Int -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> ShowS)
-> (SignKeyDSIGN EcdsaSecp256k1DSIGN -> String)
-> ([SignKeyDSIGN EcdsaSecp256k1DSIGN] -> ShowS)
-> Show (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> ShowS
showsPrec :: Int -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> ShowS
$cshow :: SignKeyDSIGN EcdsaSecp256k1DSIGN -> String
show :: SignKeyDSIGN EcdsaSecp256k1DSIGN -> String
$cshowList :: [SignKeyDSIGN EcdsaSecp256k1DSIGN] -> ShowS
showList :: [SignKeyDSIGN EcdsaSecp256k1DSIGN] -> ShowS
Show, (forall x.
 SignKeyDSIGN EcdsaSecp256k1DSIGN
 -> Rep (SignKeyDSIGN EcdsaSecp256k1DSIGN) x)
-> (forall x.
    Rep (SignKeyDSIGN EcdsaSecp256k1DSIGN) x
    -> SignKeyDSIGN EcdsaSecp256k1DSIGN)
-> Generic (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall x.
Rep (SignKeyDSIGN EcdsaSecp256k1DSIGN) x
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
forall x.
SignKeyDSIGN EcdsaSecp256k1DSIGN
-> Rep (SignKeyDSIGN EcdsaSecp256k1DSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SignKeyDSIGN EcdsaSecp256k1DSIGN
-> Rep (SignKeyDSIGN EcdsaSecp256k1DSIGN) x
from :: forall x.
SignKeyDSIGN EcdsaSecp256k1DSIGN
-> Rep (SignKeyDSIGN EcdsaSecp256k1DSIGN) x
$cto :: forall x.
Rep (SignKeyDSIGN EcdsaSecp256k1DSIGN) x
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
to :: forall x.
Rep (SignKeyDSIGN EcdsaSecp256k1DSIGN) x
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
Generic)
    deriving anyclass (Context -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
Proxy (SignKeyDSIGN EcdsaSecp256k1DSIGN) -> String
(Context
 -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo))
-> (Context
    -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo))
-> (Proxy (SignKeyDSIGN EcdsaSecp256k1DSIGN) -> String)
-> NoThunks (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
noThunks :: Context -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SignKeyDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (SignKeyDSIGN EcdsaSecp256k1DSIGN) -> String
showTypeOf :: Proxy (SignKeyDSIGN EcdsaSecp256k1DSIGN) -> String
NoThunks)
  newtype SigDSIGN EcdsaSecp256k1DSIGN
    = SigEcdsaSecp256k1 (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES_INTERNAL)
    deriving newtype (SigDSIGN EcdsaSecp256k1DSIGN
-> SigDSIGN EcdsaSecp256k1DSIGN -> Bool
(SigDSIGN EcdsaSecp256k1DSIGN
 -> SigDSIGN EcdsaSecp256k1DSIGN -> Bool)
-> (SigDSIGN EcdsaSecp256k1DSIGN
    -> SigDSIGN EcdsaSecp256k1DSIGN -> Bool)
-> Eq (SigDSIGN EcdsaSecp256k1DSIGN)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigDSIGN EcdsaSecp256k1DSIGN
-> SigDSIGN EcdsaSecp256k1DSIGN -> Bool
== :: SigDSIGN EcdsaSecp256k1DSIGN
-> SigDSIGN EcdsaSecp256k1DSIGN -> Bool
$c/= :: SigDSIGN EcdsaSecp256k1DSIGN
-> SigDSIGN EcdsaSecp256k1DSIGN -> Bool
/= :: SigDSIGN EcdsaSecp256k1DSIGN
-> SigDSIGN EcdsaSecp256k1DSIGN -> Bool
Eq, SigDSIGN EcdsaSecp256k1DSIGN -> ()
(SigDSIGN EcdsaSecp256k1DSIGN -> ())
-> NFData (SigDSIGN EcdsaSecp256k1DSIGN)
forall a. (a -> ()) -> NFData a
$crnf :: SigDSIGN EcdsaSecp256k1DSIGN -> ()
rnf :: SigDSIGN EcdsaSecp256k1DSIGN -> ()
NFData)
    deriving stock (Int -> SigDSIGN EcdsaSecp256k1DSIGN -> ShowS
[SigDSIGN EcdsaSecp256k1DSIGN] -> ShowS
SigDSIGN EcdsaSecp256k1DSIGN -> String
(Int -> SigDSIGN EcdsaSecp256k1DSIGN -> ShowS)
-> (SigDSIGN EcdsaSecp256k1DSIGN -> String)
-> ([SigDSIGN EcdsaSecp256k1DSIGN] -> ShowS)
-> Show (SigDSIGN EcdsaSecp256k1DSIGN)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigDSIGN EcdsaSecp256k1DSIGN -> ShowS
showsPrec :: Int -> SigDSIGN EcdsaSecp256k1DSIGN -> ShowS
$cshow :: SigDSIGN EcdsaSecp256k1DSIGN -> String
show :: SigDSIGN EcdsaSecp256k1DSIGN -> String
$cshowList :: [SigDSIGN EcdsaSecp256k1DSIGN] -> ShowS
showList :: [SigDSIGN EcdsaSecp256k1DSIGN] -> ShowS
Show, (forall x.
 SigDSIGN EcdsaSecp256k1DSIGN
 -> Rep (SigDSIGN EcdsaSecp256k1DSIGN) x)
-> (forall x.
    Rep (SigDSIGN EcdsaSecp256k1DSIGN) x
    -> SigDSIGN EcdsaSecp256k1DSIGN)
-> Generic (SigDSIGN EcdsaSecp256k1DSIGN)
forall x.
Rep (SigDSIGN EcdsaSecp256k1DSIGN) x
-> SigDSIGN EcdsaSecp256k1DSIGN
forall x.
SigDSIGN EcdsaSecp256k1DSIGN
-> Rep (SigDSIGN EcdsaSecp256k1DSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SigDSIGN EcdsaSecp256k1DSIGN
-> Rep (SigDSIGN EcdsaSecp256k1DSIGN) x
from :: forall x.
SigDSIGN EcdsaSecp256k1DSIGN
-> Rep (SigDSIGN EcdsaSecp256k1DSIGN) x
$cto :: forall x.
Rep (SigDSIGN EcdsaSecp256k1DSIGN) x
-> SigDSIGN EcdsaSecp256k1DSIGN
to :: forall x.
Rep (SigDSIGN EcdsaSecp256k1DSIGN) x
-> SigDSIGN EcdsaSecp256k1DSIGN
Generic)
    deriving anyclass (Context -> SigDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
Proxy (SigDSIGN EcdsaSecp256k1DSIGN) -> String
(Context -> SigDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo))
-> (Context
    -> SigDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo))
-> (Proxy (SigDSIGN EcdsaSecp256k1DSIGN) -> String)
-> NoThunks (SigDSIGN EcdsaSecp256k1DSIGN)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SigDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
noThunks :: Context -> SigDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SigDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SigDSIGN EcdsaSecp256k1DSIGN -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (SigDSIGN EcdsaSecp256k1DSIGN) -> String
showTypeOf :: Proxy (SigDSIGN EcdsaSecp256k1DSIGN) -> String
NoThunks)
  algorithmNameDSIGN :: forall (proxy :: * -> *). proxy EcdsaSecp256k1DSIGN -> String
algorithmNameDSIGN proxy EcdsaSecp256k1DSIGN
_ = String
"ecdsa-secp256k1"
  {-# NOINLINE deriveVerKeyDSIGN #-}
  deriveVerKeyDSIGN :: SignKeyDSIGN EcdsaSecp256k1DSIGN -> VerKeyDSIGN EcdsaSecp256k1DSIGN
deriveVerKeyDSIGN (SignKeyEcdsaSecp256k1 PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
skBytes) =
    PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> VerKeyDSIGN EcdsaSecp256k1DSIGN
VerKeyEcdsaSecp256k1 (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
 -> VerKeyDSIGN EcdsaSecp256k1DSIGN)
-> ((SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
     -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
    -> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> VerKeyDSIGN EcdsaSecp256k1DSIGN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
forall a. IO a -> a
unsafeDupablePerformIO (IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
 -> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> ((SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
     -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
skBytes ((SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
  -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
 -> VerKeyDSIGN EcdsaSecp256k1DSIGN)
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> VerKeyDSIGN EcdsaSecp256k1DSIGN
forall a b. (a -> b) -> a -> b
$
      \SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
skp -> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO ())
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m ()) -> m (PinnedSizedBytes n)
psbCreateSized ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO ())
 -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO ())
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
vkp ->
        ForeignPtr SECP256k1Context
-> (Ptr SECP256k1Context -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SECP256k1Context
secpCtxPtr ((Ptr SECP256k1Context -> IO ()) -> IO ())
-> (Ptr SECP256k1Context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SECP256k1Context
ctx -> do
          CInt
res <- Ptr SECP256k1Context
-> SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
-> SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
-> IO CInt
secpEcPubkeyCreate Ptr SECP256k1Context
ctx SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
vkp SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
skp
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
            (CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
1)
            (String -> IO ()
forall a. HasCallStack => String -> a
error String
"deriveVerKeyDSIGN: Failed to derive VerKeyDSIGN EcdsaSecp256k1DSIGN")
  {-# NOINLINE signDSIGN #-}
  signDSIGN :: forall a.
(Signable EcdsaSecp256k1DSIGN a, HasCallStack) =>
ContextDSIGN EcdsaSecp256k1DSIGN
-> a
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
-> SigDSIGN EcdsaSecp256k1DSIGN
signDSIGN () (MH PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb) (SignKeyEcdsaSecp256k1 PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
skBytes) =
    PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> SigDSIGN EcdsaSecp256k1DSIGN
SigEcdsaSecp256k1 (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
 -> SigDSIGN EcdsaSecp256k1DSIGN)
-> ((SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
     -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
    -> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> SigDSIGN EcdsaSecp256k1DSIGN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
forall a. IO a -> a
unsafeDupablePerformIO (IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
 -> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> ((SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
     -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb ((SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
  -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
 -> SigDSIGN EcdsaSecp256k1DSIGN)
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> SigDSIGN EcdsaSecp256k1DSIGN
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
psp -> do
      PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
skBytes ((SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
  -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
 -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
skp ->
        (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO ())
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m ()) -> m (PinnedSizedBytes n)
psbCreateSized ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO ())
 -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO ())
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
sigp ->
          ForeignPtr SECP256k1Context
-> (Ptr SECP256k1Context -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SECP256k1Context
secpCtxPtr ((Ptr SECP256k1Context -> IO ()) -> IO ())
-> (Ptr SECP256k1Context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SECP256k1Context
ctx -> do
            -- The two nullPtr arguments correspond to nonces and extra nonce
            -- data. We use neither, so we pass nullPtrs to indicate this to the
            -- C API.
            CInt
res <- Ptr SECP256k1Context
-> SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
-> SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
-> SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
-> Ptr CUChar
-> Ptr CUChar
-> IO CInt
secpEcdsaSign Ptr SECP256k1Context
ctx SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
sigp SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
psp SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
skp Ptr CUChar
forall a. Ptr a
nullPtr Ptr CUChar
forall a. Ptr a
nullPtr
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
              (CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
1)
              (String -> IO ()
forall a. HasCallStack => String -> a
error String
"signDSIGN: Failed to sign EcdsaSecp256k1DSIGN message")
  {-# NOINLINE verifyDSIGN #-}
  verifyDSIGN :: forall a.
(Signable EcdsaSecp256k1DSIGN a, HasCallStack) =>
ContextDSIGN EcdsaSecp256k1DSIGN
-> VerKeyDSIGN EcdsaSecp256k1DSIGN
-> a
-> SigDSIGN EcdsaSecp256k1DSIGN
-> Either String ()
verifyDSIGN () (VerKeyEcdsaSecp256k1 PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
vkBytes) (MH PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb) (SigEcdsaSecp256k1 PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
sigBytes) =
    IO (Either String ()) -> Either String ()
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either String ()) -> Either String ())
-> ((SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
     -> IO (Either String ()))
    -> IO (Either String ()))
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (Either String ()))
-> Either String ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (Either String ()))
-> IO (Either String ())
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb ((SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES -> IO (Either String ()))
 -> Either String ())
-> (SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
    -> IO (Either String ()))
-> Either String ()
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
psp -> do
      PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (Either String ()))
-> IO (Either String ())
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
sigBytes ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
  -> IO (Either String ()))
 -> IO (Either String ()))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (Either String ()))
-> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
sigp ->
        PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (Either String ()))
-> IO (Either String ())
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
vkBytes ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
  -> IO (Either String ()))
 -> IO (Either String ()))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (Either String ()))
-> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
vkp ->
          ForeignPtr SECP256k1Context
-> (Ptr SECP256k1Context -> IO (Either String ()))
-> IO (Either String ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SECP256k1Context
secpCtxPtr ((Ptr SECP256k1Context -> IO (Either String ()))
 -> IO (Either String ()))
-> (Ptr SECP256k1Context -> IO (Either String ()))
-> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ \Ptr SECP256k1Context
ctx -> do
            let res :: CInt
res = Ptr SECP256k1Context
-> SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
-> SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
-> SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
-> CInt
secpEcdsaVerify Ptr SECP256k1Context
ctx SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
sigp SizedPtr SECP256K1_ECDSA_MESSAGE_BYTES
psp SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
vkp
            Either String () -> IO (Either String ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ case CInt
res of
              CInt
0 -> String -> Either String ()
forall a b. a -> Either a b
Left String
"verifyDSIGN: Incorrect or unparseable SigDSIGN EcdsaSecp256k1DSIGN"
              CInt
_ -> () -> Either String ()
forall a b. b -> Either a b
Right ()
  genKeyDSIGN :: Seed -> SignKeyDSIGN EcdsaSecp256k1DSIGN
genKeyDSIGN Seed
seed = Seed
-> (forall {m :: * -> *}.
    MonadRandom m =>
    m (SignKeyDSIGN EcdsaSecp256k1DSIGN))
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
runMonadRandomWithSeed Seed
seed ((forall {m :: * -> *}.
  MonadRandom m =>
  m (SignKeyDSIGN EcdsaSecp256k1DSIGN))
 -> SignKeyDSIGN EcdsaSecp256k1DSIGN)
-> (forall {m :: * -> *}.
    MonadRandom m =>
    m (SignKeyDSIGN EcdsaSecp256k1DSIGN))
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
    case ByteString
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (PinnedSizedBytes n)
psbFromByteStringCheck ByteString
bs of
      Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
Nothing -> String -> m (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall a. HasCallStack => String -> a
error String
"genKeyDSIGN: Failed to generate SignKeyDSIGN EcdsaSecp256k1DSIGN unexpectedly"
      Just PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb -> SignKeyDSIGN EcdsaSecp256k1DSIGN
-> m (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignKeyDSIGN EcdsaSecp256k1DSIGN
 -> m (SignKeyDSIGN EcdsaSecp256k1DSIGN))
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
-> m (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall a b. (a -> b) -> a -> b
$ PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
SignKeyEcdsaSecp256k1 PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb
  {-# NOINLINE rawSerialiseSigDSIGN #-}
  rawSerialiseSigDSIGN :: SigDSIGN EcdsaSecp256k1DSIGN -> ByteString
rawSerialiseSigDSIGN (SigEcdsaSecp256k1 PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
psb) =
    forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString @SECP256K1_ECDSA_SIGNATURE_BYTES (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES -> ByteString)
-> (IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
    -> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
forall a. IO a -> a
unsafeDupablePerformIO (IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
 -> ByteString)
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> ByteString
forall a b. (a -> b) -> a -> b
$ do
      PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
psb ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
  -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
 -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
psp ->
        (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO ())
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m ()) -> m (PinnedSizedBytes n)
psbCreateSized ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO ())
 -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO ())
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
dstp ->
          ForeignPtr SECP256k1Context
-> (Ptr SECP256k1Context -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SECP256k1Context
secpCtxPtr ((Ptr SECP256k1Context -> IO ()) -> IO ())
-> (Ptr SECP256k1Context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SECP256k1Context
ctx ->
            IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SECP256k1Context
-> SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
-> SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
-> IO CInt
secpEcdsaSignatureSerializeCompact Ptr SECP256k1Context
ctx SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
dstp SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
psp
  {-# NOINLINE rawSerialiseVerKeyDSIGN #-}
  rawSerialiseVerKeyDSIGN :: VerKeyDSIGN EcdsaSecp256k1DSIGN -> ByteString
rawSerialiseVerKeyDSIGN (VerKeyEcdsaSecp256k1 PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
psb) =
    PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES -> ByteString)
-> ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
     -> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES))
    -> PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES)
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES))
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES)
-> PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES
forall a. IO a -> a
unsafeDupablePerformIO (IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES)
 -> PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES)
-> ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
     -> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES))
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES))
-> PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES))
-> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES)
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
psb ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
  -> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES))
 -> ByteString)
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES))
-> ByteString
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
psp ->
      forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(Ptr Word8 -> CSize -> m ()) -> m (PinnedSizedBytes n)
psbCreateLen @SECP256K1_ECDSA_PUBKEY_BYTES ((Ptr Word8 -> CSize -> IO ())
 -> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES))
-> (Ptr Word8 -> CSize -> IO ())
-> IO (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr CSize
len -> do
        let dstp :: Ptr CUChar
dstp = Ptr Word8 -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr
        -- This is necessary because of how the C API handles checking writes:
        -- maximum permissible length is given as a pointer, which is
        -- overwritten to indicate the number of bytes we actually wrote; if
        -- we get a mismatch, then the serialization failed. While an odd
        -- choice, we have to go with it.
        (Ptr CSize -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO ()) -> IO ()) -> (Ptr CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CSize
lenPtr :: Ptr CSize) -> do
          Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
lenPtr CSize
len
          ForeignPtr SECP256k1Context
-> (Ptr SECP256k1Context -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SECP256k1Context
secpCtxPtr ((Ptr SECP256k1Context -> IO ()) -> IO ())
-> (Ptr SECP256k1Context -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SECP256k1Context
ctx -> do
            CInt
ret <- Ptr SECP256k1Context
-> Ptr CUChar
-> Ptr CSize
-> SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
-> CUInt
-> IO CInt
secpEcPubkeySerialize Ptr SECP256k1Context
ctx Ptr CUChar
dstp Ptr CSize
lenPtr SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
psp CUInt
secpEcCompressed
            CSize
writtenLen <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
lenPtr
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
              (CSize
writtenLen CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
== CSize
len)
              (String -> IO ()
forall a. HasCallStack => String -> a
error String
"rawSerializeVerKeyDSIGN: Did not write correct length for VerKeyDSIGN EcdsaSecp256k1DSIGN")
            -- This should never happen, since `secpEcPubkeySerialize` in the current
            -- version of `secp256k1` library always returns 1:
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
              (CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1)
              (String -> IO ()
forall a. HasCallStack => String -> a
error String
"rawSerializeVerKeyDSIGN: Failed for unknown reason")
  rawSerialiseSignKeyDSIGN :: SignKeyDSIGN EcdsaSecp256k1DSIGN -> ByteString
rawSerialiseSignKeyDSIGN (SignKeyEcdsaSecp256k1 PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb) = PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
psb
  {-# NOINLINE rawDeserialiseSigDSIGN #-}
  rawDeserialiseSigDSIGN :: ByteString -> Maybe (SigDSIGN EcdsaSecp256k1DSIGN)
rawDeserialiseSigDSIGN ByteString
bs =
    PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> SigDSIGN EcdsaSecp256k1DSIGN
SigEcdsaSecp256k1 (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
 -> SigDSIGN EcdsaSecp256k1DSIGN)
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> Maybe (SigDSIGN EcdsaSecp256k1DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (PinnedSizedBytes n)
psbFromByteStringCheck ByteString
bs Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
    -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
go)
    where
      go ::
        PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES ->
        Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES_INTERNAL)
      go :: PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
go PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
psb = IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
 -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
     -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
    -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
-> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
psb ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
  -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
 -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
    -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
psp -> do
        (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
sigPsb, CInt
res) <- (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO CInt)
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES, CInt)
forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m r) -> m (PinnedSizedBytes n, r)
psbCreateSizedResult ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO CInt)
 -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES, CInt))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO CInt)
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES, CInt)
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
sigp ->
          ForeignPtr SECP256k1Context
-> (Ptr SECP256k1Context -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SECP256k1Context
secpCtxPtr ((Ptr SECP256k1Context -> IO CInt) -> IO CInt)
-> (Ptr SECP256k1Context -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr SECP256k1Context
ctx ->
            Ptr SECP256k1Context
-> SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
-> SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
-> IO CInt
secpEcdsaSignatureParseCompact Ptr SECP256k1Context
ctx SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
sigp SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
psp
        Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
 -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
forall a b. (a -> b) -> a -> b
$ case CInt
res of
          CInt
1 -> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
sigPsb
          CInt
_ -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a. Maybe a
Nothing
  {-# NOINLINE rawDeserialiseVerKeyDSIGN #-}
  rawDeserialiseVerKeyDSIGN :: ByteString -> Maybe (VerKeyDSIGN EcdsaSecp256k1DSIGN)
rawDeserialiseVerKeyDSIGN ByteString
bs =
    PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> VerKeyDSIGN EcdsaSecp256k1DSIGN
VerKeyEcdsaSecp256k1 (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
 -> VerKeyDSIGN EcdsaSecp256k1DSIGN)
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> Maybe (VerKeyDSIGN EcdsaSecp256k1DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES)
forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (PinnedSizedBytes n)
psbFromByteStringCheck ByteString
bs Maybe (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES)
-> (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES
    -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
go)
    where
      go ::
        PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES ->
        Maybe (PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES_INTERNAL)
      go :: PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
go PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES
psb = IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
 -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> ((Ptr Word8
     -> CSize
     -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
    -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
-> (Ptr Word8
    -> CSize
    -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES
-> (Ptr Word8
    -> CSize
    -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
-> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
PinnedSizedBytes n -> (Ptr Word8 -> CSize -> m r) -> m r
psbUseAsCPtrLen PinnedSizedBytes SECP256K1_ECDSA_PUBKEY_BYTES
psb ((Ptr Word8
  -> CSize
  -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
 -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
-> (Ptr Word8
    -> CSize
    -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p CSize
srcLen -> do
        let srcp :: Ptr CUChar
srcp = Ptr Word8 -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p
        (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
vkPsb, CInt
res) <- (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO CInt)
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES, CInt)
forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m r) -> m (PinnedSizedBytes n, r)
psbCreateSizedResult ((SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO CInt)
 -> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES, CInt))
-> (SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES -> IO CInt)
-> IO (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES, CInt)
forall a b. (a -> b) -> a -> b
$ \SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
vkp ->
          ForeignPtr SECP256k1Context
-> (Ptr SECP256k1Context -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SECP256k1Context
secpCtxPtr ((Ptr SECP256k1Context -> IO CInt) -> IO CInt)
-> (Ptr SECP256k1Context -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr SECP256k1Context
ctx ->
            Ptr SECP256k1Context
-> SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
-> Ptr CUChar
-> CSize
-> IO CInt
secpEcPubkeyParse Ptr SECP256k1Context
ctx SizedPtr SECP256K1_ECDSA_SIGNATURE_BYTES
vkp Ptr CUChar
srcp CSize
srcLen
        Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
 -> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)))
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
-> IO (Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES))
forall a b. (a -> b) -> a -> b
$ case CInt
res of
          CInt
1 -> PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES
vkPsb
          CInt
_ -> Maybe (PinnedSizedBytes SECP256K1_ECDSA_SIGNATURE_BYTES)
forall a. Maybe a
Nothing
  rawDeserialiseSignKeyDSIGN :: ByteString -> Maybe (SignKeyDSIGN EcdsaSecp256k1DSIGN)
rawDeserialiseSignKeyDSIGN ByteString
bs =
    PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
-> SignKeyDSIGN EcdsaSecp256k1DSIGN
SignKeyEcdsaSecp256k1 (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES
 -> SignKeyDSIGN EcdsaSecp256k1DSIGN)
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
-> Maybe (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> Maybe (PinnedSizedBytes SECP256K1_ECDSA_MESSAGE_BYTES)
forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (PinnedSizedBytes n)
psbFromByteStringCheck ByteString
bs

instance ToCBOR (VerKeyDSIGN EcdsaSecp256k1DSIGN) where
  toCBOR :: VerKeyDSIGN EcdsaSecp256k1DSIGN -> Encoding
toCBOR = VerKeyDSIGN EcdsaSecp256k1DSIGN -> Encoding
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerKeyDSIGN EcdsaSecp256k1DSIGN) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = Proxy (VerKeyDSIGN EcdsaSecp256k1DSIGN) -> Size
forall v. DSIGNAlgorithm v => Proxy (VerKeyDSIGN v) -> Size
encodedVerKeyDSIGNSizeExpr

instance FromCBOR (VerKeyDSIGN EcdsaSecp256k1DSIGN) where
  fromCBOR :: forall s. Decoder s (VerKeyDSIGN EcdsaSecp256k1DSIGN)
fromCBOR = Decoder s (VerKeyDSIGN EcdsaSecp256k1DSIGN)
forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN

instance ToCBOR (SignKeyDSIGN EcdsaSecp256k1DSIGN) where
  toCBOR :: SignKeyDSIGN EcdsaSecp256k1DSIGN -> Encoding
toCBOR = SignKeyDSIGN EcdsaSecp256k1DSIGN -> Encoding
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> Encoding
encodeSignKeyDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SignKeyDSIGN EcdsaSecp256k1DSIGN) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = Proxy (SignKeyDSIGN EcdsaSecp256k1DSIGN) -> Size
forall v. DSIGNAlgorithm v => Proxy (SignKeyDSIGN v) -> Size
encodedSignKeyDSIGNSizeExpr

instance FromCBOR (SignKeyDSIGN EcdsaSecp256k1DSIGN) where
  fromCBOR :: forall s. Decoder s (SignKeyDSIGN EcdsaSecp256k1DSIGN)
fromCBOR = Decoder s (SignKeyDSIGN EcdsaSecp256k1DSIGN)
forall v s. DSIGNAlgorithm v => Decoder s (SignKeyDSIGN v)
decodeSignKeyDSIGN

instance ToCBOR (SigDSIGN EcdsaSecp256k1DSIGN) where
  toCBOR :: SigDSIGN EcdsaSecp256k1DSIGN -> Encoding
toCBOR = SigDSIGN EcdsaSecp256k1DSIGN -> Encoding
forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigDSIGN EcdsaSecp256k1DSIGN) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = Proxy (SigDSIGN EcdsaSecp256k1DSIGN) -> Size
forall v. DSIGNAlgorithm v => Proxy (SigDSIGN v) -> Size
encodedSigDSIGNSizeExpr

instance FromCBOR (SigDSIGN EcdsaSecp256k1DSIGN) where
  fromCBOR :: forall s. Decoder s (SigDSIGN EcdsaSecp256k1DSIGN)
fromCBOR = Decoder s (SigDSIGN EcdsaSecp256k1DSIGN)
forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN