{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeApplications   #-}

{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

{- Note [Oracle incorrect implementation]

This current Oracle implementation uses the
'Constraints.mustIncludeDatumInTxWithHash' constraint which used to add a datum
in transaction body. However, cardano-ledger enforces a rule (rewording the
rule here..) in which a datum in the transaction body needs to have the same
hash as a datum in one of the transaction's outputs.

However, now that we have fixed the bug in
'Constraints.mustIncludeDatumInTxWithHash' so work with this ledger rule, the
Oracle implementation does not work anymore, and examples in the
plutus-use-cases Haskell package now fail because of this.

Therefore, for now, we will comment out the failing test cases until we rewrite
this Oracle module to work with inline datums instead of datums in the
transaction body. This implies upgrades some of the examples in
`plutus-use-cases` to PlutusV2.
-}
module Plutus.Contract.Oracle(
  -- * Signed messages
  -- $oracles
  --
  Observation(..)
  , SignedMessage(..)
  -- * Checking signed messages
  , SignedMessageCheckError(..)
  , checkSignature
  , checkHashConstraints
  , checkHashOffChain
  , verifySignedMessageOffChain
  , verifySignedMessageOnChain
  , verifySignedMessageConstraints
  -- * Signing messages
  , signMessage
  , signObservation
  -- * Signing messages with no passphrase
  , signMessage'
  , signObservation'
  ) where

import Cardano.Crypto.Wallet qualified as Crypto (XPrv)
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)

import PlutusTx (FromData (fromBuiltinData), ToData (toBuiltinData), makeIsDataIndexed, makeLift)
import PlutusTx.Prelude (Applicative (pure), Either (Left, Right), Eq ((==)), maybe, trace, unless,
                         verifyEd25519Signature, ($), (&&), (>>))

import Ledger.Address (PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey (PaymentPubKey))
import Ledger.Crypto (Passphrase, PubKey (..), Signature (..))
import Ledger.Crypto qualified as Crypto
import Ledger.Scripts (Datum (Datum), DatumHash (DatumHash))
import Ledger.Tx.Constraints (TxConstraints)
import Ledger.Tx.Constraints qualified as Constraints
import Ledger.Tx.Constraints.OnChain.V2 qualified as Constraints
import Plutus.Script.Utils.Scripts qualified as Scripts
import Plutus.V1.Ledger.Bytes (LedgerBytes (LedgerBytes))
import Plutus.V1.Ledger.Time (POSIXTime)
import Plutus.V2.Ledger.Contexts (ScriptContext)

import Prelude qualified as Haskell

-- $oracles
-- This module provides a way to verify signed messages, and a type for
--  observations (for example, the price of a commodity on a given date).
--  Together, the two can be used to implement trusted oracles:
--
--  * The oracle observes a value, for example 'Price' and constructs a value
--    @o = @ 'Observation' @Price@.
--  * The oracle then calls 'signMessage' @o pk@ with its own private key to
--    produce a 'SignedMessage' @(@'Observation' @Price)@.
--  * The signed message is passed to the contract as the redeemer of some
--    unspent output. __Important:__ The redeeming transaction must include the
--    message 'o' as a datum. This is because we can't hash anything in
--    on-chain code, and therefore have to rely on the node to do it for us
--    via the pending transaction's map of datum hashes to datums.
--    (The constraints resolution mechanism takes care of including the message)
--  * The contract then calls 'checkSignature' to check the signature, and
--    produces a constraint ensuring that the signed hash is really the hash
--    of the datum.

-- | A value that was observed at a specific point in time
data Observation a = Observation
    { Observation a -> a
obsValue :: a
    -- ^ The value
    , Observation a -> POSIXTime
obsTime  :: POSIXTime
    -- ^ The time at which the value was observed
    } deriving ((forall x. Observation a -> Rep (Observation a) x)
-> (forall x. Rep (Observation a) x -> Observation a)
-> Generic (Observation a)
forall x. Rep (Observation a) x -> Observation a
forall x. Observation a -> Rep (Observation a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Observation a) x -> Observation a
forall a x. Observation a -> Rep (Observation a) x
$cto :: forall a x. Rep (Observation a) x -> Observation a
$cfrom :: forall a x. Observation a -> Rep (Observation a) x
Generic, Int -> Observation a -> ShowS
[Observation a] -> ShowS
Observation a -> String
(Int -> Observation a -> ShowS)
-> (Observation a -> String)
-> ([Observation a] -> ShowS)
-> Show (Observation a)
forall a. Show a => Int -> Observation a -> ShowS
forall a. Show a => [Observation a] -> ShowS
forall a. Show a => Observation a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Observation a] -> ShowS
$cshowList :: forall a. Show a => [Observation a] -> ShowS
show :: Observation a -> String
$cshow :: forall a. Show a => Observation a -> String
showsPrec :: Int -> Observation a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Observation a -> ShowS
Haskell.Show, Observation a -> Observation a -> Bool
(Observation a -> Observation a -> Bool)
-> (Observation a -> Observation a -> Bool) -> Eq (Observation a)
forall a. Eq a => Observation a -> Observation a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Observation a -> Observation a -> Bool
$c/= :: forall a. Eq a => Observation a -> Observation a -> Bool
== :: Observation a -> Observation a -> Bool
$c== :: forall a. Eq a => Observation a -> Observation a -> Bool
Haskell.Eq)

instance Eq a => Eq (Observation a) where
    Observation a
l == :: Observation a -> Observation a -> Bool
== Observation a
r =
        Observation a -> a
forall a. Observation a -> a
obsValue Observation a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Observation a -> a
forall a. Observation a -> a
obsValue Observation a
r
        Bool -> Bool -> Bool
&& Observation a -> POSIXTime
forall a. Observation a -> POSIXTime
obsTime Observation a
l POSIXTime -> POSIXTime -> Bool
forall a. Eq a => a -> a -> Bool
== Observation a -> POSIXTime
forall a. Observation a -> POSIXTime
obsTime Observation a
r

-- | @SignedMessage a@ contains the signature of a hash of a 'Datum'.
--   The 'Datum' can be decoded to a value of type @a@.
data SignedMessage a = SignedMessage
    { SignedMessage a -> Signature
osmSignature   :: Signature
    -- ^ Signature of the message
    , SignedMessage a -> DatumHash
osmMessageHash :: DatumHash
    -- ^ Hash of the message
    , SignedMessage a -> Datum
osmDatum       :: Datum
    }
    deriving stock ((forall x. SignedMessage a -> Rep (SignedMessage a) x)
-> (forall x. Rep (SignedMessage a) x -> SignedMessage a)
-> Generic (SignedMessage a)
forall x. Rep (SignedMessage a) x -> SignedMessage a
forall x. SignedMessage a -> Rep (SignedMessage a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SignedMessage a) x -> SignedMessage a
forall a x. SignedMessage a -> Rep (SignedMessage a) x
$cto :: forall a x. Rep (SignedMessage a) x -> SignedMessage a
$cfrom :: forall a x. SignedMessage a -> Rep (SignedMessage a) x
Generic, Int -> SignedMessage a -> ShowS
[SignedMessage a] -> ShowS
SignedMessage a -> String
(Int -> SignedMessage a -> ShowS)
-> (SignedMessage a -> String)
-> ([SignedMessage a] -> ShowS)
-> Show (SignedMessage a)
forall a. Int -> SignedMessage a -> ShowS
forall a. [SignedMessage a] -> ShowS
forall a. SignedMessage a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignedMessage a] -> ShowS
$cshowList :: forall a. [SignedMessage a] -> ShowS
show :: SignedMessage a -> String
$cshow :: forall a. SignedMessage a -> String
showsPrec :: Int -> SignedMessage a -> ShowS
$cshowsPrec :: forall a. Int -> SignedMessage a -> ShowS
Haskell.Show, SignedMessage a -> SignedMessage a -> Bool
(SignedMessage a -> SignedMessage a -> Bool)
-> (SignedMessage a -> SignedMessage a -> Bool)
-> Eq (SignedMessage a)
forall a. SignedMessage a -> SignedMessage a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignedMessage a -> SignedMessage a -> Bool
$c/= :: forall a. SignedMessage a -> SignedMessage a -> Bool
== :: SignedMessage a -> SignedMessage a -> Bool
$c== :: forall a. SignedMessage a -> SignedMessage a -> Bool
Haskell.Eq)
    deriving anyclass ([SignedMessage a] -> Encoding
[SignedMessage a] -> Value
SignedMessage a -> Encoding
SignedMessage a -> Value
(SignedMessage a -> Value)
-> (SignedMessage a -> Encoding)
-> ([SignedMessage a] -> Value)
-> ([SignedMessage a] -> Encoding)
-> ToJSON (SignedMessage a)
forall a. [SignedMessage a] -> Encoding
forall a. [SignedMessage a] -> Value
forall a. SignedMessage a -> Encoding
forall a. SignedMessage a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SignedMessage a] -> Encoding
$ctoEncodingList :: forall a. [SignedMessage a] -> Encoding
toJSONList :: [SignedMessage a] -> Value
$ctoJSONList :: forall a. [SignedMessage a] -> Value
toEncoding :: SignedMessage a -> Encoding
$ctoEncoding :: forall a. SignedMessage a -> Encoding
toJSON :: SignedMessage a -> Value
$ctoJSON :: forall a. SignedMessage a -> Value
ToJSON, Value -> Parser [SignedMessage a]
Value -> Parser (SignedMessage a)
(Value -> Parser (SignedMessage a))
-> (Value -> Parser [SignedMessage a])
-> FromJSON (SignedMessage a)
forall a. Value -> Parser [SignedMessage a]
forall a. Value -> Parser (SignedMessage a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SignedMessage a]
$cparseJSONList :: forall a. Value -> Parser [SignedMessage a]
parseJSON :: Value -> Parser (SignedMessage a)
$cparseJSON :: forall a. Value -> Parser (SignedMessage a)
FromJSON)

instance Eq a => Eq (SignedMessage a) where
    SignedMessage a
l == :: SignedMessage a -> SignedMessage a -> Bool
== SignedMessage a
r =
        SignedMessage a -> Signature
forall a. SignedMessage a -> Signature
osmSignature SignedMessage a
l Signature -> Signature -> Bool
forall a. Eq a => a -> a -> Bool
== SignedMessage a -> Signature
forall a. SignedMessage a -> Signature
osmSignature SignedMessage a
r
        Bool -> Bool -> Bool
&& SignedMessage a -> DatumHash
forall a. SignedMessage a -> DatumHash
osmMessageHash SignedMessage a
l DatumHash -> DatumHash -> Bool
forall a. Eq a => a -> a -> Bool
== SignedMessage a -> DatumHash
forall a. SignedMessage a -> DatumHash
osmMessageHash SignedMessage a
r
        Bool -> Bool -> Bool
&& SignedMessage a -> Datum
forall a. SignedMessage a -> Datum
osmDatum SignedMessage a
l Datum -> Datum -> Bool
forall a. Eq a => a -> a -> Bool
== SignedMessage a -> Datum
forall a. SignedMessage a -> Datum
osmDatum SignedMessage a
r

data SignedMessageCheckError =
    SignatureMismatch Signature PaymentPubKey DatumHash
    -- ^ The signature did not match the public key
    | DatumMissing DatumHash
    -- ^ The datum was missing from the pending transaction
    | DecodingError
    -- ^ The datum had the wrong shape
    | DatumNotEqualToExpected
    -- ^ The datum that corresponds to the hash is wrong
    deriving ((forall x.
 SignedMessageCheckError -> Rep SignedMessageCheckError x)
-> (forall x.
    Rep SignedMessageCheckError x -> SignedMessageCheckError)
-> Generic SignedMessageCheckError
forall x. Rep SignedMessageCheckError x -> SignedMessageCheckError
forall x. SignedMessageCheckError -> Rep SignedMessageCheckError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SignedMessageCheckError x -> SignedMessageCheckError
$cfrom :: forall x. SignedMessageCheckError -> Rep SignedMessageCheckError x
Generic, Int -> SignedMessageCheckError -> ShowS
[SignedMessageCheckError] -> ShowS
SignedMessageCheckError -> String
(Int -> SignedMessageCheckError -> ShowS)
-> (SignedMessageCheckError -> String)
-> ([SignedMessageCheckError] -> ShowS)
-> Show SignedMessageCheckError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignedMessageCheckError] -> ShowS
$cshowList :: [SignedMessageCheckError] -> ShowS
show :: SignedMessageCheckError -> String
$cshow :: SignedMessageCheckError -> String
showsPrec :: Int -> SignedMessageCheckError -> ShowS
$cshowsPrec :: Int -> SignedMessageCheckError -> ShowS
Haskell.Show)

{-# INLINABLE checkSignature #-}
-- | Verify the signature on a signed datum hash
checkSignature
  :: DatumHash
  -- ^ The hash of the message
  -> PaymentPubKey
  -- ^ The public key of the signatory
  -> Signature
  -- ^ The signed message
  -> Either SignedMessageCheckError ()
checkSignature :: DatumHash
-> PaymentPubKey -> Signature -> Either SignedMessageCheckError ()
checkSignature DatumHash
datumHash PaymentPubKey
pubKey Signature
signature_ =
    let PaymentPubKey (PubKey (LedgerBytes BuiltinByteString
pk)) = PaymentPubKey
pubKey
        Signature BuiltinByteString
sig = Signature
signature_
        DatumHash BuiltinByteString
h = DatumHash
datumHash
    in if BuiltinByteString -> BuiltinByteString -> BuiltinByteString -> Bool
verifyEd25519Signature BuiltinByteString
pk BuiltinByteString
h BuiltinByteString
sig
        then () -> Either SignedMessageCheckError ()
forall a b. b -> Either a b
Right ()
        else SignedMessageCheckError -> Either SignedMessageCheckError ()
forall a b. a -> Either a b
Left (SignedMessageCheckError -> Either SignedMessageCheckError ())
-> SignedMessageCheckError -> Either SignedMessageCheckError ()
forall a b. (a -> b) -> a -> b
$ Signature -> PaymentPubKey -> DatumHash -> SignedMessageCheckError
SignatureMismatch Signature
signature_ PaymentPubKey
pubKey DatumHash
datumHash

{-# INLINABLE checkHashConstraints #-}
-- | Extract the contents of the message and produce a constraint that checks
--   that the hash is correct. In off-chain code, where we check the hash
--   straightforwardly, 'checkHashOffChain' can be used instead of this.
checkHashConstraints ::
    ( FromData a )
    => SignedMessage a
    -- ^ The signed message
    -> Either SignedMessageCheckError (a, TxConstraints i o)
checkHashConstraints :: SignedMessage a
-> Either SignedMessageCheckError (a, TxConstraints i o)
checkHashConstraints SignedMessage{DatumHash
osmMessageHash :: DatumHash
osmMessageHash :: forall a. SignedMessage a -> DatumHash
osmMessageHash, osmDatum :: forall a. SignedMessage a -> Datum
osmDatum=Datum BuiltinData
dt} =
    Either SignedMessageCheckError (a, TxConstraints i o)
-> (a -> Either SignedMessageCheckError (a, TxConstraints i o))
-> Maybe a
-> Either SignedMessageCheckError (a, TxConstraints i o)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (BuiltinString
-> Either SignedMessageCheckError (a, TxConstraints i o)
-> Either SignedMessageCheckError (a, TxConstraints i o)
forall a. BuiltinString -> a -> a
trace BuiltinString
"Li" {-"DecodingError"-} (Either SignedMessageCheckError (a, TxConstraints i o)
 -> Either SignedMessageCheckError (a, TxConstraints i o))
-> Either SignedMessageCheckError (a, TxConstraints i o)
-> Either SignedMessageCheckError (a, TxConstraints i o)
forall a b. (a -> b) -> a -> b
$ SignedMessageCheckError
-> Either SignedMessageCheckError (a, TxConstraints i o)
forall a b. a -> Either a b
Left SignedMessageCheckError
DecodingError)
        (\a
a -> (a, TxConstraints i o)
-> Either SignedMessageCheckError (a, TxConstraints i o)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, DatumHash -> Datum -> TxConstraints i o
forall i o. DatumHash -> Datum -> TxConstraints i o
Constraints.mustIncludeDatumInTxWithHash DatumHash
osmMessageHash (BuiltinData -> Datum
Datum BuiltinData
dt)))
        (BuiltinData -> Maybe a
forall a. FromData a => BuiltinData -> Maybe a
fromBuiltinData BuiltinData
dt)

{-# INLINABLE verifySignedMessageConstraints #-}
-- | Check the signature on a 'SignedMessage' and extract the contents of the
--   message, producing a 'TxConstraint' value that ensures the hashes match
--   up.
verifySignedMessageConstraints ::
    ( FromData a)
    => PaymentPubKey
    -> SignedMessage a
    -> Either SignedMessageCheckError (a, TxConstraints i o)
verifySignedMessageConstraints :: PaymentPubKey
-> SignedMessage a
-> Either SignedMessageCheckError (a, TxConstraints i o)
verifySignedMessageConstraints PaymentPubKey
pk s :: SignedMessage a
s@SignedMessage{Signature
osmSignature :: Signature
osmSignature :: forall a. SignedMessage a -> Signature
osmSignature, DatumHash
osmMessageHash :: DatumHash
osmMessageHash :: forall a. SignedMessage a -> DatumHash
osmMessageHash} =
    DatumHash
-> PaymentPubKey -> Signature -> Either SignedMessageCheckError ()
checkSignature DatumHash
osmMessageHash PaymentPubKey
pk Signature
osmSignature
    Either SignedMessageCheckError ()
-> Either SignedMessageCheckError (a, TxConstraints i o)
-> Either SignedMessageCheckError (a, TxConstraints i o)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SignedMessage a
-> Either SignedMessageCheckError (a, TxConstraints i o)
forall a i o.
FromData a =>
SignedMessage a
-> Either SignedMessageCheckError (a, TxConstraints i o)
checkHashConstraints SignedMessage a
s

{-# INLINABLE verifySignedMessageOnChain #-}
-- | Check the signature on a 'SignedMessage' and extract the contents of the
--   message, using the pending transaction in lieu of a hash function. See
--   'verifySignedMessageConstraints' for a version that does not require a
--   'ScriptContext' value.
verifySignedMessageOnChain ::
    ( FromData a)
    => ScriptContext
    -> PaymentPubKey
    -> SignedMessage a
    -> Either SignedMessageCheckError a
verifySignedMessageOnChain :: ScriptContext
-> PaymentPubKey
-> SignedMessage a
-> Either SignedMessageCheckError a
verifySignedMessageOnChain ScriptContext
ptx PaymentPubKey
pk s :: SignedMessage a
s@SignedMessage{Signature
osmSignature :: Signature
osmSignature :: forall a. SignedMessage a -> Signature
osmSignature, DatumHash
osmMessageHash :: DatumHash
osmMessageHash :: forall a. SignedMessage a -> DatumHash
osmMessageHash} = do
    DatumHash
-> PaymentPubKey -> Signature -> Either SignedMessageCheckError ()
checkSignature DatumHash
osmMessageHash PaymentPubKey
pk Signature
osmSignature
    (a
a, TxConstraints () ()
constraints) <- SignedMessage a
-> Either SignedMessageCheckError (a, TxConstraints () ())
forall a i o.
FromData a =>
SignedMessage a
-> Either SignedMessageCheckError (a, TxConstraints i o)
checkHashConstraints SignedMessage a
s
    Bool
-> Either SignedMessageCheckError ()
-> Either SignedMessageCheckError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TxConstraints () () -> ScriptContext -> Bool
forall i o.
(ToData i, ToData o) =>
TxConstraints i o -> ScriptContext -> Bool
Constraints.checkScriptContext @() @() TxConstraints () ()
constraints ScriptContext
ptx)
        (SignedMessageCheckError -> Either SignedMessageCheckError ()
forall a b. a -> Either a b
Left (SignedMessageCheckError -> Either SignedMessageCheckError ())
-> SignedMessageCheckError -> Either SignedMessageCheckError ()
forall a b. (a -> b) -> a -> b
$ DatumHash -> SignedMessageCheckError
DatumMissing DatumHash
osmMessageHash)
    a -> Either SignedMessageCheckError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | The off-chain version of 'checkHashConstraints', using the hash function
--   directly instead of obtaining the hash from a 'ScriptContext' value
checkHashOffChain ::
    ( FromData a )
    => SignedMessage a
    -> Either SignedMessageCheckError a
checkHashOffChain :: SignedMessage a -> Either SignedMessageCheckError a
checkHashOffChain SignedMessage{DatumHash
osmMessageHash :: DatumHash
osmMessageHash :: forall a. SignedMessage a -> DatumHash
osmMessageHash, osmDatum :: forall a. SignedMessage a -> Datum
osmDatum=Datum
dt} = do
    Bool
-> Either SignedMessageCheckError ()
-> Either SignedMessageCheckError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DatumHash
osmMessageHash DatumHash -> DatumHash -> Bool
forall a. Eq a => a -> a -> Bool
== Datum -> DatumHash
Scripts.datumHash Datum
dt) (SignedMessageCheckError -> Either SignedMessageCheckError ()
forall a b. a -> Either a b
Left SignedMessageCheckError
DatumNotEqualToExpected)
    let Datum BuiltinData
dv = Datum
dt
    Either SignedMessageCheckError a
-> (a -> Either SignedMessageCheckError a)
-> Maybe a
-> Either SignedMessageCheckError a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SignedMessageCheckError -> Either SignedMessageCheckError a
forall a b. a -> Either a b
Left SignedMessageCheckError
DecodingError) a -> Either SignedMessageCheckError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BuiltinData -> Maybe a
forall a. FromData a => BuiltinData -> Maybe a
fromBuiltinData BuiltinData
dv)

-- | Check the signature on a 'SignedMessage' and extract the contents of the
--   message.
verifySignedMessageOffChain ::
    ( FromData a)
    => PaymentPubKey
    -> SignedMessage a
    -> Either SignedMessageCheckError a
verifySignedMessageOffChain :: PaymentPubKey
-> SignedMessage a -> Either SignedMessageCheckError a
verifySignedMessageOffChain PaymentPubKey
pk s :: SignedMessage a
s@SignedMessage{Signature
osmSignature :: Signature
osmSignature :: forall a. SignedMessage a -> Signature
osmSignature, DatumHash
osmMessageHash :: DatumHash
osmMessageHash :: forall a. SignedMessage a -> DatumHash
osmMessageHash} =
    DatumHash
-> PaymentPubKey -> Signature -> Either SignedMessageCheckError ()
checkSignature DatumHash
osmMessageHash PaymentPubKey
pk Signature
osmSignature
    Either SignedMessageCheckError ()
-> Either SignedMessageCheckError a
-> Either SignedMessageCheckError a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SignedMessage a -> Either SignedMessageCheckError a
forall a.
FromData a =>
SignedMessage a -> Either SignedMessageCheckError a
checkHashOffChain SignedMessage a
s

-- | Encode a message of type @a@ as a @Data@ value and sign the
--   hash of the datum.
signMessage :: ToData a => a -> PaymentPrivateKey -> Passphrase -> SignedMessage a
signMessage :: a -> PaymentPrivateKey -> Passphrase -> SignedMessage a
signMessage a
msg PaymentPrivateKey
pk Passphrase
pass =
  let dt :: Datum
dt = BuiltinData -> Datum
Datum (a -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData a
msg)
      DatumHash BuiltinByteString
msgHash = Datum -> DatumHash
Scripts.datumHash Datum
dt
      sig :: Signature
sig     = BuiltinByteString -> XPrv -> Passphrase -> Signature
forall a. ByteArrayAccess a => a -> XPrv -> Passphrase -> Signature
Crypto.sign BuiltinByteString
msgHash (PaymentPrivateKey -> XPrv
unPaymentPrivateKey PaymentPrivateKey
pk) Passphrase
pass
  in SignedMessage :: forall a. Signature -> DatumHash -> Datum -> SignedMessage a
SignedMessage
        { osmSignature :: Signature
osmSignature = Signature
sig
        , osmMessageHash :: DatumHash
osmMessageHash = BuiltinByteString -> DatumHash
DatumHash BuiltinByteString
msgHash
        , osmDatum :: Datum
osmDatum = Datum
dt
        }

-- | Encode an observation of a value of type @a@ that was made at the given time
signObservation :: ToData a => POSIXTime -> a -> PaymentPrivateKey -> Passphrase -> SignedMessage (Observation a)
signObservation :: POSIXTime
-> a
-> PaymentPrivateKey
-> Passphrase
-> SignedMessage (Observation a)
signObservation POSIXTime
time a
vl = Observation a
-> PaymentPrivateKey -> Passphrase -> SignedMessage (Observation a)
forall a.
ToData a =>
a -> PaymentPrivateKey -> Passphrase -> SignedMessage a
signMessage Observation :: forall a. a -> POSIXTime -> Observation a
Observation{obsValue :: a
obsValue=a
vl, obsTime :: POSIXTime
obsTime=POSIXTime
time}

-- | Encode a message of type @a@ as a @Data@ value and sign the
--   hash of the datum.
signMessage' :: ToData a => a -> Crypto.XPrv -> SignedMessage a
signMessage' :: a -> XPrv -> SignedMessage a
signMessage' a
msg XPrv
pk =
  let dt :: Datum
dt = BuiltinData -> Datum
Datum (a -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData a
msg)
      DatumHash BuiltinByteString
msgHash = Datum -> DatumHash
Scripts.datumHash Datum
dt
      sig :: Signature
sig     = BuiltinByteString -> XPrv -> Signature
forall a. ByteArrayAccess a => a -> XPrv -> Signature
Crypto.sign' BuiltinByteString
msgHash XPrv
pk
  in SignedMessage :: forall a. Signature -> DatumHash -> Datum -> SignedMessage a
SignedMessage
        { osmSignature :: Signature
osmSignature = Signature
sig
        , osmMessageHash :: DatumHash
osmMessageHash = BuiltinByteString -> DatumHash
DatumHash BuiltinByteString
msgHash
        , osmDatum :: Datum
osmDatum = Datum
dt
        }

-- | Encode an observation of a value of type @a@ that was made at the given time
signObservation' :: ToData a => POSIXTime -> a -> Crypto.XPrv -> SignedMessage (Observation a)
signObservation' :: POSIXTime -> a -> XPrv -> SignedMessage (Observation a)
signObservation' POSIXTime
time a
vl = Observation a -> XPrv -> SignedMessage (Observation a)
forall a. ToData a => a -> XPrv -> SignedMessage a
signMessage' Observation :: forall a. a -> POSIXTime -> Observation a
Observation{obsValue :: a
obsValue=a
vl, obsTime :: POSIXTime
obsTime=POSIXTime
time}

makeLift ''SignedMessage
makeIsDataIndexed ''SignedMessage [('SignedMessage,0)]

makeLift ''Observation
makeIsDataIndexed ''Observation [('Observation,0)]