{-# LANGUAGE TemplateHaskell #-}

-- | Module to load and provide the Hydra scripts.
--
-- The plutus blueprint in 'plutus.json' is embedded in the binary and serves as
-- the ground truth for validator scripts and hashes.
--
-- NOTE: All scripts are PlutusV3 scripts (defined by the 'PlutusScript' synonym pattern).
--
-- XXX: We are using a hardcoded indices to access validators in plutus.json.
-- This is fragile and depends on the validator names not changing.
module Hydra.Plutus where

import Hydra.Prelude

import Control.Lens ((^.))
import Data.Aeson qualified as Aeson
import Data.Aeson.Lens (key, nth, _String)
import Data.ByteString.Base16 qualified as Base16
import Data.FileEmbed (embedFile, makeRelativeToProject)
import Hydra.Cardano.Api (PlutusScript, pattern PlutusScriptSerialised)

-- | Loads the embedded "plutus.json" blueprint and provides the decoded JSON.
blueprintJSON :: Aeson.Value
blueprintJSON :: Value
blueprintJSON =
  case ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decodeStrict $(makeRelativeToProject "./plutus.json" >>= embedFile) of
    Maybe Value
Nothing -> Text -> Value
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Invalid blueprint: plutus.json"
    Just Value
value -> Value
value

-- | Get the deposit validator by decoding it from 'blueprintJSON'.
depositValidatorScript :: PlutusScript
depositValidatorScript :: PlutusScript
depositValidatorScript =
  ShortByteString -> PlutusScript
PlutusScriptSerialised (ShortByteString -> PlutusScript)
-> (Text -> ShortByteString) -> Text -> PlutusScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> ShortByteString)
-> (Text -> ByteString) -> Text -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.decodeLenient (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> PlutusScript) -> Text -> PlutusScript
forall a b. (a -> b) -> a -> b
$
    Value
blueprintJSON Value -> Getting Text Value Text -> Text
forall s a. s -> Getting a s a -> a
^. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"validators" ((Value -> Const Text Value) -> Value -> Const Text Value)
-> Getting Text Value Text -> Getting Text Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Traversal' Value Value
forall t. AsValue t => Int -> Traversal' t Value
nth Int
0 ((Value -> Const Text Value) -> Value -> Const Text Value)
-> Getting Text Value Text -> Getting Text Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"compiledCode" ((Value -> Const Text Value) -> Value -> Const Text Value)
-> Getting Text Value Text -> Getting Text Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text Value Text
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String