{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoImplicitPrelude #-}

{- HLINT ignore "Use camelCase" -}
{- HLINT ignore "Evaluate" -}

module Test.Cardano.Ledger.Allegra.CDDL (
  module Test.Cardano.Ledger.Shelley.CDDL,
  allegraCDDL,

  -- * 64-bit integers
  int64,
  nonzero_int64,

  -- * Transaction
  transaction_witness_set,

  -- * Auxiliary data
  auxiliary_data,
  auxiliary_data_array,

  -- * Native scripts
  allegra_native_script,
) where

import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Core (Era)
import Codec.CBOR.Cuddle.Huddle
import Data.Function (($))
import GHC.Num (Integer)
import Test.Cardano.Ledger.Shelley.CDDL
import Text.Heredoc

allegraCDDL :: Huddle
allegraCDDL :: Huddle
allegraCDDL =
  [HuddleItem] -> Huddle
collectFrom
    [ Rule -> HuddleItem
HIRule (Rule -> HuddleItem) -> Rule -> HuddleItem
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Rule
block @AllegraEra
    , Rule -> HuddleItem
HIRule (Rule -> HuddleItem) -> Rule -> HuddleItem
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Rule
transaction @AllegraEra
    ]

min_int64 :: Rule
min_int64 :: Rule
min_int64 = Text
"min_int64" Text -> Integer -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= (-Integer
9223372036854775808 :: Integer)

max_int64 :: Rule
max_int64 :: Rule
max_int64 = Text
"max_int64" Text -> Integer -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= (Integer
9223372036854775807 :: Integer)

negative_int64 :: Rule
negative_int64 :: Rule
negative_int64 = Text
"negative_int64" Text -> Ranged -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule
min_int64 Rule -> Integer -> Ranged
forall a b. (IsRangeBound a, IsRangeBound b) => a -> b -> Ranged
... (-Integer
1 :: Integer)

positive_int64 :: Rule
positive_int64 :: Rule
positive_int64 = Text
"positive_int64" Text -> Ranged -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= (Integer
1 :: Integer) Integer -> Rule -> Ranged
forall a b. (IsRangeBound a, IsRangeBound b) => a -> b -> Ranged
... Rule
max_int64

nonzero_int64 :: Rule
nonzero_int64 :: Rule
nonzero_int64 = Text
"nonzero_int64" Text -> Choice Type2 -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule
negative_int64 Rule -> Rule -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Rule
positive_int64

-- | 64-bit signed integers for native script timelock thresholds.
int64 :: Rule
int64 :: Rule
int64 = Text
"int64" Text -> Ranged -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule
min_int64 Rule -> Rule -> Ranged
forall a b. (IsRangeBound a, IsRangeBound b) => a -> b -> Ranged
... Rule
max_int64

allegra_native_script :: Rule
allegra_native_script :: Rule
allegra_native_script =
  Text -> Rule -> Rule
forall a. HasField' "description" a (Maybe Text) => Text -> a -> a
comment
    Text
[str|Allegra introduces timelock support for native scripts.
        |This is the 6-variant native script format used by
        |Allegra, Mary, Alonzo, Babbage, and Conway.
        |
        |Timelock validity intervals are half-open intervals [a, b).
        |  script_invalid_before: specifies the left (included) endpoint a.
        |  script_invalid_hereafter: specifies the right (excluded) endpoint b.
        |
        |Note: Allegra switched to int64 for script_n_of_k thresholds.
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"native_script"
      Text -> Choice ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
script_pubkey]
      ArrayChoice -> ArrayChoice -> Choice ArrayChoice
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
script_all]
      Choice ArrayChoice -> ArrayChoice -> Choice ArrayChoice
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
script_any]
      Choice ArrayChoice -> ArrayChoice -> Choice ArrayChoice
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
script_n_of_k]
      Choice ArrayChoice -> ArrayChoice -> Choice ArrayChoice
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
script_invalid_before]
      Choice ArrayChoice -> ArrayChoice -> Choice ArrayChoice
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Named Group -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Named Group
script_invalid_hereafter]

script_pubkey :: Named Group
script_pubkey :: Named Group
script_pubkey = Named Group
mkScriptPubkey

script_all :: Named Group
script_all :: Named Group
script_all = Rule -> Named Group
forall script. IsType0 script => script -> Named Group
mkScriptAll Rule
allegra_native_script

script_any :: Named Group
script_any :: Named Group
script_any = Rule -> Named Group
forall script. IsType0 script => script -> Named Group
mkScriptAny Rule
allegra_native_script

script_n_of_k :: Named Group
script_n_of_k :: Named Group
script_n_of_k = Rule -> Rule -> Named Group
forall threshold script.
(IsType0 threshold, IsType0 script) =>
threshold -> script -> Named Group
mkScriptNOfK Rule
int64 Rule
allegra_native_script

script_invalid_before :: Named Group
script_invalid_before :: Named Group
script_invalid_before = Named Group
mkScriptInvalidBefore

script_invalid_hereafter :: Named Group
script_invalid_hereafter :: Named Group
script_invalid_hereafter = Named Group
mkScriptInvalidHereafter

auxiliary_scripts :: Rule
auxiliary_scripts :: Rule
auxiliary_scripts = Text
"auxiliary_scripts" Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
allegra_native_script]

auxiliary_data_array :: Rule
auxiliary_data_array :: Rule
auxiliary_data_array =
  Text
"auxiliary_data_array"
    Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr
      [ Key
"transaction_metadata" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
metadata
      , Key
"auxiliary_scripts" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
auxiliary_scripts
      ]

-- | Adds auxiliary_data_array format for batching native scripts with metadata.
auxiliary_data :: Rule
auxiliary_data :: Rule
auxiliary_data =
  Text
"auxiliary_data"
    Text -> Choice Type2 -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= Rule
metadata
    Rule -> Rule -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Rule
auxiliary_data_array

-- | Adds validity interval start (index 8) for timelock script support.
transaction_body :: forall era. Era era => Rule
transaction_body :: forall era. Era era => Rule
transaction_body =
  Text -> Rule -> Rule
forall a. HasField' "description" a (Maybe Text) => Text -> a -> a
comment
    Text
[str|Allegra transaction body adds the validity interval start at index 8
        |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Text
"transaction_body"
      Text -> MapChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= MapChoice -> MapChoice
mp
        [ Word64 -> Key
idx Word64
0 Key -> GRuleCall -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule -> GRuleCall
forall a. IsType0 a => a -> GRuleCall
untagged_set Rule
transaction_input
        , Word64 -> Key
idx Word64
1 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
transaction_output]
        , Word64 -> Key
idx Word64
2 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
coin
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
3 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
slot)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
4 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
certificate])
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
5 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
withdrawals)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
6 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> forall era. Era era => Rule
update @era)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
7 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
auxiliary_data_hash)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
8 Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
slot)
        ]

block :: forall era. Era era => Rule
block :: forall era. Era era => Rule
block =
  Text
"block"
    Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr
      [ Rule -> Item ArrayChoice
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (Rule -> Item ArrayChoice) -> Rule -> Item ArrayChoice
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Rule
header @era
      , Key
"transaction_bodies" Key -> ArrayChoice -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (forall era. Era era => Rule
transaction_body @era)]
      , Key
"transaction_witness_sets" Key -> ArrayChoice -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
transaction_witness_set]
      , Key
"auxiliary_data_set" Key -> MapChoice -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> MapChoice -> MapChoice
mp [Word64
0 Word64 -> MapEntry -> MapEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> Key
forall r. IsType0 r => r -> Key
asKey Rule
transaction_index Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
auxiliary_data]
      ]

transaction :: forall era. Era era => Rule
transaction :: forall era. Era era => Rule
transaction =
  Text
"transaction"
    Text -> ArrayChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= ArrayChoice -> ArrayChoice
arr
      [ Rule -> Item ArrayChoice
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (Rule -> Item ArrayChoice) -> Rule -> Item ArrayChoice
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Rule
transaction_body @era
      , Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
transaction_witness_set
      , Choice Type2 -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (Rule
auxiliary_data Rule -> Value Void -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Value Void
VNil)
      ]

-- | Uses allegra_native_script with timelock support (invalid_before/hereafter).
transaction_witness_set :: Rule
transaction_witness_set :: Rule
transaction_witness_set =
  Text
"transaction_witness_set"
    Text -> MapChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= MapChoice -> MapChoice
mp
      [ Item MapChoice -> Item MapChoice
forall a. CanQuantify a => a -> a
opt (Item MapChoice -> Item MapChoice)
-> Item MapChoice -> Item MapChoice
forall a b. (a -> b) -> a -> b
$ Word64 -> Key
idx Word64
0 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
vkeywitness]
      , Item MapChoice -> Item MapChoice
forall a. CanQuantify a => a -> a
opt (Item MapChoice -> Item MapChoice)
-> Item MapChoice -> Item MapChoice
forall a b. (a -> b) -> a -> b
$ Word64 -> Key
idx Word64
1 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
allegra_native_script]
      , Item MapChoice -> Item MapChoice
forall a. CanQuantify a => a -> a
opt (Item MapChoice -> Item MapChoice)
-> Item MapChoice -> Item MapChoice
forall a b. (a -> b) -> a -> b
$ Word64 -> Key
idx Word64
2 Key -> ArrayChoice -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> ArrayChoice -> ArrayChoice
arr [Word64
0 Word64 -> ArrayEntry -> ArrayEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
bootstrap_witness]
      ]