{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns     #-}
{-| Functions for dealing with scripts and datums
-}
module Convex.Scripts(
  compiledCodeToScript,

  -- * FromData / ToData
  fromScriptData,
  toScriptData,
  toHashableScriptData,

  -- * Translating between ledger and plutus representations

) where

import           Cardano.Api                        (PlutusScript)
import qualified Cardano.Api.Shelley                as C
import           Cardano.Ledger.Alonzo.Scripts.Data (Data (..))
import           Codec.Serialise                    (serialise)
import           Data.ByteString.Lazy               (toStrict)
import           Data.ByteString.Short              (toShort)
import           Ouroboros.Consensus.Shelley.Eras   (StandardBabbage)
import           PlutusLedgerApi.Common             (serialiseCompiledCode)
import qualified PlutusLedgerApi.V1                 as PV1
import           PlutusTx.Code                      (CompiledCode)

{-| Get the 'PlutusScript' of a 'CompiledCode'
-}
compiledCodeToScript :: CompiledCode a -> PlutusScript lang
compiledCodeToScript :: forall a lang. CompiledCode a -> PlutusScript lang
compiledCodeToScript = forall lang. SerialisedScript -> PlutusScript lang
C.PlutusScriptSerialised forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SerialisedScript
toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => a -> ByteString
serialise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CompiledCode a -> SerialisedScript
serialiseCompiledCode

fromScriptData :: PV1.FromData a => C.ScriptData -> Maybe a
fromScriptData :: forall a. FromData a => ScriptData -> Maybe a
fromScriptData (ScriptData -> Data
C.toPlutusData -> Data
d) = forall a. FromData a => Data -> Maybe a
PV1.fromData Data
d

toScriptData :: PV1.ToData a => a -> C.ScriptData
toScriptData :: forall a. ToData a => a -> ScriptData
toScriptData = Data -> ScriptData
C.fromPlutusData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToData a => a -> Data
PV1.toData

toHashableScriptData :: PV1.ToData a => a -> C.HashableScriptData
toHashableScriptData :: forall a. ToData a => a -> HashableScriptData
toHashableScriptData = forall ledgerera. Data ledgerera -> HashableScriptData
C.fromAlonzoData @StandardBabbage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data -> Data era
Data forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToData a => a -> Data
PV1.toData