{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia        #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeApplications   #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Ledger.Crypto
    ( module Export
    , PubKey(..)
    , PrivateKey(..)
    , Signature(..)
    , Passphrase(..)
    , pubKeyHash
    , signedBy
    , sign
    , signTx
    , generateFromSeed
    , toPublicKey
    , xPubToPublicKey
    -- * Signing and generation with no passphrase
    , sign'
    , signTx'
    , generateFromSeed'
    ) where

import Cardano.Crypto.Wallet qualified as Crypto
import Codec.Serialise.Class (Serialise)
import Control.Newtype.Generics (Newtype)
import Crypto.Hash qualified as Crypto
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey, (.:))
import Data.Aeson qualified as JSON
import Data.Aeson.Extras qualified as JSON
import Data.ByteArray qualified as BA
import Data.ByteString qualified as BS
import Data.Hashable (Hashable)
import Data.String
import GHC.Generics (Generic)
import Ledger.Tx.Orphans.V1 ()
import Plutus.V1.Ledger.Api (LedgerBytes (LedgerBytes), TxId (TxId), fromBuiltin, toBuiltin)
import Plutus.V1.Ledger.Bytes qualified as KB
import Plutus.V1.Ledger.Crypto as Export
import PlutusTx qualified as PlutusTx
import PlutusTx.Lift (makeLift)
import PlutusTx.Prelude qualified as PlutusTx
import Prettyprinter (Pretty)

-- | Passphrase newtype to mark intent
newtype Passphrase =
  Passphrase { Passphrase -> ByteString
unPassphrase :: BS.ByteString }
  deriving newtype (String -> Passphrase
(String -> Passphrase) -> IsString Passphrase
forall a. (String -> a) -> IsString a
fromString :: String -> Passphrase
$cfromString :: String -> Passphrase
IsString)

instance Show Passphrase where
  show :: Passphrase -> String
show Passphrase
_ = String
"<passphrase>"

-- | A message with a cryptographic signature.
newtype Signature = Signature { Signature -> BuiltinByteString
getSignature :: PlutusTx.BuiltinByteString }
    deriving stock (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c== :: Signature -> Signature -> Bool
Eq, Eq Signature
Eq Signature
-> (Signature -> Signature -> Ordering)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Signature)
-> (Signature -> Signature -> Signature)
-> Ord Signature
Signature -> Signature -> Bool
Signature -> Signature -> Ordering
Signature -> Signature -> Signature
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Signature -> Signature -> Signature
$cmin :: Signature -> Signature -> Signature
max :: Signature -> Signature -> Signature
$cmax :: Signature -> Signature -> Signature
>= :: Signature -> Signature -> Bool
$c>= :: Signature -> Signature -> Bool
> :: Signature -> Signature -> Bool
$c> :: Signature -> Signature -> Bool
<= :: Signature -> Signature -> Bool
$c<= :: Signature -> Signature -> Bool
< :: Signature -> Signature -> Bool
$c< :: Signature -> Signature -> Bool
compare :: Signature -> Signature -> Ordering
$ccompare :: Signature -> Signature -> Ordering
$cp1Ord :: Eq Signature
Ord, (forall x. Signature -> Rep Signature x)
-> (forall x. Rep Signature x -> Signature) -> Generic Signature
forall x. Rep Signature x -> Signature
forall x. Signature -> Rep Signature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Signature x -> Signature
$cfrom :: forall x. Signature -> Rep Signature x
Generic)
    deriving newtype (Signature -> Signature -> Bool
(Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> Eq a
== :: Signature -> Signature -> Bool
$c== :: Signature -> Signature -> Bool
PlutusTx.Eq, Eq Signature
Eq Signature
-> (Signature -> Signature -> Ordering)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Signature)
-> (Signature -> Signature -> Signature)
-> Ord Signature
Signature -> Signature -> Bool
Signature -> Signature -> Ordering
Signature -> Signature -> Signature
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Signature -> Signature -> Signature
$cmin :: Signature -> Signature -> Signature
max :: Signature -> Signature -> Signature
$cmax :: Signature -> Signature -> Signature
>= :: Signature -> Signature -> Bool
$c>= :: Signature -> Signature -> Bool
> :: Signature -> Signature -> Bool
$c> :: Signature -> Signature -> Bool
<= :: Signature -> Signature -> Bool
$c<= :: Signature -> Signature -> Bool
< :: Signature -> Signature -> Bool
$c< :: Signature -> Signature -> Bool
compare :: Signature -> Signature -> Ordering
$ccompare :: Signature -> Signature -> Ordering
$cp1Ord :: Eq Signature
PlutusTx.Ord, Decoder s Signature
Decoder s [Signature]
[Signature] -> Encoding
Signature -> Encoding
(Signature -> Encoding)
-> (forall s. Decoder s Signature)
-> ([Signature] -> Encoding)
-> (forall s. Decoder s [Signature])
-> Serialise Signature
forall s. Decoder s [Signature]
forall s. Decoder s Signature
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [Signature]
$cdecodeList :: forall s. Decoder s [Signature]
encodeList :: [Signature] -> Encoding
$cencodeList :: [Signature] -> Encoding
decode :: Decoder s Signature
$cdecode :: forall s. Decoder s Signature
encode :: Signature -> Encoding
$cencode :: Signature -> Encoding
Serialise, Signature -> BuiltinData
(Signature -> BuiltinData) -> ToData Signature
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: Signature -> BuiltinData
$ctoBuiltinData :: Signature -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe Signature
(BuiltinData -> Maybe Signature) -> FromData Signature
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe Signature
$cfromBuiltinData :: BuiltinData -> Maybe Signature
PlutusTx.FromData, BuiltinData -> Signature
(BuiltinData -> Signature) -> UnsafeFromData Signature
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> Signature
$cunsafeFromBuiltinData :: BuiltinData -> Signature
PlutusTx.UnsafeFromData)
    deriving (Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show, [Signature] -> Doc ann
Signature -> Doc ann
(forall ann. Signature -> Doc ann)
-> (forall ann. [Signature] -> Doc ann) -> Pretty Signature
forall ann. [Signature] -> Doc ann
forall ann. Signature -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [Signature] -> Doc ann
$cprettyList :: forall ann. [Signature] -> Doc ann
pretty :: Signature -> Doc ann
$cpretty :: forall ann. Signature -> Doc ann
Pretty) via LedgerBytes
makeLift ''Signature

instance ToJSON Signature where
  toJSON :: Signature -> Value
toJSON Signature
signature =
    [Pair] -> Value
JSON.object
      [ ( Key
"getSignature"
        , Text -> Value
JSON.String (Text -> Value) -> (Signature -> Text) -> Signature -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ByteString -> Text
JSON.encodeByteString (ByteString -> Text)
-> (Signature -> ByteString) -> Signature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin (BuiltinByteString -> ByteString)
-> (Signature -> BuiltinByteString) -> Signature -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          Signature -> BuiltinByteString
getSignature (Signature -> Value) -> Signature -> Value
forall a b. (a -> b) -> a -> b
$
          Signature
signature)
      ]

instance FromJSON Signature where
  parseJSON :: Value -> Parser Signature
parseJSON =
    String -> (Object -> Parser Signature) -> Value -> Parser Signature
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Signature" ((Object -> Parser Signature) -> Value -> Parser Signature)
-> (Object -> Parser Signature) -> Value -> Parser Signature
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
      Value
raw <- Object
object Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"getSignature"
      ByteString
bytes <- Value -> Parser ByteString
JSON.decodeByteString Value
raw
      Signature -> Parser Signature
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> Parser Signature)
-> (BuiltinByteString -> Signature)
-> BuiltinByteString
-> Parser Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> Signature
Signature (BuiltinByteString -> Parser Signature)
-> BuiltinByteString -> Parser Signature
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bytes

newtype PubKey = PubKey { PubKey -> LedgerBytes
getPubKey :: LedgerBytes }
    deriving stock (PubKey -> PubKey -> Bool
(PubKey -> PubKey -> Bool)
-> (PubKey -> PubKey -> Bool) -> Eq PubKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubKey -> PubKey -> Bool
$c/= :: PubKey -> PubKey -> Bool
== :: PubKey -> PubKey -> Bool
$c== :: PubKey -> PubKey -> Bool
Eq, Eq PubKey
Eq PubKey
-> (PubKey -> PubKey -> Ordering)
-> (PubKey -> PubKey -> Bool)
-> (PubKey -> PubKey -> Bool)
-> (PubKey -> PubKey -> Bool)
-> (PubKey -> PubKey -> Bool)
-> (PubKey -> PubKey -> PubKey)
-> (PubKey -> PubKey -> PubKey)
-> Ord PubKey
PubKey -> PubKey -> Bool
PubKey -> PubKey -> Ordering
PubKey -> PubKey -> PubKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PubKey -> PubKey -> PubKey
$cmin :: PubKey -> PubKey -> PubKey
max :: PubKey -> PubKey -> PubKey
$cmax :: PubKey -> PubKey -> PubKey
>= :: PubKey -> PubKey -> Bool
$c>= :: PubKey -> PubKey -> Bool
> :: PubKey -> PubKey -> Bool
$c> :: PubKey -> PubKey -> Bool
<= :: PubKey -> PubKey -> Bool
$c<= :: PubKey -> PubKey -> Bool
< :: PubKey -> PubKey -> Bool
$c< :: PubKey -> PubKey -> Bool
compare :: PubKey -> PubKey -> Ordering
$ccompare :: PubKey -> PubKey -> Ordering
$cp1Ord :: Eq PubKey
Ord, (forall x. PubKey -> Rep PubKey x)
-> (forall x. Rep PubKey x -> PubKey) -> Generic PubKey
forall x. Rep PubKey x -> PubKey
forall x. PubKey -> Rep PubKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PubKey x -> PubKey
$cfrom :: forall x. PubKey -> Rep PubKey x
Generic)
    deriving anyclass (O PubKey -> PubKey
PubKey -> O PubKey
(O PubKey -> PubKey) -> (PubKey -> O PubKey) -> Newtype PubKey
forall n. (O n -> n) -> (n -> O n) -> Newtype n
unpack :: PubKey -> O PubKey
$cunpack :: PubKey -> O PubKey
pack :: O PubKey -> PubKey
$cpack :: O PubKey -> PubKey
Newtype, [PubKey] -> Encoding
[PubKey] -> Value
PubKey -> Encoding
PubKey -> Value
(PubKey -> Value)
-> (PubKey -> Encoding)
-> ([PubKey] -> Value)
-> ([PubKey] -> Encoding)
-> ToJSON PubKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PubKey] -> Encoding
$ctoEncodingList :: [PubKey] -> Encoding
toJSONList :: [PubKey] -> Value
$ctoJSONList :: [PubKey] -> Value
toEncoding :: PubKey -> Encoding
$ctoEncoding :: PubKey -> Encoding
toJSON :: PubKey -> Value
$ctoJSON :: PubKey -> Value
ToJSON, Value -> Parser [PubKey]
Value -> Parser PubKey
(Value -> Parser PubKey)
-> (Value -> Parser [PubKey]) -> FromJSON PubKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PubKey]
$cparseJSONList :: Value -> Parser [PubKey]
parseJSON :: Value -> Parser PubKey
$cparseJSON :: Value -> Parser PubKey
FromJSON)
    deriving newtype (PubKey -> PubKey -> Bool
(PubKey -> PubKey -> Bool) -> Eq PubKey
forall a. (a -> a -> Bool) -> Eq a
== :: PubKey -> PubKey -> Bool
$c== :: PubKey -> PubKey -> Bool
PlutusTx.Eq, Eq PubKey
Eq PubKey
-> (PubKey -> PubKey -> Ordering)
-> (PubKey -> PubKey -> Bool)
-> (PubKey -> PubKey -> Bool)
-> (PubKey -> PubKey -> Bool)
-> (PubKey -> PubKey -> Bool)
-> (PubKey -> PubKey -> PubKey)
-> (PubKey -> PubKey -> PubKey)
-> Ord PubKey
PubKey -> PubKey -> Bool
PubKey -> PubKey -> Ordering
PubKey -> PubKey -> PubKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PubKey -> PubKey -> PubKey
$cmin :: PubKey -> PubKey -> PubKey
max :: PubKey -> PubKey -> PubKey
$cmax :: PubKey -> PubKey -> PubKey
>= :: PubKey -> PubKey -> Bool
$c>= :: PubKey -> PubKey -> Bool
> :: PubKey -> PubKey -> Bool
$c> :: PubKey -> PubKey -> Bool
<= :: PubKey -> PubKey -> Bool
$c<= :: PubKey -> PubKey -> Bool
< :: PubKey -> PubKey -> Bool
$c< :: PubKey -> PubKey -> Bool
compare :: PubKey -> PubKey -> Ordering
$ccompare :: PubKey -> PubKey -> Ordering
$cp1Ord :: Eq PubKey
PlutusTx.Ord, Decoder s PubKey
Decoder s [PubKey]
[PubKey] -> Encoding
PubKey -> Encoding
(PubKey -> Encoding)
-> (forall s. Decoder s PubKey)
-> ([PubKey] -> Encoding)
-> (forall s. Decoder s [PubKey])
-> Serialise PubKey
forall s. Decoder s [PubKey]
forall s. Decoder s PubKey
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [PubKey]
$cdecodeList :: forall s. Decoder s [PubKey]
encodeList :: [PubKey] -> Encoding
$cencodeList :: [PubKey] -> Encoding
decode :: Decoder s PubKey
$cdecode :: forall s. Decoder s PubKey
encode :: PubKey -> Encoding
$cencode :: PubKey -> Encoding
Serialise, PubKey -> BuiltinData
(PubKey -> BuiltinData) -> ToData PubKey
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: PubKey -> BuiltinData
$ctoBuiltinData :: PubKey -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe PubKey
(BuiltinData -> Maybe PubKey) -> FromData PubKey
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe PubKey
$cfromBuiltinData :: BuiltinData -> Maybe PubKey
PlutusTx.FromData, BuiltinData -> PubKey
(BuiltinData -> PubKey) -> UnsafeFromData PubKey
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> PubKey
$cunsafeFromBuiltinData :: BuiltinData -> PubKey
PlutusTx.UnsafeFromData)
    deriving String -> PubKey
(String -> PubKey) -> IsString PubKey
forall a. (String -> a) -> IsString a
fromString :: String -> PubKey
$cfromString :: String -> PubKey
IsString via LedgerBytes
    deriving (Int -> PubKey -> ShowS
[PubKey] -> ShowS
PubKey -> String
(Int -> PubKey -> ShowS)
-> (PubKey -> String) -> ([PubKey] -> ShowS) -> Show PubKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PubKey] -> ShowS
$cshowList :: [PubKey] -> ShowS
show :: PubKey -> String
$cshow :: PubKey -> String
showsPrec :: Int -> PubKey -> ShowS
$cshowsPrec :: Int -> PubKey -> ShowS
Show, [PubKey] -> Doc ann
PubKey -> Doc ann
(forall ann. PubKey -> Doc ann)
-> (forall ann. [PubKey] -> Doc ann) -> Pretty PubKey
forall ann. [PubKey] -> Doc ann
forall ann. PubKey -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [PubKey] -> Doc ann
$cprettyList :: forall ann. [PubKey] -> Doc ann
pretty :: PubKey -> Doc ann
$cpretty :: forall ann. PubKey -> Doc ann
Pretty) via LedgerBytes
makeLift ''PubKey

instance ToJSONKey PubKey where
  toJSONKey :: ToJSONKeyFunction PubKey
toJSONKey = (PubKey -> Value)
-> (PubKey -> Encoding) -> ToJSONKeyFunction PubKey
forall a. (a -> Value) -> (a -> Encoding) -> ToJSONKeyFunction a
JSON.ToJSONKeyValue (Options -> PubKey -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
JSON.genericToJSON Options
JSON.defaultOptions) PubKey -> Encoding
forall a. ToJSON a => a -> Encoding
JSON.toEncoding

instance FromJSONKey PubKey where
  fromJSONKey :: FromJSONKeyFunction PubKey
fromJSONKey = (Value -> Parser PubKey) -> FromJSONKeyFunction PubKey
forall a. (Value -> Parser a) -> FromJSONKeyFunction a
JSON.FromJSONKeyValue (Options -> Value -> Parser PubKey
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
JSON.genericParseJSON Options
JSON.defaultOptions)

-- | A cryptographic private key.
newtype PrivateKey = PrivateKey { PrivateKey -> LedgerBytes
getPrivateKey :: LedgerBytes }
    deriving stock (PrivateKey -> PrivateKey -> Bool
(PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool) -> Eq PrivateKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivateKey -> PrivateKey -> Bool
$c/= :: PrivateKey -> PrivateKey -> Bool
== :: PrivateKey -> PrivateKey -> Bool
$c== :: PrivateKey -> PrivateKey -> Bool
Eq, Eq PrivateKey
Eq PrivateKey
-> (PrivateKey -> PrivateKey -> Ordering)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> PrivateKey)
-> (PrivateKey -> PrivateKey -> PrivateKey)
-> Ord PrivateKey
PrivateKey -> PrivateKey -> Bool
PrivateKey -> PrivateKey -> Ordering
PrivateKey -> PrivateKey -> PrivateKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrivateKey -> PrivateKey -> PrivateKey
$cmin :: PrivateKey -> PrivateKey -> PrivateKey
max :: PrivateKey -> PrivateKey -> PrivateKey
$cmax :: PrivateKey -> PrivateKey -> PrivateKey
>= :: PrivateKey -> PrivateKey -> Bool
$c>= :: PrivateKey -> PrivateKey -> Bool
> :: PrivateKey -> PrivateKey -> Bool
$c> :: PrivateKey -> PrivateKey -> Bool
<= :: PrivateKey -> PrivateKey -> Bool
$c<= :: PrivateKey -> PrivateKey -> Bool
< :: PrivateKey -> PrivateKey -> Bool
$c< :: PrivateKey -> PrivateKey -> Bool
compare :: PrivateKey -> PrivateKey -> Ordering
$ccompare :: PrivateKey -> PrivateKey -> Ordering
$cp1Ord :: Eq PrivateKey
Ord, (forall x. PrivateKey -> Rep PrivateKey x)
-> (forall x. Rep PrivateKey x -> PrivateKey) -> Generic PrivateKey
forall x. Rep PrivateKey x -> PrivateKey
forall x. PrivateKey -> Rep PrivateKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrivateKey x -> PrivateKey
$cfrom :: forall x. PrivateKey -> Rep PrivateKey x
Generic)
    deriving anyclass ([PrivateKey] -> Encoding
[PrivateKey] -> Value
PrivateKey -> Encoding
PrivateKey -> Value
(PrivateKey -> Value)
-> (PrivateKey -> Encoding)
-> ([PrivateKey] -> Value)
-> ([PrivateKey] -> Encoding)
-> ToJSON PrivateKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PrivateKey] -> Encoding
$ctoEncodingList :: [PrivateKey] -> Encoding
toJSONList :: [PrivateKey] -> Value
$ctoJSONList :: [PrivateKey] -> Value
toEncoding :: PrivateKey -> Encoding
$ctoEncoding :: PrivateKey -> Encoding
toJSON :: PrivateKey -> Value
$ctoJSON :: PrivateKey -> Value
ToJSON, Value -> Parser [PrivateKey]
Value -> Parser PrivateKey
(Value -> Parser PrivateKey)
-> (Value -> Parser [PrivateKey]) -> FromJSON PrivateKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PrivateKey]
$cparseJSONList :: Value -> Parser [PrivateKey]
parseJSON :: Value -> Parser PrivateKey
$cparseJSON :: Value -> Parser PrivateKey
FromJSON, O PrivateKey -> PrivateKey
PrivateKey -> O PrivateKey
(O PrivateKey -> PrivateKey)
-> (PrivateKey -> O PrivateKey) -> Newtype PrivateKey
forall n. (O n -> n) -> (n -> O n) -> Newtype n
unpack :: PrivateKey -> O PrivateKey
$cunpack :: PrivateKey -> O PrivateKey
pack :: O PrivateKey -> PrivateKey
$cpack :: O PrivateKey -> PrivateKey
Newtype, ToJSONKeyFunction [PrivateKey]
ToJSONKeyFunction PrivateKey
ToJSONKeyFunction PrivateKey
-> ToJSONKeyFunction [PrivateKey] -> ToJSONKey PrivateKey
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [PrivateKey]
$ctoJSONKeyList :: ToJSONKeyFunction [PrivateKey]
toJSONKey :: ToJSONKeyFunction PrivateKey
$ctoJSONKey :: ToJSONKeyFunction PrivateKey
ToJSONKey, FromJSONKeyFunction [PrivateKey]
FromJSONKeyFunction PrivateKey
FromJSONKeyFunction PrivateKey
-> FromJSONKeyFunction [PrivateKey] -> FromJSONKey PrivateKey
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [PrivateKey]
$cfromJSONKeyList :: FromJSONKeyFunction [PrivateKey]
fromJSONKey :: FromJSONKeyFunction PrivateKey
$cfromJSONKey :: FromJSONKeyFunction PrivateKey
FromJSONKey)
    deriving newtype (PrivateKey -> PrivateKey -> Bool
(PrivateKey -> PrivateKey -> Bool) -> Eq PrivateKey
forall a. (a -> a -> Bool) -> Eq a
== :: PrivateKey -> PrivateKey -> Bool
$c== :: PrivateKey -> PrivateKey -> Bool
PlutusTx.Eq, Eq PrivateKey
Eq PrivateKey
-> (PrivateKey -> PrivateKey -> Ordering)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> PrivateKey)
-> (PrivateKey -> PrivateKey -> PrivateKey)
-> Ord PrivateKey
PrivateKey -> PrivateKey -> Bool
PrivateKey -> PrivateKey -> Ordering
PrivateKey -> PrivateKey -> PrivateKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrivateKey -> PrivateKey -> PrivateKey
$cmin :: PrivateKey -> PrivateKey -> PrivateKey
max :: PrivateKey -> PrivateKey -> PrivateKey
$cmax :: PrivateKey -> PrivateKey -> PrivateKey
>= :: PrivateKey -> PrivateKey -> Bool
$c>= :: PrivateKey -> PrivateKey -> Bool
> :: PrivateKey -> PrivateKey -> Bool
$c> :: PrivateKey -> PrivateKey -> Bool
<= :: PrivateKey -> PrivateKey -> Bool
$c<= :: PrivateKey -> PrivateKey -> Bool
< :: PrivateKey -> PrivateKey -> Bool
$c< :: PrivateKey -> PrivateKey -> Bool
compare :: PrivateKey -> PrivateKey -> Ordering
$ccompare :: PrivateKey -> PrivateKey -> Ordering
$cp1Ord :: Eq PrivateKey
PlutusTx.Ord, Decoder s PrivateKey
Decoder s [PrivateKey]
[PrivateKey] -> Encoding
PrivateKey -> Encoding
(PrivateKey -> Encoding)
-> (forall s. Decoder s PrivateKey)
-> ([PrivateKey] -> Encoding)
-> (forall s. Decoder s [PrivateKey])
-> Serialise PrivateKey
forall s. Decoder s [PrivateKey]
forall s. Decoder s PrivateKey
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [PrivateKey]
$cdecodeList :: forall s. Decoder s [PrivateKey]
encodeList :: [PrivateKey] -> Encoding
$cencodeList :: [PrivateKey] -> Encoding
decode :: Decoder s PrivateKey
$cdecode :: forall s. Decoder s PrivateKey
encode :: PrivateKey -> Encoding
$cencode :: PrivateKey -> Encoding
Serialise, PrivateKey -> BuiltinData
(PrivateKey -> BuiltinData) -> ToData PrivateKey
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: PrivateKey -> BuiltinData
$ctoBuiltinData :: PrivateKey -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe PrivateKey
(BuiltinData -> Maybe PrivateKey) -> FromData PrivateKey
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe PrivateKey
$cfromBuiltinData :: BuiltinData -> Maybe PrivateKey
PlutusTx.FromData, BuiltinData -> PrivateKey
(BuiltinData -> PrivateKey) -> UnsafeFromData PrivateKey
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> PrivateKey
$cunsafeFromBuiltinData :: BuiltinData -> PrivateKey
PlutusTx.UnsafeFromData)
    deriving (Int -> PrivateKey -> ShowS
[PrivateKey] -> ShowS
PrivateKey -> String
(Int -> PrivateKey -> ShowS)
-> (PrivateKey -> String)
-> ([PrivateKey] -> ShowS)
-> Show PrivateKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivateKey] -> ShowS
$cshowList :: [PrivateKey] -> ShowS
show :: PrivateKey -> String
$cshow :: PrivateKey -> String
showsPrec :: Int -> PrivateKey -> ShowS
$cshowsPrec :: Int -> PrivateKey -> ShowS
Show, [PrivateKey] -> Doc ann
PrivateKey -> Doc ann
(forall ann. PrivateKey -> Doc ann)
-> (forall ann. [PrivateKey] -> Doc ann) -> Pretty PrivateKey
forall ann. [PrivateKey] -> Doc ann
forall ann. PrivateKey -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [PrivateKey] -> Doc ann
$cprettyList :: forall ann. [PrivateKey] -> Doc ann
pretty :: PrivateKey -> Doc ann
$cpretty :: forall ann. PrivateKey -> Doc ann
Pretty) via LedgerBytes
    deriving Int -> PrivateKey -> Int
PrivateKey -> Int
(Int -> PrivateKey -> Int)
-> (PrivateKey -> Int) -> Hashable PrivateKey
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PrivateKey -> Int
$chash :: PrivateKey -> Int
hashWithSalt :: Int -> PrivateKey -> Int
$chashWithSalt :: Int -> PrivateKey -> Int
Hashable via PlutusTx.BuiltinByteString
makeLift ''PrivateKey

-- | Compute the hash of a public key.
pubKeyHash :: PubKey -> PubKeyHash
pubKeyHash :: PubKey -> PubKeyHash
pubKeyHash (PubKey (LedgerBytes BuiltinByteString
bs)) =
    BuiltinByteString -> PubKeyHash
PubKeyHash
      (BuiltinByteString -> PubKeyHash)
-> BuiltinByteString -> PubKeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin
      (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ (ByteArrayAccess (Digest Blake2b_224), ByteArray ByteString) =>
Digest Blake2b_224 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert @_ @BS.ByteString
      (Digest Blake2b_224 -> ByteString)
-> Digest Blake2b_224 -> ByteString
forall a b. (a -> b) -> a -> b
$ Blake2b_224 -> ByteString -> Digest Blake2b_224
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Crypto.hashWith Blake2b_224
Crypto.Blake2b_224 (BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
fromBuiltin BuiltinByteString
bs)

-- | Check whether the given 'Signature' was signed by the private key corresponding to the given public key.
signedBy :: BA.ByteArrayAccess a => Signature -> PubKey -> a -> Bool
signedBy :: Signature -> PubKey -> a -> Bool
signedBy (Signature BuiltinByteString
s) (PubKey LedgerBytes
k) a
payload =
    let xpub :: XPub
xpub = ByteString -> ChainCode -> XPub
Crypto.XPub (LedgerBytes -> ByteString
KB.bytes LedgerBytes
k) (ByteString -> ChainCode
Crypto.ChainCode ByteString
"" {- value is ignored -})
        xsig :: XSignature
xsig = (String -> XSignature)
-> (XSignature -> XSignature)
-> Either String XSignature
-> XSignature
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> XSignature
forall a. HasCallStack => String -> a
error XSignature -> XSignature
forall a. a -> a
id (Either String XSignature -> XSignature)
-> Either String XSignature -> XSignature
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String XSignature
Crypto.xsignature (BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
s)
    in XPub -> a -> XSignature -> Bool
forall msg.
ByteArrayAccess msg =>
XPub -> msg -> XSignature -> Bool
Crypto.verify XPub
xpub a
payload XSignature
xsig

-- | Sign the hash of a transaction using a private key and passphrase.
signTx :: TxId -> Crypto.XPrv -> Passphrase -> Signature
signTx :: TxId -> XPrv -> Passphrase -> Signature
signTx (TxId BuiltinByteString
txId) = BuiltinByteString -> XPrv -> Passphrase -> Signature
forall a. ByteArrayAccess a => a -> XPrv -> Passphrase -> Signature
sign BuiltinByteString
txId

-- | Sign the hash of a transaction using a private key that has no passphrase.
signTx' :: TxId -> Crypto.XPrv -> Signature
signTx' :: TxId -> XPrv -> Signature
signTx' TxId
txId XPrv
xprv = TxId -> XPrv -> Passphrase -> Signature
signTx TxId
txId XPrv
xprv Passphrase
noPassphrase

-- | Sign a message using a private key and passphrase.
sign :: BA.ByteArrayAccess a => a -> Crypto.XPrv -> Passphrase -> Signature
sign :: a -> XPrv -> Passphrase -> Signature
sign a
msg XPrv
privKey (Passphrase ByteString
passPhrase) = BuiltinByteString -> Signature
Signature (BuiltinByteString -> Signature)
-> (XSignature -> BuiltinByteString) -> XSignature -> Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> BuiltinByteString)
-> (XSignature -> ByteString) -> XSignature -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XSignature -> ByteString
Crypto.unXSignature (XSignature -> Signature) -> XSignature -> Signature
forall a b. (a -> b) -> a -> b
$ ByteString -> XPrv -> a -> XSignature
forall passPhrase msg.
(ByteArrayAccess passPhrase, ByteArrayAccess msg) =>
passPhrase -> XPrv -> msg -> XSignature
Crypto.sign ByteString
passPhrase XPrv
privKey a
msg

-- | Sign a message using a private key with no passphrase.
sign' :: BA.ByteArrayAccess a => a -> Crypto.XPrv -> Signature
sign' :: a -> XPrv -> Signature
sign' a
msg XPrv
privKey = a -> XPrv -> Passphrase -> Signature
forall a. ByteArrayAccess a => a -> XPrv -> Passphrase -> Signature
sign a
msg XPrv
privKey Passphrase
noPassphrase

-- | Generate a private key from a seed phrase and passphrase
generateFromSeed :: BS.ByteString -> Passphrase -> Crypto.XPrv
generateFromSeed :: ByteString -> Passphrase -> XPrv
generateFromSeed ByteString
seed (Passphrase ByteString
passPhrase) = ByteString -> ByteString -> XPrv
forall passPhrase seed.
(ByteArrayAccess passPhrase, ByteArrayAccess seed) =>
seed -> passPhrase -> XPrv
Crypto.generate ByteString
seed ByteString
passPhrase

-- | Generate a private key from a seed phrase without a passphrase.
generateFromSeed' :: BS.ByteString -> Crypto.XPrv
generateFromSeed' :: ByteString -> XPrv
generateFromSeed' ByteString
seed = ByteString -> Passphrase -> XPrv
generateFromSeed ByteString
seed Passphrase
noPassphrase

noPassphrase :: Passphrase
noPassphrase :: Passphrase
noPassphrase = ByteString -> Passphrase
Passphrase ByteString
""

xPubToPublicKey :: Crypto.XPub -> PubKey
xPubToPublicKey :: XPub -> PubKey
xPubToPublicKey = LedgerBytes -> PubKey
PubKey (LedgerBytes -> PubKey) -> (XPub -> LedgerBytes) -> XPub -> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LedgerBytes
KB.fromBytes (ByteString -> LedgerBytes)
-> (XPub -> ByteString) -> XPub -> LedgerBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
Crypto.xpubPublicKey

toPublicKey :: Crypto.XPrv -> PubKey
toPublicKey :: XPrv -> PubKey
toPublicKey = XPub -> PubKey
xPubToPublicKey (XPub -> PubKey) -> (XPrv -> XPub) -> XPrv -> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => XPrv -> XPub
XPrv -> XPub
Crypto.toXPub