{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Api.Experimental.Simple.Script
  ( SimpleScript (..)
  , SimpleScriptOrReferenceInput (..)
  , deserialiseSimpleScript
  , hashSimpleScript
  )
where

import Cardano.Api.Experimental.Era
import Cardano.Api.HasTypeProxy
import Cardano.Api.Ledger.Internal.Reexport qualified as L
import Cardano.Api.Serialise.Cbor
import Cardano.Api.Tx.Internal.TxIn (TxIn)

import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo
import Cardano.Ledger.Binary qualified as CBOR
import Cardano.Ledger.Core qualified as L

import Data.ByteString qualified as BS

-- | A simple script in a particular era. We leverage ledger's Cardano.Api.Experimental.ErasraScript
-- type class methods to work with the script.
data SimpleScript era where
  SimpleScript :: L.EraScript era => L.NativeScript era -> SimpleScript era

deriving instance Show (SimpleScript era)

deriving instance Eq (SimpleScript era)

instance L.Era era => HasTypeProxy (SimpleScript era) where
  data AsType (SimpleScript era) = AsSimpleScriptEra (Proxy era)
  proxyToAsType :: Proxy (SimpleScript era) -> AsType (SimpleScript era)
proxyToAsType Proxy (SimpleScript era)
_ = Proxy era -> AsType (SimpleScript era)
forall era. Proxy era -> AsType (SimpleScript era)
AsSimpleScriptEra Proxy era
forall {k} (t :: k). Proxy t
Proxy

instance
  (L.Era era, L.EraScript era)
  => SerialiseAsCBOR (SimpleScript era)
  where
  serialiseToCBOR :: SimpleScript era -> ByteString
serialiseToCBOR (SimpleScript NativeScript era
ns) = Version -> NativeScript era -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
L.serialize' (forall era. Era era => Version
L.eraProtVerHigh @era) NativeScript era
ns

  deserialiseFromCBOR :: AsType (SimpleScript era)
-> ByteString -> Either DecoderError (SimpleScript era)
deserialiseFromCBOR AsType (SimpleScript era)
_ ByteString
bs = do
    r <-
      Annotator (NativeScript era) -> FullByteString -> NativeScript era
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator
        (Annotator (NativeScript era)
 -> FullByteString -> NativeScript era)
-> Either DecoderError (Annotator (NativeScript era))
-> Either DecoderError (FullByteString -> NativeScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version
-> ByteString -> Either DecoderError (Annotator (NativeScript era))
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
CBOR.decodeFull' (forall era. Era era => Version
L.eraProtVerHigh @era) ByteString
bs
    return $ SimpleScript $ r $ CBOR.Full $ BS.fromStrict bs

-- TODO: We should also deserialize the JSON representation of simple scripts.
deserialiseSimpleScript
  :: forall era
   . L.EraScript era
  => BS.ByteString
  -> Either CBOR.DecoderError (SimpleScript era)
deserialiseSimpleScript :: forall era.
EraScript era =>
ByteString -> Either DecoderError (SimpleScript era)
deserialiseSimpleScript ByteString
bs =
  AsType (SimpleScript era)
-> ByteString -> Either DecoderError (SimpleScript era)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR (Proxy (SimpleScript era) -> AsType (SimpleScript era)
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SimpleScript era))) ByteString
bs

hashSimpleScript
  :: forall era. IsEra era => SimpleScript (LedgerEra era) -> L.ScriptHash
hashSimpleScript :: forall era. IsEra era => SimpleScript (LedgerEra era) -> ScriptHash
hashSimpleScript (SimpleScript NativeScript (LedgerEra era)
ns) =
  case forall era. IsEra era => Era era
useEra @era of
    Era era
ConwayEra -> Script ConwayEra -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
L.hashScript (Script ConwayEra -> ScriptHash) -> Script ConwayEra -> ScriptHash
forall a b. (a -> b) -> a -> b
$ NativeScript ConwayEra -> AlonzoScript ConwayEra
forall era. NativeScript era -> AlonzoScript era
Alonzo.NativeScript NativeScript ConwayEra
NativeScript (LedgerEra era)
ns
    Era era
DijkstraEra -> Script DijkstraEra -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
L.hashScript (Script DijkstraEra -> ScriptHash)
-> Script DijkstraEra -> ScriptHash
forall a b. (a -> b) -> a -> b
$ NativeScript DijkstraEra -> AlonzoScript DijkstraEra
forall era. NativeScript era -> AlonzoScript era
Alonzo.NativeScript NativeScript DijkstraEra
NativeScript (LedgerEra era)
ns

data SimpleScriptOrReferenceInput era
  = SScript (SimpleScript era)
  | SReferenceScript TxIn
  deriving (Int -> SimpleScriptOrReferenceInput era -> ShowS
[SimpleScriptOrReferenceInput era] -> ShowS
SimpleScriptOrReferenceInput era -> String
(Int -> SimpleScriptOrReferenceInput era -> ShowS)
-> (SimpleScriptOrReferenceInput era -> String)
-> ([SimpleScriptOrReferenceInput era] -> ShowS)
-> Show (SimpleScriptOrReferenceInput era)
forall era. Int -> SimpleScriptOrReferenceInput era -> ShowS
forall era. [SimpleScriptOrReferenceInput era] -> ShowS
forall era. SimpleScriptOrReferenceInput era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> SimpleScriptOrReferenceInput era -> ShowS
showsPrec :: Int -> SimpleScriptOrReferenceInput era -> ShowS
$cshow :: forall era. SimpleScriptOrReferenceInput era -> String
show :: SimpleScriptOrReferenceInput era -> String
$cshowList :: forall era. [SimpleScriptOrReferenceInput era] -> ShowS
showList :: [SimpleScriptOrReferenceInput era] -> ShowS
Show, SimpleScriptOrReferenceInput era
-> SimpleScriptOrReferenceInput era -> Bool
(SimpleScriptOrReferenceInput era
 -> SimpleScriptOrReferenceInput era -> Bool)
-> (SimpleScriptOrReferenceInput era
    -> SimpleScriptOrReferenceInput era -> Bool)
-> Eq (SimpleScriptOrReferenceInput era)
forall era.
SimpleScriptOrReferenceInput era
-> SimpleScriptOrReferenceInput era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
SimpleScriptOrReferenceInput era
-> SimpleScriptOrReferenceInput era -> Bool
== :: SimpleScriptOrReferenceInput era
-> SimpleScriptOrReferenceInput era -> Bool
$c/= :: forall era.
SimpleScriptOrReferenceInput era
-> SimpleScriptOrReferenceInput era -> Bool
/= :: SimpleScriptOrReferenceInput era
-> SimpleScriptOrReferenceInput era -> Bool
Eq)