{-# LANGUAGE OverloadedStrings #-}

module PlutusLedgerApi.Envelope (
  compiledCodeEnvelope,
  compiledCodeEnvelopeForVersion,
  writeCodeEnvelope,
  writeCodeEnvelopeForVersion,
) where

import Data.Aeson ((.=))
import Data.Aeson qualified as Json
import Data.Aeson.Encode.Pretty qualified as Json
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Lazy qualified as LBS
import Data.ByteString.Short qualified as BS
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import PlutusLedgerApi.Common.SerialisedScript (serialiseCompiledCode)
import PlutusLedgerApi.Common.Versions (PlutusLedgerLanguage (..))
import PlutusTx.Code (CompiledCode)

{-| Produce a JSON envelope containing 'CompiledCode' serialised with
CBOR and encoded in Base 16 (aka. HEX), using PlutusV3 by default.

"Envelope" is a JSON object with the following fields:
@
{
  "type": "PlutusScriptV3",
  "description": "A description of the code",
  "cborHex": "..."
}
@
-}
compiledCodeEnvelope
  :: Text
  -- ^ Description of the code
  -> CompiledCode a
  -- ^ Compiled code to wrap in the envelope
  -> Json.Value
  -- ^ JSON envelope
compiledCodeEnvelope :: forall a. Text -> CompiledCode a -> Value
compiledCodeEnvelope = PlutusLedgerLanguage -> Text -> CompiledCode a -> Value
forall a. PlutusLedgerLanguage -> Text -> CompiledCode a -> Value
compiledCodeEnvelopeForVersion PlutusLedgerLanguage
PlutusV3

{-| Produce a JSON envelope containing 'CompiledCode' serialised with
CBOR and encoded in Base 16 (aka. HEX).

"Envelope" is a JSON object with the following fields:
@
{
  "type": "PlutusScriptV2",
  "description": "A description of the code",
  "cborHex": "..."
}
@
-}
compiledCodeEnvelopeForVersion
  :: PlutusLedgerLanguage
  -- ^ Language of the compiled code, e.g. 'PlutusLedgerLanguage.PlutusV3'
  -> Text
  -- ^ Description of the code
  -> CompiledCode a
  -- ^ Compiled code to wrap in the envelope
  -> Json.Value
  -- ^ JSON envelope
compiledCodeEnvelopeForVersion :: forall a. PlutusLedgerLanguage -> Text -> CompiledCode a -> Value
compiledCodeEnvelopeForVersion PlutusLedgerLanguage
lang Text
desc CompiledCode a
code =
  [Pair] -> Value
Json.object
    [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
typ
    , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
desc
    , Key
"cborHex" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
hex
    ]
 where
  Text
typ :: Text =
    case PlutusLedgerLanguage
lang of
      PlutusLedgerLanguage
PlutusV1 -> Text
"PlutusScriptV1"
      PlutusLedgerLanguage
PlutusV2 -> Text
"PlutusScriptV2"
      PlutusLedgerLanguage
PlutusV3 -> Text
"PlutusScriptV3"

  hex :: Text
hex = ByteString -> Text
decodeUtf8 (ByteString -> ByteString
Base16.encode (ShortByteString -> ByteString
BS.fromShort (CompiledCode a -> ShortByteString
forall a. CompiledCode a -> ShortByteString
serialiseCompiledCode CompiledCode a
code)))

{-|
Write a JSON envelope containing 'CompiledCode' serialised with
CBOR and encoded in Base 16 (aka. HEX) to a file on disk, using PlutusV3 by default.

"Envelope" is a JSON object with the following fields:
@
{
  "type": "PlutusScriptV3",
  "description": "A description of the code",
  "cborHex": "..."
}
@
-}
writeCodeEnvelope
  :: Text
  -- ^ Description of the code
  -> CompiledCode a
  -- ^ Compiled code to wrap in the envelope
  -> FilePath
  -- ^ File path to write the envelope to
  -> IO ()
writeCodeEnvelope :: forall a. Text -> CompiledCode a -> FilePath -> IO ()
writeCodeEnvelope = PlutusLedgerLanguage -> Text -> CompiledCode a -> FilePath -> IO ()
forall a.
PlutusLedgerLanguage -> Text -> CompiledCode a -> FilePath -> IO ()
writeCodeEnvelopeForVersion PlutusLedgerLanguage
PlutusV3

{-|
Write a JSON envelope containing 'CompiledCode' serialised with
CBOR and encoded in Base 16 (aka. HEX) to a file on disk.

"Envelope" is a JSON object with the following fields:
@
{
  "type": "PlutusScriptV2",
  "description": "A description of the code",
  "cborHex": "..."
}
@
-}
writeCodeEnvelopeForVersion
  :: PlutusLedgerLanguage
  -- ^ Language of the compiled code, e.g. 'PlutusLedgerLanguage.PlutusV3'
  -> Text
  -- ^ Description of the code
  -> CompiledCode a
  -- ^ Compiled code to wrap in the envelope
  -> FilePath
  -- ^ File path to write the envelope to
  -> IO ()
writeCodeEnvelopeForVersion :: forall a.
PlutusLedgerLanguage -> Text -> CompiledCode a -> FilePath -> IO ()
writeCodeEnvelopeForVersion PlutusLedgerLanguage
lang Text
desc CompiledCode a
code FilePath
path = do
  let envelope :: Value
envelope = PlutusLedgerLanguage -> Text -> CompiledCode a -> Value
forall a. PlutusLedgerLanguage -> Text -> CompiledCode a -> Value
compiledCodeEnvelopeForVersion PlutusLedgerLanguage
lang Text
desc CompiledCode a
code
      -- aeson-pretty doesn't add a newline at the end, so we add it manually
      envelopePretty :: ByteString
envelopePretty = Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Json.encodePretty' Config
config Value
envelope ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
  FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
path ByteString
envelopePretty
 where
  config :: Config
config =
    Config
Json.defConfig
      { Json.confCompare =
          Json.keyOrder ["type", "description", "cborHex"]
      }