{-# 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,
  module Test.Cardano.Ledger.Allegra.CDDL,
) where

import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Core (Era)
import Codec.CBOR.Cuddle.Huddle
import Data.Function (($))
import Test.Cardano.Ledger.Shelley.CDDL hiding (
  block,
  transaction,
  transaction_body,
  transaction_witness_set,
 )
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
    ]

native_script :: Rule
native_script :: Rule
native_script =
  Text -> Rule -> Rule
forall a. HasField' "description" a (Maybe Text) => Text -> a -> a
comment
    Text
[str|Timelock validity intervals are half-open intervals [a, b).
        |
        |  invalid_before:
        |    specifies the left (included) endpoint a.
        |
        |  invalid_hereafter:
        |    specifies the right (excluded) endpoint b.
        |]
    (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
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
invalid_hereafter]

script_pubkey :: Named Group
script_pubkey :: Named Group
script_pubkey = Text
"script_pubkey" Text -> Group -> Named Group
=:~ Group -> Group
grp [Item Group
ArrayEntry
0, Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Rule
addr_keyhash]

script_all :: Named Group
script_all :: Named Group
script_all = Text
"script_all" Text -> Group -> Named Group
=:~ Group -> Group
grp [Item Group
ArrayEntry
1, ArrayChoice -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (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
native_script])]

script_any :: Named Group
script_any :: Named Group
script_any = Text
"script_any" Text -> Group -> Named Group
=:~ Group -> Group
grp [Item Group
ArrayEntry
2, ArrayChoice -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (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
native_script])]

script_n_of_k :: Named Group
script_n_of_k :: Named Group
script_n_of_k = Text
"script_n_of_k" Text -> Group -> Named Group
=:~ Group -> Group
grp [Item Group
ArrayEntry
3, Key
"n" Key -> Rule -> ArrayEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
int64, ArrayChoice -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (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
native_script])]

invalid_before :: Named Group
invalid_before :: Named Group
invalid_before = Text
"invalid_before" Text -> Group -> Named Group
=:~ Group -> Group
grp [Item Group
ArrayEntry
4, Value Int -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Value Int
VUInt]

invalid_hereafter :: Named Group
invalid_hereafter :: Named Group
invalid_hereafter = Text
"invalid_hereafter" Text -> Group -> Named Group
=:~ Group -> Group
grp [Item Group
ArrayEntry
5, Value Int -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Value Int
VUInt]

metadata :: Rule
metadata :: Rule
metadata = Text
"metadata" Text -> MapChoice -> Rule
forall a. IsType0 a => Text -> a -> Rule
=:= 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_metadatum_label Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Rule
transaction_metadatum]

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
native_script]

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 -> Seal (Choice ArrayChoice) -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> Seal (Choice ArrayChoice)
sarr
      [ 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
      ]

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 t0. IsType0 t0 => t0 -> GRuleCall
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 -> Value Int -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt)
        , 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
metadata_hash)
        , MapEntry -> MapEntry
forall a. CanQuantify a => a -> a
opt (Word64 -> Key
idx Word64
8 Key -> Value Int -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> Value Int
VUInt)
        ]

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)
      ]

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
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]
      ]