{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Core.HuddleSpec where

import Cardano.Ledger.BaseTypes (getVersion)
import Cardano.Ledger.Core (ByronEra, eraProtVerHigh, eraProtVerLow)
import Cardano.Ledger.Huddle
import Codec.CBOR.Cuddle.CDDL (Name (..))
import Codec.CBOR.Cuddle.CDDL.CBORGenerator (WrappedTerm (..))
import Codec.CBOR.Cuddle.Huddle
import Codec.CBOR.Term (Term (..))
import Data.Bits (Bits (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.MemPack (VarLen (..), packByteString)
import Data.Proxy (Proxy (..))
import qualified Data.Text as T
import Data.Word (Word16, Word32, Word64)
import Test.QuickCheck (Arbitrary (..), Gen, choose, oneof, vectorOf)
import Text.Heredoc
import Prelude hiding ((/))

genByteString :: Int -> Gen ByteString
genByteString :: Int -> Gen ByteString
genByteString Int
n = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

instance Era era => HuddleRule "hash28" era where
  huddleRuleNamed :: Proxy "hash28" -> Proxy era -> Rule
huddleRuleNamed Proxy "hash28"
pname Proxy era
_ = Proxy "hash28"
pname Proxy "hash28" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
28 :: Word64)

instance Era era => HuddleRule "hash32" era where
  huddleRuleNamed :: Proxy "hash32" -> Proxy era -> Rule
huddleRuleNamed Proxy "hash32"
pname Proxy era
_ = Proxy "hash32"
pname Proxy "hash32" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
32 :: Word64)

instance Era era => HuddleRule "max_word64" era where
  huddleRuleNamed :: Proxy "max_word64" -> Proxy era -> Rule
huddleRuleNamed Proxy "max_word64"
pname Proxy era
_ = Proxy "max_word64"
pname Proxy "max_word64" -> Integer -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= (Integer
18446744073709551615 :: Integer)

instance Era era => HuddleRule "positive_int" era where
  huddleRuleNamed :: Proxy "positive_int" -> Proxy era -> Rule
huddleRuleNamed Proxy "positive_int"
pname Proxy era
p = Proxy "positive_int"
pname Proxy "positive_int" -> Ranged -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= (Integer
1 :: Integer) Integer -> Rule -> Ranged
forall a b. (IsRangeBound a, IsRangeBound b) => a -> b -> Ranged
... forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"max_word64" Proxy era
p

instance Era era => HuddleRule "max_word32" era where
  huddleRuleNamed :: Proxy "max_word32" -> Proxy era -> Rule
huddleRuleNamed Proxy "max_word32"
pname Proxy era
_ = Proxy "max_word32"
pname Proxy "max_word32" -> Integer -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= (Integer
4294967295 :: Integer)

instance Era era => HuddleRule "positive_word32" era where
  huddleRuleNamed :: Proxy "positive_word32" -> Proxy era -> Rule
huddleRuleNamed Proxy "positive_word32"
pname Proxy era
p = Proxy "positive_word32"
pname Proxy "positive_word32" -> Ranged -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= (Integer
1 :: Integer) Integer -> Rule -> Ranged
forall a b. (IsRangeBound a, IsRangeBound b) => a -> b -> Ranged
... forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"max_word32" Proxy era
p

instance Era era => HuddleRule "unit_interval" era where
  huddleRuleNamed :: Proxy "unit_interval" -> Proxy era -> Rule
huddleRuleNamed Proxy "unit_interval"
pname Proxy era
_ =
    Comment -> Rule -> Rule
forall a. HasComment a => Comment -> a -> a
comment
      Comment
[str|A unit interval is a number in the range between 0 and 1, which
          |means there are two extra constraints:
          |  1. numerator <= denominator
          |  2. denominator > 0
          |
          |The relation between numerator and denominator can be
          |expressed in CDDL, but we have a limitation currently
          |(see: https://github.com/input-output-hk/cuddle/issues/30)
          |which poses a problem for testing. We need to be able to
          |generate random valid data for testing implementation of
          |our encoders/decoders. Which means we cannot use the actual
          |definition here and we hard code the value to 1/2
          |]
      (Rule -> Rule) -> (Rule -> Rule) -> Rule -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CTreeRoot GenPhase -> Gen WrappedTerm) -> Rule -> Rule
forall a.
HasGenerator a =>
(CTreeRoot GenPhase -> Gen WrappedTerm) -> a -> a
withGenerator (Gen WrappedTerm -> CTreeRoot GenPhase -> Gen WrappedTerm
forall a b. a -> b -> a
const Gen WrappedTerm
generator)
      (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Proxy "unit_interval"
pname Proxy "unit_interval" -> Tagged ArrayChoice -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
30 (ArrayChoice -> ArrayChoice
arr [Value Int -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Value Int
VUInt, Value Int -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Value Int
VUInt])
    where
      generator :: Gen WrappedTerm
generator = do
        let genUnitInterval64 :: b -> b -> Gen (b, b)
genUnitInterval64 b
l b
u = do
              d <- (b, b) -> Gen b
forall a. Random a => (a, a) -> Gen a
choose (b -> b -> b
forall a. Ord a => a -> a -> a
max b
1 b
l, b
u)
              n <- choose (l, d)
              pure (n, d)
            max64 :: Integer
max64 = Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound @Word64)
        (n, d) <-
          [Gen (Integer, Integer)] -> Gen (Integer, Integer)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
            [ Integer -> Integer -> Gen (Integer, Integer)
forall {b}. (Random b, Ord b, Num b) => b -> b -> Gen (b, b)
genUnitInterval64 Integer
0 Integer
max64
            , Integer -> Integer -> Gen (Integer, Integer)
forall {b}. (Random b, Ord b, Num b) => b -> b -> Gen (b, b)
genUnitInterval64 Integer
0 Integer
1000
            , Integer -> Integer -> Gen (Integer, Integer)
forall {b}. (Random b, Ord b, Num b) => b -> b -> Gen (b, b)
genUnitInterval64 (Integer
max64 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1000) Integer
max64
            ]
        S . TTagged 30
          <$> genArrayTerm [TInteger $ toInteger n, TInteger $ toInteger d]

instance Era era => HuddleRule "nonnegative_interval" era where
  huddleRuleNamed :: Proxy "nonnegative_interval" -> Proxy era -> Rule
huddleRuleNamed Proxy "nonnegative_interval"
pname Proxy era
p =
    Proxy "nonnegative_interval"
pname Proxy "nonnegative_interval" -> Tagged ArrayChoice -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Word64 -> ArrayChoice -> Tagged ArrayChoice
forall a. Word64 -> a -> Tagged a
tag Word64
30 (ArrayChoice -> ArrayChoice
arr [Value Int -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Value Int
VUInt, Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"positive_int" Proxy era
p)])

distinct :: IsSizeable s => Value s -> HuddleItem
distinct :: forall s. IsSizeable s => Value s -> HuddleItem
distinct Value s
x =
  Rule -> HuddleItem
HIRule
    (Rule -> HuddleItem) -> Rule -> HuddleItem
forall a b. (a -> b) -> a -> b
$ Comment -> Rule -> Rule
forall a. HasComment a => Comment -> a -> a
comment
      Comment
[str|A type for distinct values.
          |The type parameter must support .size, for example: bytes or uint
          |]
    (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Name
"distinct_"
      Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Text -> Name
Name (Value s -> Text
forall s. Value s -> Text
show' Value s
x)
        Name -> Choice Type2 -> Rule
forall a. IsType0 a => Name -> a -> Rule
=:= (Value s
x Value s -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
8 :: Word64))
        Constrained -> Constrained -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ (Value s
x Value s -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
16 :: Word64))
        Choice Type2 -> Constrained -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ (Value s
x Value s -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
20 :: Word64))
        Choice Type2 -> Constrained -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ (Value s
x Value s -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
24 :: Word64))
        Choice Type2 -> Constrained -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ (Value s
x Value s -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
30 :: Word64))
        Choice Type2 -> Constrained -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ (Value s
x Value s -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
32 :: Word64))
  where
    show' :: Value s -> T.Text
    show' :: forall s. Value s -> Text
show' = \case
      Value s
VBytes -> String -> Text
T.pack String
"bytes"
      Value s
VUInt -> String -> Text
T.pack String
"uint"
      Value s
_ -> String -> Text
forall a. HasCallStack => String -> a
error String
"Unsupported Value for `distinct`"

instance Era era => HuddleRule "nonce" era where
  huddleRuleNamed :: Proxy "nonce" -> Proxy era -> Rule
huddleRuleNamed Proxy "nonce"
pname Proxy era
p = Proxy "nonce"
pname Proxy "nonce" -> Choice ArrayChoice -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= ArrayChoice -> ArrayChoice
arr [Item ArrayChoice
ArrayEntry
0] ArrayChoice -> ArrayChoice -> Choice ArrayChoice
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Item ArrayChoice
ArrayEntry
1, Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"hash32" Proxy era
p)]

instance Era era => HuddleRule "epoch" era where
  huddleRuleNamed :: Proxy "epoch" -> Proxy era -> Rule
huddleRuleNamed Proxy "epoch"
pname Proxy era
_ = Proxy "epoch"
pname Proxy "epoch" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value Int
VUInt Value Int -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
8 :: Word64)

instance Era era => HuddleRule "epoch_interval" era where
  huddleRuleNamed :: Proxy "epoch_interval" -> Proxy era -> Rule
huddleRuleNamed Proxy "epoch_interval"
pname Proxy era
_ = Proxy "epoch_interval"
pname Proxy "epoch_interval" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value Int
VUInt Value Int -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
4 :: Word64)

instance Era era => HuddleRule "slot" era where
  huddleRuleNamed :: Proxy "slot" -> Proxy era -> Rule
huddleRuleNamed Proxy "slot"
pname Proxy era
_ = Proxy "slot"
pname Proxy "slot" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value Int
VUInt Value Int -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
8 :: Word64)

instance Era era => HuddleRule "block_number" era where
  huddleRuleNamed :: Proxy "block_number" -> Proxy era -> Rule
huddleRuleNamed Proxy "block_number"
pname Proxy era
_ = Proxy "block_number"
pname Proxy "block_number" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value Int
VUInt Value Int -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
8 :: Word64)

instance Era era => HuddleRule "addr_keyhash" era where
  huddleRuleNamed :: Proxy "addr_keyhash" -> Proxy era -> Rule
huddleRuleNamed Proxy "addr_keyhash"
pname Proxy era
p = Proxy "addr_keyhash"
pname Proxy "addr_keyhash" -> Rule -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"hash28" Proxy era
p

instance Era era => HuddleRule "pool_keyhash" era where
  huddleRuleNamed :: Proxy "pool_keyhash" -> Proxy era -> Rule
huddleRuleNamed Proxy "pool_keyhash"
pname Proxy era
p = Proxy "pool_keyhash"
pname Proxy "pool_keyhash" -> Rule -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"hash28" Proxy era
p

instance Era era => HuddleRule "vrf_keyhash" era where
  huddleRuleNamed :: Proxy "vrf_keyhash" -> Proxy era -> Rule
huddleRuleNamed Proxy "vrf_keyhash"
pname Proxy era
p = Proxy "vrf_keyhash"
pname Proxy "vrf_keyhash" -> Rule -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"hash32" Proxy era
p

instance Era era => HuddleRule "vkey" era where
  huddleRuleNamed :: Proxy "vkey" -> Proxy era -> Rule
huddleRuleNamed Proxy "vkey"
pname Proxy era
_ = Proxy "vkey"
pname Proxy "vkey" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
32 :: Word64)

instance Era era => HuddleRule "vrf_vkey" era where
  huddleRuleNamed :: Proxy "vrf_vkey" -> Proxy era -> Rule
huddleRuleNamed Proxy "vrf_vkey"
pname Proxy era
_ = Proxy "vrf_vkey"
pname Proxy "vrf_vkey" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
32 :: Word64)

instance Era era => HuddleRule "vrf_cert" era where
  huddleRuleNamed :: Proxy "vrf_cert" -> Proxy era -> Rule
huddleRuleNamed Proxy "vrf_cert"
pname Proxy era
_ = Proxy "vrf_cert"
pname Proxy "vrf_cert" -> ArrayChoice -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= ArrayChoice -> ArrayChoice
arr [Value ByteString -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a Value ByteString
VBytes, Constrained -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
80 :: Word64))]

instance Era era => HuddleRule "kes_vkey" era where
  huddleRuleNamed :: Proxy "kes_vkey" -> Proxy era -> Rule
huddleRuleNamed Proxy "kes_vkey"
pname Proxy era
_ = Proxy "kes_vkey"
pname Proxy "kes_vkey" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
32 :: Word64)

instance Era era => HuddleRule "kes_signature" era where
  huddleRuleNamed :: Proxy "kes_signature" -> Proxy era -> Rule
huddleRuleNamed Proxy "kes_signature"
pname Proxy era
_ = Proxy "kes_signature"
pname Proxy "kes_signature" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
448 :: Word64)

instance Era era => HuddleRule "signkey_kes" era where
  huddleRuleNamed :: Proxy "signkey_kes" -> Proxy era -> Rule
huddleRuleNamed Proxy "signkey_kes"
pname Proxy era
_ = Proxy "signkey_kes"
pname Proxy "signkey_kes" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
64 :: Word64)

instance Era era => HuddleRule "sequence_number" era where
  huddleRuleNamed :: Proxy "sequence_number" -> Proxy era -> Rule
huddleRuleNamed Proxy "sequence_number"
pname Proxy era
_ = Proxy "sequence_number"
pname Proxy "sequence_number" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value Int
VUInt Value Int -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
8 :: Word64)

instance Era era => HuddleRule "kes_period" era where
  huddleRuleNamed :: Proxy "kes_period" -> Proxy era -> Rule
huddleRuleNamed Proxy "kes_period"
pname Proxy era
_ = Proxy "kes_period"
pname Proxy "kes_period" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value Int
VUInt Value Int -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
8 :: Word64)

instance Era era => HuddleRule "signature" era where
  huddleRuleNamed :: Proxy "signature" -> Proxy era -> Rule
huddleRuleNamed Proxy "signature"
pname Proxy era
_ = Proxy "signature"
pname Proxy "signature" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
64 :: Word64)

instance Era era => HuddleRule "coin" era where
  huddleRuleNamed :: Proxy "coin" -> Proxy era -> Rule
huddleRuleNamed Proxy "coin"
pname Proxy era
_ = Proxy "coin"
pname Proxy "coin" -> Value Int -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value Int
VUInt

instance Era era => HuddleRule "positive_coin" era where
  huddleRuleNamed :: Proxy "positive_coin" -> Proxy era -> Rule
huddleRuleNamed Proxy "positive_coin"
pname Proxy era
p = Proxy "positive_coin"
pname Proxy "positive_coin" -> Ranged -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= (Integer
1 :: Integer) Integer -> Rule -> Ranged
forall a b. (IsRangeBound a, IsRangeBound b) => a -> b -> Ranged
... forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"max_word64" Proxy era
p

genHash28 :: Gen ByteString
genHash28 :: Gen ByteString
genHash28 = Int -> Gen ByteString
genByteString Int
28

instance Era era => HuddleRule "address" era where
  huddleRuleNamed :: Proxy "address" -> Proxy era -> Rule
huddleRuleNamed Proxy "address"
pname Proxy era
_ =
    Comment -> Rule -> Rule
forall a. HasComment a => Comment -> a -> a
comment
      Comment
[str|address format:
          |  [ 8 bit header | payload ];
          |
          |shelley payment addresses:
          |     bit 7: 0
          |     bit 6: base/other
          |     bit 5: pointer/enterprise [for base: stake cred is keyhash/scripthash]
          |     bit 4: payment cred is keyhash/scripthash
          |  bits 3-0: network id
          |
          |reward addresses:
          |  bits 7-5: 111
          |     bit 4: credential is keyhash/scripthash
          |  bits 3-0: network id
          |
          |byron addresses:
          |  bits 7-4: 1000
          |
          |     0000: base address: keyhash28,keyhash28
          |     0001: base address: scripthash28,keyhash28
          |     0010: base address: keyhash28,scripthash28
          |     0011: base address: scripthash28,scripthash28
          |     0100: pointer address: keyhash28, 3 variable length uint
          |     0101: pointer address: scripthash28, 3 variable length uint
          |     0110: enterprise address: keyhash28
          |     0111: enterprise address: scripthash28
          |     1000: byron address
          |     1110: account address: keyhash28
          |     1111: account address: scripthash28
          |1001-1101: future formats
          |]
      (Rule -> Rule) -> (Rule -> Rule) -> Rule -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CTreeRoot GenPhase -> Gen WrappedTerm) -> Rule -> Rule
forall a.
HasGenerator a =>
(CTreeRoot GenPhase -> Gen WrappedTerm) -> a -> a
withGenerator (Gen WrappedTerm -> CTreeRoot GenPhase -> Gen WrappedTerm
forall a b. a -> b -> a
const Gen WrappedTerm
generator)
      (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Proxy "address"
pname Proxy "address" -> Value ByteString -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes
    where
      generator :: Gen WrappedTerm
generator = do
        stakeRef <- (Word8, Word8) -> Gen Word8
forall a. Random a => (a, a) -> Gen a
choose (Word8
0, Word8
0b11)
        let
          stakeRefMask = Word8
stakeRef Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
5 -- 0b0xx00000
          mkMask p
mask Bool
isMask = if Bool
isMask then p
mask else p
0
        isPaymentScriptMask <- mkMask 0b00010000 <$> arbitrary
        isMainnetMask <- mkMask 0b00000001 <$> arbitrary
        let
          header = Word8
stakeRefMask Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
isPaymentScriptMask Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
isMainnetMask
          genVar32 = Word32 -> VarLen Word32
forall a. a -> VarLen a
VarLen (Word32 -> VarLen Word32) -> Gen Word32 -> Gen (VarLen Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Word32
          genVar16 = Word16 -> VarLen Word16
forall a. a -> VarLen a
VarLen (Word16 -> VarLen Word16) -> Gen Word16 -> Gen (VarLen Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Word16
        stakeCred <- case stakeRef of
          Word8
0b00 -> Gen ByteString
genHash28 -- staking payment hash
          Word8
0b01 -> Gen ByteString
genHash28 -- staking script hash
          Word8
0b10 -> do
            -- Ptr
            slotNo <- Gen (VarLen Word32)
genVar32
            txIx <- genVar16
            certIx <- genVar16
            pure $ packByteString slotNo <> packByteString txIx <> packByteString certIx
          Word8
_ -> ByteString -> Gen ByteString
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
forall a. Monoid a => a
mempty
        paymentCred <- genHash28
        -- TODO use genBytesTerm once indefinite bytestring decoding has been fixed
        let bytesTerm = ByteString -> Term
TBytes (ByteString -> Term)
-> (ByteString -> ByteString) -> ByteString -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> ByteString
BS.cons Word8
header (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ ByteString
paymentCred ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
stakeCred
        pure $ S bytesTerm

instance Era era => HuddleRule "reward_account" era where
  huddleRuleNamed :: Proxy "reward_account" -> Proxy era -> Rule
huddleRuleNamed Proxy "reward_account"
pname Proxy era
_ = (CTreeRoot GenPhase -> Gen WrappedTerm) -> Rule -> Rule
forall a.
HasGenerator a =>
(CTreeRoot GenPhase -> Gen WrappedTerm) -> a -> a
withGenerator (Gen WrappedTerm -> CTreeRoot GenPhase -> Gen WrappedTerm
forall a b. a -> b -> a
const Gen WrappedTerm
generator) (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Proxy "reward_account"
pname Proxy "reward_account" -> Value ByteString -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes
    where
      generator :: Gen WrappedTerm
generator = do
        isMainnet <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
        isScript <- arbitrary
        let
          mainnetMask | Bool
isMainnet = Word8
0b00000001 | Bool
otherwise = Word8
0x00
          scriptMask | Bool
isScript = Word8
0b00010000 | Bool
otherwise = Word8
0x00
          header = Word8
0b11100000 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
mainnetMask Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
scriptMask
        payload <- genHash28
        let term = ByteString -> Term
TBytes (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ByteString
BS.cons Word8
header ByteString
payload
        pure $ S term

instance Era era => HuddleRule "transaction_index" era where
  huddleRuleNamed :: Proxy "transaction_index" -> Proxy era -> Rule
huddleRuleNamed Proxy "transaction_index"
pname Proxy era
_ = Proxy "transaction_index"
pname Proxy "transaction_index" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value Int
VUInt Value Int -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
2 :: Word64)

instance Era era => HuddleRule "metadatum_label" era where
  huddleRuleNamed :: Proxy "metadatum_label" -> Proxy era -> Rule
huddleRuleNamed Proxy "metadatum_label"
pname Proxy era
_ = Proxy "metadatum_label"
pname Proxy "metadatum_label" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value Int
VUInt Value Int -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
8 :: Word64)

instance Era era => HuddleRule "metadatum" era where
  huddleRuleNamed :: Proxy "metadatum" -> Proxy era -> Rule
huddleRuleNamed Proxy "metadatum"
pname Proxy era
p =
    Proxy "metadatum"
pname
      Proxy "metadatum" -> Choice Type2 -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= MapChoice -> Seal Map
smp
        [ Word64
0 Word64 -> MapEntry -> MapEntry
forall a. CanQuantify a => Word64 -> a -> a
<+ Rule -> Key
forall r. IsType0 r => r -> Key
asKey (forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"metadatum" Proxy era
p) Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"metadatum" Proxy era
p
        ]
      Seal Map -> Seal (Choice ArrayChoice) -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> Seal (Choice ArrayChoice)
sarr [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 (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"metadatum" Proxy era
p)]
      Choice Type2 -> Value Int -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ Value Int
VInt
      Choice Type2 -> Constrained -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ (Value ByteString
VBytes Value ByteString -> (Word64, Word64) -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
0 :: Word64, Word64
64 :: Word64))
      Choice Type2 -> Constrained -> Choice Type2
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ (Value Text
VText Value Text -> (Word64, Word64) -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
0 :: Word64, Word64
64 :: Word64))

instance Era era => HuddleRule "metadata" era where
  huddleRuleNamed :: Proxy "metadata" -> Proxy era -> Rule
huddleRuleNamed Proxy "metadata"
pname Proxy era
p =
    Proxy "metadata"
pname
      Proxy "metadata" -> MapChoice -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> 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 (forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"metadatum_label" Proxy era
p)
            Key -> Rule -> MapEntry
forall a me. (IsType0 a, IsEntryLike me) => Key -> a -> me
==> forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"metadatum" Proxy era
p
        ]

instance Era era => HuddleRule "auxiliary_data_hash" era where
  huddleRuleNamed :: Proxy "auxiliary_data_hash" -> Proxy era -> Rule
huddleRuleNamed Proxy "auxiliary_data_hash"
pname Proxy era
p = Proxy "auxiliary_data_hash"
pname Proxy "auxiliary_data_hash" -> Rule -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"hash32" Proxy era
p

instance Era era => HuddleRule "script_hash" era where
  huddleRuleNamed :: Proxy "script_hash" -> Proxy era -> Rule
huddleRuleNamed Proxy "script_hash"
pname Proxy era
p =
    Comment -> Rule -> Rule
forall a. HasComment a => Comment -> a -> a
comment
      Comment
[str|To compute a script hash, note that you must prepend
          |a tag to the bytes of the script before hashing.
          |The tag is determined by the language.
          |The tags are:
          |  "\x00" for multisig/native scripts
          |  "\x01" for Plutus V1 scripts
          |  "\x02" for Plutus V2 scripts
          |  "\x03" for Plutus V3 scripts
          |  "\x04" for Plutus V4 scripts
          |]
      (Rule -> Rule) -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ Proxy "script_hash"
pname
        Proxy "script_hash" -> Rule -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"hash28" Proxy era
p

instance Era era => HuddleRule "credential" era where
  huddleRuleNamed :: Proxy "credential" -> Proxy era -> Rule
huddleRuleNamed Proxy "credential"
pname Proxy era
p =
    Proxy "credential"
pname
      Proxy "credential" -> Choice ArrayChoice -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= ArrayChoice -> ArrayChoice
arr [Item ArrayChoice
ArrayEntry
0, Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"addr_keyhash" Proxy era
p)]
      ArrayChoice -> ArrayChoice -> Choice ArrayChoice
forall a c b.
(IsChoosable a c, IsChoosable b c) =>
a -> b -> Choice c
/ ArrayChoice -> ArrayChoice
arr [Item ArrayChoice
ArrayEntry
1, Rule -> ArrayEntry
forall a e. (IsType0 a, IsGroupOrArrayEntry e) => a -> e
a (forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"script_hash" Proxy era
p)]

instance Era era => HuddleRule "stake_credential" era where
  huddleRuleNamed :: Proxy "stake_credential" -> Proxy era -> Rule
huddleRuleNamed Proxy "stake_credential"
pname Proxy era
p = Proxy "stake_credential"
pname Proxy "stake_credential" -> Rule -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= forall (name :: Symbol) era.
HuddleRule name era =>
Proxy era -> Rule
huddleRule @"credential" Proxy era
p

instance Era era => HuddleRule "port" era where
  huddleRuleNamed :: Proxy "port" -> Proxy era -> Rule
huddleRuleNamed Proxy "port"
pname Proxy era
_ = Proxy "port"
pname Proxy "port" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value Int
VUInt Value Int -> Word64 -> Constrained
forall a c.
(IsComparable a, IsConstrainable c a) =>
c -> Word64 -> Constrained
`le` Word64
65535

instance Era era => HuddleRule "ipv4" era where
  huddleRuleNamed :: Proxy "ipv4" -> Proxy era -> Rule
huddleRuleNamed Proxy "ipv4"
pname Proxy era
_ = Proxy "ipv4"
pname Proxy "ipv4" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
4 :: Word64)

instance Era era => HuddleRule "ipv6" era where
  huddleRuleNamed :: Proxy "ipv6" -> Proxy era -> Rule
huddleRuleNamed Proxy "ipv6"
pname Proxy era
_ = Proxy "ipv6"
pname Proxy "ipv6" -> Constrained -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= Value ByteString
VBytes Value ByteString -> Word64 -> Constrained
forall c a s.
(IsSizeable a, IsSize s, IsConstrainable c a) =>
c -> s -> Constrained
`sized` (Word64
16 :: Word64)

majorProtocolVersionRule ::
  forall era. Era era => Proxy "major_protocol_version" -> Proxy era -> Rule
majorProtocolVersionRule :: forall era.
Era era =>
Proxy "major_protocol_version" -> Proxy era -> Rule
majorProtocolVersionRule Proxy "major_protocol_version"
pname Proxy era
_ =
  Proxy "major_protocol_version"
pname
    Proxy "major_protocol_version" -> Ranged -> Rule
forall (name :: Symbol) t.
(KnownSymbol name, IsType0 t) =>
Proxy name -> t -> Rule
=.= forall i. Integral i => Version -> i
getVersion @Integer (forall era. Era era => Version
eraProtVerLow @ByronEra)
    Integer -> Integer -> Ranged
forall a b. (IsRangeBound a, IsRangeBound b) => a -> b -> Ranged
... Integer -> Integer
forall a. Enum a => a -> a
succ (forall i. Integral i => Version -> i
getVersion @Integer (forall era. Era era => Version
eraProtVerHigh @era))