{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Allegra.Binary.Annotator (
  module Test.Cardano.Ledger.Shelley.Binary.Annotator,
) where

import Cardano.Ledger.Allegra (AllegraEra, Tx (..))
import Cardano.Ledger.Allegra.Scripts
import Cardano.Ledger.Allegra.TxAuxData
import Cardano.Ledger.Allegra.TxBody
import Cardano.Ledger.Binary
import Cardano.Ledger.Core
import Cardano.Ledger.MemoBytes (decodeMemoized)
import qualified Data.Sequence.Strict as StrictSeq
import Test.Cardano.Ledger.Allegra.Arbitrary ()
import Test.Cardano.Ledger.Shelley.Binary.Annotator

deriving newtype instance DecCBOR (TxBody TopTx AllegraEra)

instance
  ( Era era
  , AllegraEraScript era
  , DecCBOR (NativeScript era)
  ) =>
  DecCBOR (AllegraTxAuxDataRaw era)
  where
  decCBOR :: forall s. Decoder s (AllegraTxAuxDataRaw era)
decCBOR =
    Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s (AllegraTxAuxDataRaw era))
-> Decoder s (AllegraTxAuxDataRaw era)
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      TokenType
TypeMapLen -> Decoder s (AllegraTxAuxDataRaw era)
forall {s} {era}. Decoder s (AllegraTxAuxDataRaw era)
decodeFromMap
      TokenType
TypeMapLen64 -> Decoder s (AllegraTxAuxDataRaw era)
forall {s} {era}. Decoder s (AllegraTxAuxDataRaw era)
decodeFromMap
      TokenType
TypeMapLenIndef -> Decoder s (AllegraTxAuxDataRaw era)
forall {s} {era}. Decoder s (AllegraTxAuxDataRaw era)
decodeFromMap
      TokenType
TypeListLen -> Decoder s (AllegraTxAuxDataRaw era)
forall s. Decoder s (AllegraTxAuxDataRaw era)
decodeFromList
      TokenType
TypeListLen64 -> Decoder s (AllegraTxAuxDataRaw era)
forall s. Decoder s (AllegraTxAuxDataRaw era)
decodeFromList
      TokenType
TypeListLenIndef -> Decoder s (AllegraTxAuxDataRaw era)
forall s. Decoder s (AllegraTxAuxDataRaw era)
decodeFromList
      TokenType
_ -> String -> Decoder s (AllegraTxAuxDataRaw era)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to decode AuxiliaryDataRaw"
    where
      decodeFromMap :: Decoder s (AllegraTxAuxDataRaw era)
decodeFromMap = do
        metadata <- Decoder s (Map Word64 Metadatum)
forall s. Decoder s (Map Word64 Metadatum)
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure $ AllegraTxAuxDataRaw metadata StrictSeq.empty
      decodeFromList :: Decoder s (AllegraTxAuxDataRaw era)
decodeFromList =
        Text
-> (AllegraTxAuxDataRaw era -> Int)
-> Decoder s (AllegraTxAuxDataRaw era)
-> Decoder s (AllegraTxAuxDataRaw era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"AllegraTxAuxDataRaw" (Int -> AllegraTxAuxDataRaw era -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (AllegraTxAuxDataRaw era)
 -> Decoder s (AllegraTxAuxDataRaw era))
-> Decoder s (AllegraTxAuxDataRaw era)
-> Decoder s (AllegraTxAuxDataRaw era)
forall a b. (a -> b) -> a -> b
$
          Map Word64 Metadatum
-> StrictSeq (NativeScript era) -> AllegraTxAuxDataRaw era
forall era.
Map Word64 Metadatum
-> StrictSeq (NativeScript era) -> AllegraTxAuxDataRaw era
AllegraTxAuxDataRaw (Map Word64 Metadatum
 -> StrictSeq (NativeScript era) -> AllegraTxAuxDataRaw era)
-> Decoder s (Map Word64 Metadatum)
-> Decoder
     s (StrictSeq (NativeScript era) -> AllegraTxAuxDataRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map Word64 Metadatum)
forall s. Decoder s (Map Word64 Metadatum)
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (StrictSeq (NativeScript era) -> AllegraTxAuxDataRaw era)
-> Decoder s (StrictSeq (NativeScript era))
-> Decoder s (AllegraTxAuxDataRaw era)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (StrictSeq (NativeScript era))
forall s. Decoder s (StrictSeq (NativeScript era))
forall a s. DecCBOR a => Decoder s a
decCBOR

deriving newtype instance
  (AllegraEraScript era, DecCBOR (NativeScript era)) => DecCBOR (AllegraTxAuxData era)

instance Era era => DecCBOR (TimelockRaw era) where
  decCBOR :: forall s. Decoder s (TimelockRaw era)
decCBOR = Text
-> (Word -> Decoder s (Int, TimelockRaw era))
-> Decoder s (TimelockRaw era)
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"TimelockRaw" ((Word -> Decoder s (Int, TimelockRaw era))
 -> Decoder s (TimelockRaw era))
-> (Word -> Decoder s (Int, TimelockRaw era))
-> Decoder s (TimelockRaw era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> do
      keyHash <- Decoder s (KeyHash Witness)
forall s. Decoder s (KeyHash Witness)
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, TimelockSignature keyHash)
    Word
1 -> do
      timelocks <- Decoder s (StrictSeq (Timelock era))
forall s. Decoder s (StrictSeq (Timelock era))
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, TimelockAllOf timelocks)
    Word
2 -> do
      timelocks <- Decoder s (StrictSeq (Timelock era))
forall s. Decoder s (StrictSeq (Timelock era))
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, TimelockAnyOf timelocks)
    Word
3 -> do
      requiredCount <- Decoder s Int
forall s. Decoder s Int
forall a s. DecCBOR a => Decoder s a
decCBOR
      timelocks <- decCBOR
      pure (3, TimelockMOf requiredCount timelocks)
    Word
4 -> do
      slot <- Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, TimelockTimeStart slot)
    Word
5 -> do
      slot <- Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, TimelockTimeExpire slot)
    Word
k -> Word -> Decoder s (Int, TimelockRaw era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k

instance Era era => DecCBOR (Timelock era) where
  decCBOR :: forall s. Decoder s (Timelock era)
decCBOR = MemoBytes (TimelockRaw era) -> Timelock era
forall {k} (era :: k). MemoBytes (TimelockRaw era) -> Timelock era
MkTimelock (MemoBytes (TimelockRaw era) -> Timelock era)
-> Decoder s (MemoBytes (TimelockRaw era))
-> Decoder s (Timelock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (TimelockRaw era)
-> Decoder s (MemoBytes (TimelockRaw era))
forall s t. Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized Decoder s (TimelockRaw era)
forall s. Decoder s (TimelockRaw era)
forall a s. DecCBOR a => Decoder s a
decCBOR

deriving newtype instance DecCBOR (Tx TopTx AllegraEra)