{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Rpc.Server.Internal.UtxoRpc.Type.Script
  ( simpleScriptToUtxoRpcNativeScript
  , utxoRpcNativeScriptToSimpleScript
  , referenceScriptToUtxoRpcScript
  , scriptToUtxoRpcScript
  , utxoRpcScriptToReferenceScript
  , ledgerScriptToUtxoRpcScript
  , ledgerNativeScriptToUtxoRpcNativeScript
  )
where

import Cardano.Api.Block
import Cardano.Api.Era
import Cardano.Api.Error
import Cardano.Api.Experimental.Era
import Cardano.Api.HasTypeProxy
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Plutus
import Cardano.Api.Serialise.Cbor
import Cardano.Api.Serialise.Raw
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as U5c
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc

import Cardano.Ledger.Allegra.Scripts qualified as L
import Cardano.Ledger.Alonzo.Scripts qualified as L
  ( AlonzoScript (NativeScript, PlutusScript)
  , plutusScriptBinary
  )
import Cardano.Ledger.Api qualified as L (ShelleyEra)
import Cardano.Ledger.Core qualified as L (EraScript (NativeScript))
import Cardano.Ledger.Dijkstra.Scripts qualified as L
import Cardano.Ledger.Plutus.Language qualified as L (Language (..), PlutusBinary (..))
import Cardano.Ledger.Shelley.Scripts qualified as L

import RIO

import Data.ByteString.Short qualified as SBS
import Data.ProtoLens (defMessage)
import Network.GRPC.Spec

-- | TODO: remove together with the old-API TxOutput pipeline,
-- https://github.com/IntersectMBO/cardano-api/issues/1264
simpleScriptToUtxoRpcNativeScript :: SimpleScript -> Proto UtxoRpc.NativeScript
simpleScriptToUtxoRpcNativeScript :: SimpleScript -> Proto NativeScript
simpleScriptToUtxoRpcNativeScript = \case
  RequireSignature Hash PaymentKey
paymentKeyHash ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptPubkeyHash" a) =>
LensLike' f s a
U5c.scriptPubkeyHash LensLike' Identity (Proto NativeScript) ByteString
-> ByteString -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Hash PaymentKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes Hash PaymentKey
paymentKeyHash
  RequireTimeBefore (SlotNo Word64
slotNo) ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "invalidHereafter" a) =>
LensLike' f s a
U5c.invalidHereafter LensLike' Identity (Proto NativeScript) Word64
-> Word64 -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
slotNo
  RequireTimeAfter (SlotNo Word64
slotNo) ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "invalidBefore" a) =>
LensLike' f s a
U5c.invalidBefore LensLike' Identity (Proto NativeScript) Word64
-> Word64 -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
slotNo
  RequireAllOf [SimpleScript]
scripts ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptAll" a) =>
LensLike' f s a
U5c.scriptAll LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
-> (([Proto NativeScript] -> Identity [Proto NativeScript])
    -> Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScript
-> Identity (Proto NativeScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScriptList -> Identity (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "items" a) =>
LensLike' f s a
U5c.items (([Proto NativeScript] -> Identity [Proto NativeScript])
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> [Proto NativeScript] -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimpleScript -> Proto NativeScript)
-> [SimpleScript] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Proto NativeScript
simpleScriptToUtxoRpcNativeScript [SimpleScript]
scripts
  RequireAnyOf [SimpleScript]
scripts ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptAny" a) =>
LensLike' f s a
U5c.scriptAny LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
-> (([Proto NativeScript] -> Identity [Proto NativeScript])
    -> Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScript
-> Identity (Proto NativeScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScriptList -> Identity (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "items" a) =>
LensLike' f s a
U5c.items (([Proto NativeScript] -> Identity [Proto NativeScript])
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> [Proto NativeScript] -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimpleScript -> Proto NativeScript)
-> [SimpleScript] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Proto NativeScript
simpleScriptToUtxoRpcNativeScript [SimpleScript]
scripts
  RequireMOf Int
k [SimpleScript]
scripts -> do
    let nScriptsOf :: Proto ScriptNOfK
nScriptsOf =
          Proto ScriptNOfK
forall msg. Message msg => msg
defMessage
            Proto ScriptNOfK
-> (Proto ScriptNOfK -> Proto ScriptNOfK) -> Proto ScriptNOfK
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ScriptNOfK) Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "k" a) =>
LensLike' f s a
U5c.k LensLike' Identity (Proto ScriptNOfK) Word32
-> Word32 -> Proto ScriptNOfK -> Proto ScriptNOfK
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
            Proto ScriptNOfK
-> (Proto ScriptNOfK -> Proto ScriptNOfK) -> Proto ScriptNOfK
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ScriptNOfK) [Proto NativeScript]
forall (f :: * -> *) s a.
(Functor f, HasField s "scripts" a) =>
LensLike' f s a
U5c.scripts LensLike' Identity (Proto ScriptNOfK) [Proto NativeScript]
-> [Proto NativeScript] -> Proto ScriptNOfK -> Proto ScriptNOfK
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimpleScript -> Proto NativeScript)
-> [SimpleScript] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Proto NativeScript
simpleScriptToUtxoRpcNativeScript [SimpleScript]
scripts
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto ScriptNOfK)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptNOfK" a) =>
LensLike' f s a
U5c.scriptNOfK LensLike' Identity (Proto NativeScript) (Proto ScriptNOfK)
-> Proto ScriptNOfK -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto ScriptNOfK
nScriptsOf

utxoRpcNativeScriptToSimpleScript
  :: HasCallStack
  => MonadThrow m
  => Proto UtxoRpc.NativeScript
  -> m SimpleScript
utxoRpcNativeScriptToSimpleScript :: forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto NativeScript -> m SimpleScript
utxoRpcNativeScriptToSimpleScript Proto NativeScript
scriptRpc
  | Just ByteString
paymentKeyHash <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting
     (Maybe ByteString) (Proto NativeScript) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto NativeScript) (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'scriptPubkeyHash" a) =>
LensLike' f s a
U5c.maybe'scriptPubkeyHash =
      Hash PaymentKey -> SimpleScript
RequireSignature (Hash PaymentKey -> SimpleScript)
-> m (Hash PaymentKey) -> m SimpleScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SerialiseAsRawBytesError (Hash PaymentKey)
-> m (Hash PaymentKey)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (AsType (Hash PaymentKey)
-> ByteString -> Either SerialiseAsRawBytesError (Hash PaymentKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType (Hash PaymentKey)
forall t. HasTypeProxy t => AsType t
asType ByteString
paymentKeyHash)
  | Just Word64
slotNo <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting (Maybe Word64) (Proto NativeScript) (Maybe Word64)
-> Maybe Word64
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Word64) (Proto NativeScript) (Maybe Word64)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'invalidHereafter" a) =>
LensLike' f s a
U5c.maybe'invalidHereafter =
      SimpleScript -> m SimpleScript
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleScript -> m SimpleScript)
-> (SlotNo -> SimpleScript) -> SlotNo -> m SimpleScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> SimpleScript
RequireTimeBefore (SlotNo -> m SimpleScript) -> SlotNo -> m SimpleScript
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
slotNo
  | Just Word64
slotNo <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting (Maybe Word64) (Proto NativeScript) (Maybe Word64)
-> Maybe Word64
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Word64) (Proto NativeScript) (Maybe Word64)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'invalidBefore" a) =>
LensLike' f s a
U5c.maybe'invalidBefore =
      SimpleScript -> m SimpleScript
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleScript -> m SimpleScript)
-> (SlotNo -> SimpleScript) -> SlotNo -> m SimpleScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> SimpleScript
RequireTimeAfter (SlotNo -> m SimpleScript) -> SlotNo -> m SimpleScript
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
slotNo
  | Just Proto NativeScriptList
scriptsRpc <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting
     (Maybe (Proto NativeScriptList))
     (Proto NativeScript)
     (Maybe (Proto NativeScriptList))
-> Maybe (Proto NativeScriptList)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto NativeScriptList))
  (Proto NativeScript)
  (Maybe (Proto NativeScriptList))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'scriptAll" a) =>
LensLike' f s a
U5c.maybe'scriptAll = do
      ([SimpleScript] -> SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SimpleScript] -> SimpleScript
RequireAllOf (m [SimpleScript] -> m SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> a -> b
$
        (Proto NativeScript -> m SimpleScript)
-> [Proto NativeScript] -> m [SimpleScript]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Proto NativeScript -> m SimpleScript
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto NativeScript -> m SimpleScript
utxoRpcNativeScriptToSimpleScript ([Proto NativeScript] -> m [SimpleScript])
-> [Proto NativeScript] -> m [SimpleScript]
forall a b. (a -> b) -> a -> b
$
          Proto NativeScriptList
scriptsRpc Proto NativeScriptList
-> Getting
     [Proto NativeScript] (Proto NativeScriptList) [Proto NativeScript]
-> [Proto NativeScript]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto NativeScript] (Proto NativeScriptList) [Proto NativeScript]
forall (f :: * -> *) s a.
(Functor f, HasField s "items" a) =>
LensLike' f s a
U5c.items
  | Just Proto NativeScriptList
scriptsRpc <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting
     (Maybe (Proto NativeScriptList))
     (Proto NativeScript)
     (Maybe (Proto NativeScriptList))
-> Maybe (Proto NativeScriptList)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto NativeScriptList))
  (Proto NativeScript)
  (Maybe (Proto NativeScriptList))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'scriptAny" a) =>
LensLike' f s a
U5c.maybe'scriptAny = do
      ([SimpleScript] -> SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SimpleScript] -> SimpleScript
RequireAnyOf (m [SimpleScript] -> m SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> a -> b
$
        (Proto NativeScript -> m SimpleScript)
-> [Proto NativeScript] -> m [SimpleScript]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Proto NativeScript -> m SimpleScript
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto NativeScript -> m SimpleScript
utxoRpcNativeScriptToSimpleScript ([Proto NativeScript] -> m [SimpleScript])
-> [Proto NativeScript] -> m [SimpleScript]
forall a b. (a -> b) -> a -> b
$
          Proto NativeScriptList
scriptsRpc Proto NativeScriptList
-> Getting
     [Proto NativeScript] (Proto NativeScriptList) [Proto NativeScript]
-> [Proto NativeScript]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto NativeScript] (Proto NativeScriptList) [Proto NativeScript]
forall (f :: * -> *) s a.
(Functor f, HasField s "items" a) =>
LensLike' f s a
U5c.items
  | Just Proto ScriptNOfK
scriptsRpc <- Proto NativeScript
scriptRpc Proto NativeScript
-> Getting
     (Maybe (Proto ScriptNOfK))
     (Proto NativeScript)
     (Maybe (Proto ScriptNOfK))
-> Maybe (Proto ScriptNOfK)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto ScriptNOfK))
  (Proto NativeScript)
  (Maybe (Proto ScriptNOfK))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'scriptNOfK" a) =>
LensLike' f s a
U5c.maybe'scriptNOfK = do
      ([SimpleScript] -> SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [SimpleScript] -> SimpleScript
RequireMOf (Int -> [SimpleScript] -> SimpleScript)
-> (Word32 -> Int) -> Word32 -> [SimpleScript] -> SimpleScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> [SimpleScript] -> SimpleScript)
-> Word32 -> [SimpleScript] -> SimpleScript
forall a b. (a -> b) -> a -> b
$ Proto ScriptNOfK
scriptsRpc Proto ScriptNOfK
-> Getting Word32 (Proto ScriptNOfK) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Proto ScriptNOfK) Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "k" a) =>
LensLike' f s a
U5c.k) (m [SimpleScript] -> m SimpleScript)
-> m [SimpleScript] -> m SimpleScript
forall a b. (a -> b) -> a -> b
$
        (Proto NativeScript -> m SimpleScript)
-> [Proto NativeScript] -> m [SimpleScript]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Proto NativeScript -> m SimpleScript
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto NativeScript -> m SimpleScript
utxoRpcNativeScriptToSimpleScript ([Proto NativeScript] -> m [SimpleScript])
-> [Proto NativeScript] -> m [SimpleScript]
forall a b. (a -> b) -> a -> b
$
          Proto ScriptNOfK
scriptsRpc Proto ScriptNOfK
-> Getting
     [Proto NativeScript] (Proto ScriptNOfK) [Proto NativeScript]
-> [Proto NativeScript]
forall s a. s -> Getting a s a -> a
^. Getting
  [Proto NativeScript] (Proto ScriptNOfK) [Proto NativeScript]
forall (f :: * -> *) s a.
(Functor f, HasField s "scripts" a) =>
LensLike' f s a
U5c.scripts
  | Bool
otherwise = StringException -> m SimpleScript
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (StringException -> m SimpleScript)
-> ([Char] -> StringException) -> [Char] -> m SimpleScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => [Char] -> StringException
[Char] -> StringException
stringException ([Char] -> m SimpleScript) -> [Char] -> m SimpleScript
forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot decode UTxORPC NativeScript"

referenceScriptToUtxoRpcScript :: ReferenceScript era -> Proto UtxoRpc.Script
referenceScriptToUtxoRpcScript :: forall era. ReferenceScript era -> Proto Script
referenceScriptToUtxoRpcScript ReferenceScript era
ReferenceScriptNone = Proto Script
forall msg. Message msg => msg
defMessage
referenceScriptToUtxoRpcScript (ReferenceScript BabbageEraOnwards era
_ (ScriptInAnyLang ScriptLanguage lang
_ Script lang
script)) =
  Script lang -> Proto Script
forall lang. Script lang -> Proto Script
scriptToUtxoRpcScript Script lang
script

-- | Convert a script to the UTxO RPC 'UtxoRpc.Script' message, dispatching on
-- the script language to select the corresponding oneof field.
--
-- TODO: remove together with the old-API TxOutput pipeline,
-- https://github.com/IntersectMBO/cardano-api/issues/1264
scriptToUtxoRpcScript :: Script lang -> Proto UtxoRpc.Script
scriptToUtxoRpcScript :: forall lang. Script lang -> Proto Script
scriptToUtxoRpcScript = \case
  SimpleScript SimpleScript
ss ->
    Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) (Proto NativeScript)
forall (f :: * -> *) s a.
(Functor f, HasField s "native" a) =>
LensLike' f s a
U5c.native LensLike' Identity (Proto Script) (Proto NativeScript)
-> Proto NativeScript -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SimpleScript -> Proto NativeScript
simpleScriptToUtxoRpcNativeScript SimpleScript
ss
  PlutusScript PlutusScriptVersion lang
PlutusScriptV1 PlutusScript lang
ps ->
    Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "plutusV1" a) =>
LensLike' f s a
U5c.plutusV1 LensLike' Identity (Proto Script) ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PlutusScript lang -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PlutusScript lang
ps
  PlutusScript PlutusScriptVersion lang
PlutusScriptV2 PlutusScript lang
ps ->
    Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "plutusV2" a) =>
LensLike' f s a
U5c.plutusV2 LensLike' Identity (Proto Script) ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PlutusScript lang -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PlutusScript lang
ps
  PlutusScript PlutusScriptVersion lang
PlutusScriptV3 PlutusScript lang
ps ->
    Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "plutusV3" a) =>
LensLike' f s a
U5c.plutusV3 LensLike' Identity (Proto Script) ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PlutusScript lang -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PlutusScript lang
ps
  PlutusScript PlutusScriptVersion lang
PlutusScriptV4 PlutusScript lang
ps ->
    Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "plutusV4" a) =>
LensLike' f s a
U5c.plutusV4 LensLike' Identity (Proto Script) ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PlutusScript lang -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes PlutusScript lang
ps

utxoRpcScriptToReferenceScript
  :: forall era m
   . HasCallStack
  => MonadThrow m
  => IsEra era
  => Proto UtxoRpc.Script
  -> m (ReferenceScript era)
utxoRpcScriptToReferenceScript :: forall era (m :: * -> *).
(HasCallStack, MonadThrow m, IsEra era) =>
Proto Script -> m (ReferenceScript era)
utxoRpcScriptToReferenceScript Proto Script
protoScript
  | Just Proto NativeScript
script <- Proto Script
protoScript Proto Script
-> Getting
     (Maybe (Proto NativeScript))
     (Proto Script)
     (Maybe (Proto NativeScript))
-> Maybe (Proto NativeScript)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Proto NativeScript))
  (Proto Script)
  (Maybe (Proto NativeScript))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'native" a) =>
LensLike' f s a
U5c.maybe'native =
      BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era)
-> Era era -> BabbageEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
useEra @era) (ScriptInAnyLang -> ReferenceScript era)
-> (SimpleScript -> ScriptInAnyLang)
-> SimpleScript
-> ReferenceScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguage SimpleScript'
-> Script SimpleScript' -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang ScriptLanguage SimpleScript'
SimpleScriptLanguage (Script SimpleScript' -> ScriptInAnyLang)
-> (SimpleScript -> Script SimpleScript')
-> SimpleScript
-> ScriptInAnyLang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript
        (SimpleScript -> ReferenceScript era)
-> m SimpleScript -> m (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proto NativeScript -> m SimpleScript
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
Proto NativeScript -> m SimpleScript
utxoRpcNativeScriptToSimpleScript Proto NativeScript
script
  | Just ByteString
script <- Proto Script
protoScript Proto Script
-> Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'plutusV1" a) =>
LensLike' f s a
U5c.maybe'plutusV1 =
      BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era)
-> Era era -> BabbageEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
useEra @era) (ScriptInAnyLang -> ReferenceScript era)
-> (Script PlutusScriptV1 -> ScriptInAnyLang)
-> Script PlutusScriptV1
-> ReferenceScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguage PlutusScriptV1
-> Script PlutusScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1)
        (Script PlutusScriptV1 -> ReferenceScript era)
-> m (Script PlutusScriptV1) -> m (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DecoderError (Script PlutusScriptV1)
-> m (Script PlutusScriptV1)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (AsType (Script PlutusScriptV1)
-> ByteString -> Either DecoderError (Script PlutusScriptV1)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType (Script PlutusScriptV1)
forall t. HasTypeProxy t => AsType t
asType ByteString
script)
  | Just ByteString
script <- Proto Script
protoScript Proto Script
-> Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'plutusV2" a) =>
LensLike' f s a
U5c.maybe'plutusV2 =
      BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era)
-> Era era -> BabbageEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
useEra @era) (ScriptInAnyLang -> ReferenceScript era)
-> (Script PlutusScriptV2 -> ScriptInAnyLang)
-> Script PlutusScriptV2
-> ReferenceScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguage PlutusScriptV2
-> Script PlutusScriptV2 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV2 -> ScriptLanguage PlutusScriptV2
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2)
        (Script PlutusScriptV2 -> ReferenceScript era)
-> m (Script PlutusScriptV2) -> m (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DecoderError (Script PlutusScriptV2)
-> m (Script PlutusScriptV2)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (AsType (Script PlutusScriptV2)
-> ByteString -> Either DecoderError (Script PlutusScriptV2)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType (Script PlutusScriptV2)
forall t. HasTypeProxy t => AsType t
asType ByteString
script)
  | Just ByteString
script <- Proto Script
protoScript Proto Script
-> Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'plutusV3" a) =>
LensLike' f s a
U5c.maybe'plutusV3 =
      BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era)
-> Era era -> BabbageEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
useEra @era) (ScriptInAnyLang -> ReferenceScript era)
-> (Script PlutusScriptV3 -> ScriptInAnyLang)
-> Script PlutusScriptV3
-> ReferenceScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguage PlutusScriptV3
-> Script PlutusScriptV3 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV3 -> ScriptLanguage PlutusScriptV3
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV3
PlutusScriptV3)
        (Script PlutusScriptV3 -> ReferenceScript era)
-> m (Script PlutusScriptV3) -> m (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DecoderError (Script PlutusScriptV3)
-> m (Script PlutusScriptV3)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (AsType (Script PlutusScriptV3)
-> ByteString -> Either DecoderError (Script PlutusScriptV3)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType (Script PlutusScriptV3)
forall t. HasTypeProxy t => AsType t
asType ByteString
script)
  | Just ByteString
script <- Proto Script
protoScript Proto Script
-> Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) (Proto Script) (Maybe ByteString)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'plutusV4" a) =>
LensLike' f s a
U5c.maybe'plutusV4 =
      BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript (Era era -> BabbageEraOnwards era
forall era. Era era -> BabbageEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> BabbageEraOnwards era)
-> Era era -> BabbageEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
useEra @era) (ScriptInAnyLang -> ReferenceScript era)
-> (Script PlutusScriptV4 -> ScriptInAnyLang)
-> Script PlutusScriptV4
-> ReferenceScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguage PlutusScriptV4
-> Script PlutusScriptV4 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV4 -> ScriptLanguage PlutusScriptV4
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV4
PlutusScriptV4)
        (Script PlutusScriptV4 -> ReferenceScript era)
-> m (Script PlutusScriptV4) -> m (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DecoderError (Script PlutusScriptV4)
-> m (Script PlutusScriptV4)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Typeable e, Error e) =>
Either e a -> m a
liftEitherError (AsType (Script PlutusScriptV4)
-> ByteString -> Either DecoderError (Script PlutusScriptV4)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType (Script PlutusScriptV4)
forall t. HasTypeProxy t => AsType t
asType ByteString
script)
  | Bool
otherwise = ReferenceScript era -> m (ReferenceScript era)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone

-- | Convert a ledger script to the UTxO RPC 'UtxoRpc.Script' message,
-- dispatching native scripts to the 'UtxoRpc.NativeScript' oneof field and
-- plutus scripts to the field of their language version.
ledgerScriptToUtxoRpcScript
  :: ShelleyBasedEra era
  -> L.Script (ShelleyLedgerEra era)
  -> Proto UtxoRpc.Script
ledgerScriptToUtxoRpcScript :: forall era.
ShelleyBasedEra era
-> Script (ShelleyLedgerEra era) -> Proto Script
ledgerScriptToUtxoRpcScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
script = case ShelleyBasedEra era
sbe of
  ShelleyBasedEra era
ShelleyBasedEraShelley ->
    Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) (Proto NativeScript)
forall (f :: * -> *) s a.
(Functor f, HasField s "native" a) =>
LensLike' f s a
U5c.native LensLike' Identity (Proto Script) (Proto NativeScript)
-> Proto NativeScript -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyBasedEra era
-> NativeScript (ShelleyLedgerEra era) -> Proto NativeScript
forall era.
ShelleyBasedEra era
-> NativeScript (ShelleyLedgerEra era) -> Proto NativeScript
ledgerNativeScriptToUtxoRpcNativeScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
NativeScript (ShelleyLedgerEra era)
script
  ShelleyBasedEra era
ShelleyBasedEraAllegra ->
    Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) (Proto NativeScript)
forall (f :: * -> *) s a.
(Functor f, HasField s "native" a) =>
LensLike' f s a
U5c.native LensLike' Identity (Proto Script) (Proto NativeScript)
-> Proto NativeScript -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyBasedEra era
-> NativeScript (ShelleyLedgerEra era) -> Proto NativeScript
forall era.
ShelleyBasedEra era
-> NativeScript (ShelleyLedgerEra era) -> Proto NativeScript
ledgerNativeScriptToUtxoRpcNativeScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
NativeScript (ShelleyLedgerEra era)
script
  ShelleyBasedEra era
ShelleyBasedEraMary ->
    Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) (Proto NativeScript)
forall (f :: * -> *) s a.
(Functor f, HasField s "native" a) =>
LensLike' f s a
U5c.native LensLike' Identity (Proto Script) (Proto NativeScript)
-> Proto NativeScript -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyBasedEra era
-> NativeScript (ShelleyLedgerEra era) -> Proto NativeScript
forall era.
ShelleyBasedEra era
-> NativeScript (ShelleyLedgerEra era) -> Proto NativeScript
ledgerNativeScriptToUtxoRpcNativeScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
NativeScript (ShelleyLedgerEra era)
script
  ShelleyBasedEra era
ShelleyBasedEraAlonzo -> ShelleyBasedEra era
-> AlonzoScript (ShelleyLedgerEra era) -> Proto Script
forall era.
AlonzoEraScript (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> AlonzoScript (ShelleyLedgerEra era) -> Proto Script
alonzoScriptToUtxoRpcScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
AlonzoScript (ShelleyLedgerEra era)
script
  ShelleyBasedEra era
ShelleyBasedEraBabbage -> ShelleyBasedEra era
-> AlonzoScript (ShelleyLedgerEra era) -> Proto Script
forall era.
AlonzoEraScript (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> AlonzoScript (ShelleyLedgerEra era) -> Proto Script
alonzoScriptToUtxoRpcScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
AlonzoScript (ShelleyLedgerEra era)
script
  ShelleyBasedEra era
ShelleyBasedEraConway -> ShelleyBasedEra era
-> AlonzoScript (ShelleyLedgerEra era) -> Proto Script
forall era.
AlonzoEraScript (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> AlonzoScript (ShelleyLedgerEra era) -> Proto Script
alonzoScriptToUtxoRpcScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
AlonzoScript (ShelleyLedgerEra era)
script
  ShelleyBasedEra era
ShelleyBasedEraDijkstra -> ShelleyBasedEra era
-> AlonzoScript (ShelleyLedgerEra era) -> Proto Script
forall era.
AlonzoEraScript (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> AlonzoScript (ShelleyLedgerEra era) -> Proto Script
alonzoScriptToUtxoRpcScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
AlonzoScript (ShelleyLedgerEra era)
script

alonzoScriptToUtxoRpcScript
  :: L.AlonzoEraScript (ShelleyLedgerEra era)
  => ShelleyBasedEra era
  -> L.AlonzoScript (ShelleyLedgerEra era)
  -> Proto UtxoRpc.Script
alonzoScriptToUtxoRpcScript :: forall era.
AlonzoEraScript (ShelleyLedgerEra era) =>
ShelleyBasedEra era
-> AlonzoScript (ShelleyLedgerEra era) -> Proto Script
alonzoScriptToUtxoRpcScript ShelleyBasedEra era
sbe = \case
  L.NativeScript NativeScript (ShelleyLedgerEra era)
nativeScript ->
    Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) (Proto NativeScript)
forall (f :: * -> *) s a.
(Functor f, HasField s "native" a) =>
LensLike' f s a
U5c.native LensLike' Identity (Proto Script) (Proto NativeScript)
-> Proto NativeScript -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyBasedEra era
-> NativeScript (ShelleyLedgerEra era) -> Proto NativeScript
forall era.
ShelleyBasedEra era
-> NativeScript (ShelleyLedgerEra era) -> Proto NativeScript
ledgerNativeScriptToUtxoRpcNativeScript ShelleyBasedEra era
sbe NativeScript (ShelleyLedgerEra era)
nativeScript
  L.PlutusScript PlutusScript (ShelleyLedgerEra era)
plutusScript -> PlutusScript (ShelleyLedgerEra era) -> Proto Script
forall era. AlonzoEraScript era => PlutusScript era -> Proto Script
plutusScriptToUtxoRpcScript PlutusScript (ShelleyLedgerEra era)
plutusScript

-- | Convert a ledger Plutus script to the UTxO RPC 'UtxoRpc.Script' message,
-- dispatching on the Plutus language version to select the corresponding oneof
-- field. This is a pure projection of the script bytes: no CBOR decoding involved.
plutusScriptToUtxoRpcScript :: L.AlonzoEraScript era => L.PlutusScript era -> Proto UtxoRpc.Script
plutusScriptToUtxoRpcScript :: forall era. AlonzoEraScript era => PlutusScript era -> Proto Script
plutusScriptToUtxoRpcScript PlutusScript era
plutusScript = do
  let bytes :: ByteString
bytes = ShortByteString -> ByteString
SBS.fromShort (ShortByteString -> ByteString)
-> (PlutusBinary -> ShortByteString) -> PlutusBinary -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> ShortByteString
L.unPlutusBinary (PlutusBinary -> ByteString) -> PlutusBinary -> ByteString
forall a b. (a -> b) -> a -> b
$ PlutusScript era -> PlutusBinary
forall era. AlonzoEraScript era => PlutusScript era -> PlutusBinary
L.plutusScriptBinary PlutusScript era
plutusScript
  case PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
L.plutusScriptLanguage PlutusScript era
plutusScript of
    Language
L.PlutusV1 -> Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "plutusV1" a) =>
LensLike' f s a
U5c.plutusV1 LensLike' Identity (Proto Script) ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
bytes
    Language
L.PlutusV2 -> Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "plutusV2" a) =>
LensLike' f s a
U5c.plutusV2 LensLike' Identity (Proto Script) ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
bytes
    Language
L.PlutusV3 -> Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "plutusV3" a) =>
LensLike' f s a
U5c.plutusV3 LensLike' Identity (Proto Script) ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
bytes
    Language
L.PlutusV4 -> Proto Script
forall msg. Message msg => msg
defMessage Proto Script -> (Proto Script -> Proto Script) -> Proto Script
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto Script) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "plutusV4" a) =>
LensLike' f s a
U5c.plutusV4 LensLike' Identity (Proto Script) ByteString
-> ByteString -> Proto Script -> Proto Script
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
bytes

-- | Convert a ledger native script directly to the UTxO RPC 'UtxoRpc.NativeScript'
-- message.
--
-- Each group of eras has its own concrete native script type: 'MultiSig' at
-- Shelley, 'Timelock' from Allegra up to Conway (all sharing the same six view
-- patterns), and Dijkstra's own type, which additionally supports a guard script.
ledgerNativeScriptToUtxoRpcNativeScript
  :: ShelleyBasedEra era
  -> L.NativeScript (ShelleyLedgerEra era)
  -> Proto UtxoRpc.NativeScript
ledgerNativeScriptToUtxoRpcNativeScript :: forall era.
ShelleyBasedEra era
-> NativeScript (ShelleyLedgerEra era) -> Proto NativeScript
ledgerNativeScriptToUtxoRpcNativeScript ShelleyBasedEra era
sbe NativeScript (ShelleyLedgerEra era)
nativeScript = case ShelleyBasedEra era
sbe of
  ShelleyBasedEra era
ShelleyBasedEraShelley -> NativeScript ShelleyEra -> Proto NativeScript
shelleyMultiSigToUtxoRpcNativeScript NativeScript (ShelleyLedgerEra era)
NativeScript ShelleyEra
nativeScript
  ShelleyBasedEra era
ShelleyBasedEraAllegra -> NativeScript AllegraEra -> Proto NativeScript
forall era'.
AllegraEraScript era' =>
NativeScript era' -> Proto NativeScript
allegraEraScriptToUtxoRpcNativeScript NativeScript (ShelleyLedgerEra era)
NativeScript AllegraEra
nativeScript
  ShelleyBasedEra era
ShelleyBasedEraMary -> NativeScript MaryEra -> Proto NativeScript
forall era'.
AllegraEraScript era' =>
NativeScript era' -> Proto NativeScript
allegraEraScriptToUtxoRpcNativeScript NativeScript (ShelleyLedgerEra era)
NativeScript MaryEra
nativeScript
  ShelleyBasedEra era
ShelleyBasedEraAlonzo -> NativeScript AlonzoEra -> Proto NativeScript
forall era'.
AllegraEraScript era' =>
NativeScript era' -> Proto NativeScript
allegraEraScriptToUtxoRpcNativeScript NativeScript (ShelleyLedgerEra era)
NativeScript AlonzoEra
nativeScript
  ShelleyBasedEra era
ShelleyBasedEraBabbage -> NativeScript BabbageEra -> Proto NativeScript
forall era'.
AllegraEraScript era' =>
NativeScript era' -> Proto NativeScript
allegraEraScriptToUtxoRpcNativeScript NativeScript (ShelleyLedgerEra era)
NativeScript BabbageEra
nativeScript
  ShelleyBasedEra era
ShelleyBasedEraConway -> NativeScript ConwayEra -> Proto NativeScript
forall era'.
AllegraEraScript era' =>
NativeScript era' -> Proto NativeScript
allegraEraScriptToUtxoRpcNativeScript NativeScript (ShelleyLedgerEra era)
NativeScript ConwayEra
nativeScript
  ShelleyBasedEra era
ShelleyBasedEraDijkstra -> NativeScript DijkstraEra -> Proto NativeScript
forall era'.
DijkstraEraScript era' =>
NativeScript era' -> Proto NativeScript
dijkstraNativeScriptToUtxoRpcNativeScript NativeScript (ShelleyLedgerEra era)
NativeScript DijkstraEra
nativeScript

-- | Shelley's 'MultiSig' has only these four constructors, and ledger declares a
-- 'COMPLETE' pragma for exactly this set at 'L.ShelleyEra'. GHC 9.12.4 does not
-- resolve that pragma here in practice (verified directly: the same match without
-- a wildcard triggers @-Wincomplete-patterns@, apparently because the pragma is
-- keyed to the type family application 'L.NativeScript' 'L.ShelleyEra' rather than
-- its reduction), so a defensive wildcard is required.
shelleyMultiSigToUtxoRpcNativeScript :: L.NativeScript L.ShelleyEra -> Proto UtxoRpc.NativeScript
shelleyMultiSigToUtxoRpcNativeScript :: NativeScript ShelleyEra -> Proto NativeScript
shelleyMultiSigToUtxoRpcNativeScript = \case
  L.RequireSignature KeyHash Witness
keyHash ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptPubkeyHash" a) =>
LensLike' f s a
U5c.scriptPubkeyHash LensLike' Identity (Proto NativeScript) ByteString
-> ByteString -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
L.hashToBytes (KeyHash Witness -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall (r :: KeyRole).
KeyHash r -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
L.unKeyHash KeyHash Witness
keyHash)
  L.RequireAllOf StrictSeq (NativeScript ShelleyEra)
scripts ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptAll" a) =>
LensLike' f s a
U5c.scriptAll LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
-> (([Proto NativeScript] -> Identity [Proto NativeScript])
    -> Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScript
-> Identity (Proto NativeScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScriptList -> Identity (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "items" a) =>
LensLike' f s a
U5c.items (([Proto NativeScript] -> Identity [Proto NativeScript])
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> [Proto NativeScript] -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (MultiSig ShelleyEra -> Proto NativeScript)
-> [MultiSig ShelleyEra] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map NativeScript ShelleyEra -> Proto NativeScript
MultiSig ShelleyEra -> Proto NativeScript
shelleyMultiSigToUtxoRpcNativeScript (StrictSeq (MultiSig ShelleyEra) -> [MultiSig ShelleyEra]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript ShelleyEra)
StrictSeq (MultiSig ShelleyEra)
scripts)
  L.RequireAnyOf StrictSeq (NativeScript ShelleyEra)
scripts ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptAny" a) =>
LensLike' f s a
U5c.scriptAny LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
-> (([Proto NativeScript] -> Identity [Proto NativeScript])
    -> Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScript
-> Identity (Proto NativeScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScriptList -> Identity (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "items" a) =>
LensLike' f s a
U5c.items (([Proto NativeScript] -> Identity [Proto NativeScript])
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> [Proto NativeScript] -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (MultiSig ShelleyEra -> Proto NativeScript)
-> [MultiSig ShelleyEra] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map NativeScript ShelleyEra -> Proto NativeScript
MultiSig ShelleyEra -> Proto NativeScript
shelleyMultiSigToUtxoRpcNativeScript (StrictSeq (MultiSig ShelleyEra) -> [MultiSig ShelleyEra]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript ShelleyEra)
StrictSeq (MultiSig ShelleyEra)
scripts)
  L.RequireMOf Int
k StrictSeq (NativeScript ShelleyEra)
scripts -> do
    let nScriptsOf :: Proto ScriptNOfK
nScriptsOf =
          Proto ScriptNOfK
forall msg. Message msg => msg
defMessage
            Proto ScriptNOfK
-> (Proto ScriptNOfK -> Proto ScriptNOfK) -> Proto ScriptNOfK
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ScriptNOfK) Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "k" a) =>
LensLike' f s a
U5c.k LensLike' Identity (Proto ScriptNOfK) Word32
-> Word32 -> Proto ScriptNOfK -> Proto ScriptNOfK
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
            Proto ScriptNOfK
-> (Proto ScriptNOfK -> Proto ScriptNOfK) -> Proto ScriptNOfK
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ScriptNOfK) [Proto NativeScript]
forall (f :: * -> *) s a.
(Functor f, HasField s "scripts" a) =>
LensLike' f s a
U5c.scripts LensLike' Identity (Proto ScriptNOfK) [Proto NativeScript]
-> [Proto NativeScript] -> Proto ScriptNOfK -> Proto ScriptNOfK
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (MultiSig ShelleyEra -> Proto NativeScript)
-> [MultiSig ShelleyEra] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map NativeScript ShelleyEra -> Proto NativeScript
MultiSig ShelleyEra -> Proto NativeScript
shelleyMultiSigToUtxoRpcNativeScript (StrictSeq (MultiSig ShelleyEra) -> [MultiSig ShelleyEra]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript ShelleyEra)
StrictSeq (MultiSig ShelleyEra)
scripts)
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto ScriptNOfK)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptNOfK" a) =>
LensLike' f s a
U5c.scriptNOfK LensLike' Identity (Proto NativeScript) (Proto ScriptNOfK)
-> Proto ScriptNOfK -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto ScriptNOfK
nScriptsOf
  NativeScript ShelleyEra
_ ->
    [Char] -> Proto NativeScript
forall a. HasCallStack => [Char] -> a
error
      [Char]
"shelleyMultiSigToUtxoRpcNativeScript: impossible - every ShelleyEra MultiSig \
      \constructor is matched above"

-- | Shared body for the Allegra, Mary, Alonzo, Babbage and Conway native script
-- representations, all of which are 'Timelock' under the hood. The view patterns
-- have no 'COMPLETE' pragma at this polymorphic use (only at each concrete era), so
-- the wildcard below is unreachable in practice but required by the compiler.
allegraEraScriptToUtxoRpcNativeScript
  :: L.AllegraEraScript era'
  => L.NativeScript era'
  -> Proto UtxoRpc.NativeScript
allegraEraScriptToUtxoRpcNativeScript :: forall era'.
AllegraEraScript era' =>
NativeScript era' -> Proto NativeScript
allegraEraScriptToUtxoRpcNativeScript = \case
  L.RequireSignature KeyHash Witness
keyHash ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptPubkeyHash" a) =>
LensLike' f s a
U5c.scriptPubkeyHash LensLike' Identity (Proto NativeScript) ByteString
-> ByteString -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
L.hashToBytes (KeyHash Witness -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall (r :: KeyRole).
KeyHash r -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
L.unKeyHash KeyHash Witness
keyHash)
  L.RequireAllOf StrictSeq (NativeScript era')
scripts ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptAll" a) =>
LensLike' f s a
U5c.scriptAll LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
-> (([Proto NativeScript] -> Identity [Proto NativeScript])
    -> Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScript
-> Identity (Proto NativeScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScriptList -> Identity (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "items" a) =>
LensLike' f s a
U5c.items (([Proto NativeScript] -> Identity [Proto NativeScript])
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> [Proto NativeScript] -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (NativeScript era' -> Proto NativeScript)
-> [NativeScript era'] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map NativeScript era' -> Proto NativeScript
forall era'.
AllegraEraScript era' =>
NativeScript era' -> Proto NativeScript
allegraEraScriptToUtxoRpcNativeScript (StrictSeq (NativeScript era') -> [NativeScript era']
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era')
scripts)
  L.RequireAnyOf StrictSeq (NativeScript era')
scripts ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptAny" a) =>
LensLike' f s a
U5c.scriptAny LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
-> (([Proto NativeScript] -> Identity [Proto NativeScript])
    -> Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScript
-> Identity (Proto NativeScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScriptList -> Identity (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "items" a) =>
LensLike' f s a
U5c.items (([Proto NativeScript] -> Identity [Proto NativeScript])
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> [Proto NativeScript] -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (NativeScript era' -> Proto NativeScript)
-> [NativeScript era'] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map NativeScript era' -> Proto NativeScript
forall era'.
AllegraEraScript era' =>
NativeScript era' -> Proto NativeScript
allegraEraScriptToUtxoRpcNativeScript (StrictSeq (NativeScript era') -> [NativeScript era']
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era')
scripts)
  L.RequireMOf Int
k StrictSeq (NativeScript era')
scripts -> do
    let nScriptsOf :: Proto ScriptNOfK
nScriptsOf =
          Proto ScriptNOfK
forall msg. Message msg => msg
defMessage
            Proto ScriptNOfK
-> (Proto ScriptNOfK -> Proto ScriptNOfK) -> Proto ScriptNOfK
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ScriptNOfK) Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "k" a) =>
LensLike' f s a
U5c.k LensLike' Identity (Proto ScriptNOfK) Word32
-> Word32 -> Proto ScriptNOfK -> Proto ScriptNOfK
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
            Proto ScriptNOfK
-> (Proto ScriptNOfK -> Proto ScriptNOfK) -> Proto ScriptNOfK
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ScriptNOfK) [Proto NativeScript]
forall (f :: * -> *) s a.
(Functor f, HasField s "scripts" a) =>
LensLike' f s a
U5c.scripts LensLike' Identity (Proto ScriptNOfK) [Proto NativeScript]
-> [Proto NativeScript] -> Proto ScriptNOfK -> Proto ScriptNOfK
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (NativeScript era' -> Proto NativeScript)
-> [NativeScript era'] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map NativeScript era' -> Proto NativeScript
forall era'.
AllegraEraScript era' =>
NativeScript era' -> Proto NativeScript
allegraEraScriptToUtxoRpcNativeScript (StrictSeq (NativeScript era') -> [NativeScript era']
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era')
scripts)
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto ScriptNOfK)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptNOfK" a) =>
LensLike' f s a
U5c.scriptNOfK LensLike' Identity (Proto NativeScript) (Proto ScriptNOfK)
-> Proto ScriptNOfK -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto ScriptNOfK
nScriptsOf
  L.RequireTimeExpire (SlotNo Word64
slotNo) ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "invalidHereafter" a) =>
LensLike' f s a
U5c.invalidHereafter LensLike' Identity (Proto NativeScript) Word64
-> Word64 -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
slotNo
  L.RequireTimeStart (SlotNo Word64
slotNo) ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "invalidBefore" a) =>
LensLike' f s a
U5c.invalidBefore LensLike' Identity (Proto NativeScript) Word64
-> Word64 -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
slotNo
  NativeScript era'
_ ->
    [Char] -> Proto NativeScript
forall a. HasCallStack => [Char] -> a
error
      [Char]
"allegraEraScriptToUtxoRpcNativeScript: impossible - every AllegraEraScript \
      \NativeScript constructor is matched above"

-- | Dijkstra's native script type has its own seven constructors: the six classic
-- ones plus a guard script. Upstream ships no 'COMPLETE' pragma for this set
-- (tracked as an upstream nit), so a wildcard is required even though it is
-- unreachable.
dijkstraNativeScriptToUtxoRpcNativeScript
  :: L.DijkstraEraScript era'
  => L.NativeScript era'
  -> Proto UtxoRpc.NativeScript
dijkstraNativeScriptToUtxoRpcNativeScript :: forall era'.
DijkstraEraScript era' =>
NativeScript era' -> Proto NativeScript
dijkstraNativeScriptToUtxoRpcNativeScript = \case
  L.RequireSignature KeyHash Witness
keyHash ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptPubkeyHash" a) =>
LensLike' f s a
U5c.scriptPubkeyHash LensLike' Identity (Proto NativeScript) ByteString
-> ByteString -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
L.hashToBytes (KeyHash Witness -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall (r :: KeyRole).
KeyHash r -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
L.unKeyHash KeyHash Witness
keyHash)
  L.RequireAllOf StrictSeq (NativeScript era')
scripts ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage
      Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptAll" a) =>
LensLike' f s a
U5c.scriptAll LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
-> (([Proto NativeScript] -> Identity [Proto NativeScript])
    -> Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScript
-> Identity (Proto NativeScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScriptList -> Identity (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "items" a) =>
LensLike' f s a
U5c.items (([Proto NativeScript] -> Identity [Proto NativeScript])
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> [Proto NativeScript] -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (NativeScript era' -> Proto NativeScript)
-> [NativeScript era'] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map NativeScript era' -> Proto NativeScript
forall era'.
DijkstraEraScript era' =>
NativeScript era' -> Proto NativeScript
dijkstraNativeScriptToUtxoRpcNativeScript (StrictSeq (NativeScript era') -> [NativeScript era']
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era')
scripts)
  L.RequireAnyOf StrictSeq (NativeScript era')
scripts ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage
      Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptAny" a) =>
LensLike' f s a
U5c.scriptAny LensLike' Identity (Proto NativeScript) (Proto NativeScriptList)
-> (([Proto NativeScript] -> Identity [Proto NativeScript])
    -> Proto NativeScriptList -> Identity (Proto NativeScriptList))
-> ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScript
-> Identity (Proto NativeScript)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Proto NativeScript] -> Identity [Proto NativeScript])
-> Proto NativeScriptList -> Identity (Proto NativeScriptList)
forall (f :: * -> *) s a.
(Functor f, HasField s "items" a) =>
LensLike' f s a
U5c.items (([Proto NativeScript] -> Identity [Proto NativeScript])
 -> Proto NativeScript -> Identity (Proto NativeScript))
-> [Proto NativeScript] -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (NativeScript era' -> Proto NativeScript)
-> [NativeScript era'] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map NativeScript era' -> Proto NativeScript
forall era'.
DijkstraEraScript era' =>
NativeScript era' -> Proto NativeScript
dijkstraNativeScriptToUtxoRpcNativeScript (StrictSeq (NativeScript era') -> [NativeScript era']
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era')
scripts)
  L.RequireMOf Int
k StrictSeq (NativeScript era')
scripts -> do
    let nScriptsOf :: Proto ScriptNOfK
nScriptsOf =
          Proto ScriptNOfK
forall msg. Message msg => msg
defMessage
            Proto ScriptNOfK
-> (Proto ScriptNOfK -> Proto ScriptNOfK) -> Proto ScriptNOfK
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ScriptNOfK) Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "k" a) =>
LensLike' f s a
U5c.k LensLike' Identity (Proto ScriptNOfK) Word32
-> Word32 -> Proto ScriptNOfK -> Proto ScriptNOfK
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
            Proto ScriptNOfK
-> (Proto ScriptNOfK -> Proto ScriptNOfK) -> Proto ScriptNOfK
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto ScriptNOfK) [Proto NativeScript]
forall (f :: * -> *) s a.
(Functor f, HasField s "scripts" a) =>
LensLike' f s a
U5c.scripts LensLike' Identity (Proto ScriptNOfK) [Proto NativeScript]
-> [Proto NativeScript] -> Proto ScriptNOfK -> Proto ScriptNOfK
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (NativeScript era' -> Proto NativeScript)
-> [NativeScript era'] -> [Proto NativeScript]
forall a b. (a -> b) -> [a] -> [b]
map NativeScript era' -> Proto NativeScript
forall era'.
DijkstraEraScript era' =>
NativeScript era' -> Proto NativeScript
dijkstraNativeScriptToUtxoRpcNativeScript (StrictSeq (NativeScript era') -> [NativeScript era']
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (NativeScript era')
scripts)
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) (Proto ScriptNOfK)
forall (f :: * -> *) s a.
(Functor f, HasField s "scriptNOfK" a) =>
LensLike' f s a
U5c.scriptNOfK LensLike' Identity (Proto NativeScript) (Proto ScriptNOfK)
-> Proto ScriptNOfK -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proto ScriptNOfK
nScriptsOf
  L.RequireTimeExpire (SlotNo Word64
slotNo) ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "invalidHereafter" a) =>
LensLike' f s a
U5c.invalidHereafter LensLike' Identity (Proto NativeScript) Word64
-> Word64 -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
slotNo
  L.RequireTimeStart (SlotNo Word64
slotNo) ->
    Proto NativeScript
forall msg. Message msg => msg
defMessage Proto NativeScript
-> (Proto NativeScript -> Proto NativeScript) -> Proto NativeScript
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto NativeScript) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "invalidBefore" a) =>
LensLike' f s a
U5c.invalidBefore LensLike' Identity (Proto NativeScript) Word64
-> Word64 -> Proto NativeScript -> Proto NativeScript
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64
slotNo
  L.RequireGuard Credential Guard
_credential ->
    -- utxorpc has no guard-script variant yet (tracked as
    -- https://github.com/IntersectMBO/cardano-api/issues/1263); emit the empty
    -- message rather than omitting the script, to keep script-list positions stable.
    Proto NativeScript
forall msg. Message msg => msg
defMessage
  NativeScript era'
_ ->
    [Char] -> Proto NativeScript
forall a. HasCallStack => [Char] -> a
error
      [Char]
"dijkstraNativeScriptToUtxoRpcNativeScript: impossible - every DijkstraEraScript \
      \NativeScript constructor is matched above"