{-# LANGUAGE TemplateHaskell #-}

-- | Module to load and provide the Hydra scripts.
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 PlutusLedgerApi.Common (SerialisedScript)

-- | Loads the "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

-- | Access the commit validator script from the 'blueprintJSON'.
commitValidatorScript :: SerialisedScript
commitValidatorScript :: SerialisedScript
commitValidatorScript =
  case ByteString -> Either String ByteString
Base16.decode ByteString
base16Bytes of
    Left String
e -> Text -> SerialisedScript
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> SerialisedScript) -> Text -> SerialisedScript
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode commit validator: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall b a. (Show a, IsString b) => a -> b
show String
e
    Right ByteString
bytes -> ByteString -> SerialisedScript
toShort ByteString
bytes
 where
  base16Bytes :: ByteString
base16Bytes = Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
base16Text
  -- NOTE: we are using a hardcoded index to access the commit validator.
  -- This is fragile and will raise problems when we move another plutus validator
  -- to Aiken.
  -- Reference: https://github.com/cardano-foundation/CIPs/tree/master/CIP-0057
  base16Text :: Text
base16Text = 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

-- | Access the initial validator script from the 'blueprintJSON'.
initialValidatorScript :: SerialisedScript
initialValidatorScript :: SerialisedScript
initialValidatorScript =
  case ByteString -> Either String ByteString
Base16.decode ByteString
base16Bytes of
    Left String
e -> Text -> SerialisedScript
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> SerialisedScript) -> Text -> SerialisedScript
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode initial validator: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall b a. (Show a, IsString b) => a -> b
show String
e
    Right ByteString
bytes -> ByteString -> SerialisedScript
toShort ByteString
bytes
 where
  base16Bytes :: ByteString
base16Bytes = Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
base16Text

  -- NOTE: we are using a hardcoded index to access the commit validator.
  -- This is fragile and will raise problems when we move another plutus validator
  -- to Aiken.
  -- Reference: https://github.com/cardano-foundation/CIPs/tree/master/CIP-0057
  base16Text :: Text
base16Text = 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
2 ((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