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

module Cardano.Rpc.Server.Internal.UtxoRpc.Type.Script
  ( simpleScriptToUtxoRpcNativeScript
  , utxoRpcNativeScriptToSimpleScript
  , referenceScriptToUtxoRpcScript
  , utxoRpcScriptToReferenceScript
  )
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.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 RIO

import Data.ProtoLens (defMessage)
import Network.GRPC.Spec

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)) =
  case Script lang
script of
    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