{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Api.Experimental.Tx.Internal.Type
  ( UnsignedTx (..)
  )
where

import Cardano.Api.Era.Internal.Core qualified as Api
import Cardano.Api.HasTypeProxy (HasTypeProxy (..), asType)
import Cardano.Api.Ledger.Internal.Reexport qualified as L
import Cardano.Api.ProtocolParameters
import Cardano.Api.Serialise.Raw
  ( SerialiseAsRawBytes (..)
  , SerialiseAsRawBytesError (SerialiseAsRawBytesError)
  )

import Cardano.Ledger.Api.Era qualified as L
import Cardano.Ledger.Binary qualified as Ledger
import Cardano.Ledger.Core qualified as Ledger

import Control.Exception (displayException)
import Data.Bifunctor (bimap)
import Data.ByteString.Lazy (fromStrict)
import Data.Foldable (asum)
import Data.Typeable

-- | A transaction that can contain everything
-- except key witnesses.
data UnsignedTx era
  = L.EraTx era => UnsignedTx (Ledger.Tx era)

type family ToApiEra ledgerera where
  ToApiEra L.DijkstraEra = Api.DijkstraEra
  ToApiEra L.ConwayEra = Api.ConwayEra
  ToApiEra L.BabbageEra = Api.BabbageEra
  ToApiEra L.AlonzoEra = Api.AlonzoEra
  ToApiEra L.MaryEra = Api.MaryEra
  ToApiEra L.AllegraEra = Api.AllegraEra
  ToApiEra L.ShelleyEra = Api.ShelleyEra
  ToApiEra L.ByronEra = Api.ByronEra

instance Typeable era => HasTypeProxy (UnsignedTx era) where
  data AsType (UnsignedTx era) = AsUnsignedTx (AsType (ToApiEra era))
  proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era)
  proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era)
proxyToAsType Proxy (UnsignedTx era)
p =
    let checkAllEras :: Maybe (AsType (UnsignedTx era))
checkAllEras =
          [Maybe (AsType (UnsignedTx era))]
-> Maybe (AsType (UnsignedTx era))
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
            [ Proxy DijkstraEra
-> Proxy (UnsignedTx era) -> Maybe (AsType (UnsignedTx era))
forall expected actual ledgerera.
(Typeable expected, Typeable actual, HasTypeProxy ledgerera,
 ToApiEra expected ~ ledgerera) =>
Proxy expected
-> Proxy (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
isExpectedEra (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @L.DijkstraEra) Proxy (UnsignedTx era)
p
            , Proxy ConwayEra
-> Proxy (UnsignedTx era) -> Maybe (AsType (UnsignedTx era))
forall expected actual ledgerera.
(Typeable expected, Typeable actual, HasTypeProxy ledgerera,
 ToApiEra expected ~ ledgerera) =>
Proxy expected
-> Proxy (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
isExpectedEra (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @L.ConwayEra) Proxy (UnsignedTx era)
p
            , Proxy BabbageEra
-> Proxy (UnsignedTx era) -> Maybe (AsType (UnsignedTx era))
forall expected actual ledgerera.
(Typeable expected, Typeable actual, HasTypeProxy ledgerera,
 ToApiEra expected ~ ledgerera) =>
Proxy expected
-> Proxy (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
isExpectedEra (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @L.BabbageEra) Proxy (UnsignedTx era)
p
            , Proxy AlonzoEra
-> Proxy (UnsignedTx era) -> Maybe (AsType (UnsignedTx era))
forall expected actual ledgerera.
(Typeable expected, Typeable actual, HasTypeProxy ledgerera,
 ToApiEra expected ~ ledgerera) =>
Proxy expected
-> Proxy (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
isExpectedEra (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @L.AlonzoEra) Proxy (UnsignedTx era)
p
            , Proxy MaryEra
-> Proxy (UnsignedTx era) -> Maybe (AsType (UnsignedTx era))
forall expected actual ledgerera.
(Typeable expected, Typeable actual, HasTypeProxy ledgerera,
 ToApiEra expected ~ ledgerera) =>
Proxy expected
-> Proxy (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
isExpectedEra (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @L.MaryEra) Proxy (UnsignedTx era)
p
            , Proxy AllegraEra
-> Proxy (UnsignedTx era) -> Maybe (AsType (UnsignedTx era))
forall expected actual ledgerera.
(Typeable expected, Typeable actual, HasTypeProxy ledgerera,
 ToApiEra expected ~ ledgerera) =>
Proxy expected
-> Proxy (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
isExpectedEra (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @L.AllegraEra) Proxy (UnsignedTx era)
p
            , Proxy ShelleyEra
-> Proxy (UnsignedTx era) -> Maybe (AsType (UnsignedTx era))
forall expected actual ledgerera.
(Typeable expected, Typeable actual, HasTypeProxy ledgerera,
 ToApiEra expected ~ ledgerera) =>
Proxy expected
-> Proxy (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
isExpectedEra (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @L.ShelleyEra) Proxy (UnsignedTx era)
p
            , Proxy ByronEra
-> Proxy (UnsignedTx era) -> Maybe (AsType (UnsignedTx era))
forall expected actual ledgerera.
(Typeable expected, Typeable actual, HasTypeProxy ledgerera,
 ToApiEra expected ~ ledgerera) =>
Proxy expected
-> Proxy (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
isExpectedEra (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @L.ByronEra) Proxy (UnsignedTx era)
p
            ]
     in case Maybe (AsType (UnsignedTx era))
checkAllEras of
          Just AsType (UnsignedTx era)
a -> AsType (UnsignedTx era)
a
          Maybe (AsType (UnsignedTx era))
Nothing -> [Char] -> AsType (UnsignedTx era)
forall a. HasCallStack => [Char] -> a
error [Char]
"HasTypeProxy (UnsignedTx era): Era not supported"

isExpectedEra
  :: forall expected actual ledgerera
   . (Typeable expected, Typeable actual, HasTypeProxy ledgerera, ToApiEra expected ~ ledgerera)
  => Proxy expected -> Proxy (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
isExpectedEra :: forall expected actual ledgerera.
(Typeable expected, Typeable actual, HasTypeProxy ledgerera,
 ToApiEra expected ~ ledgerera) =>
Proxy expected
-> Proxy (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
isExpectedEra Proxy expected
_ Proxy (UnsignedTx actual)
_ = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @actual @expected of
  Just actual :~: expected
Refl -> AsType (UnsignedTx actual) -> Maybe (AsType (UnsignedTx actual))
forall a. a -> Maybe a
Just (AsType (ToApiEra actual) -> AsType (UnsignedTx actual)
forall era. AsType (ToApiEra era) -> AsType (UnsignedTx era)
AsUnsignedTx (forall t. HasTypeProxy t => AsType t
asType @(ToApiEra expected)))
  Maybe (actual :~: expected)
Nothing -> Maybe (AsType (UnsignedTx actual))
forall a. Maybe a
Nothing

instance
  L.EraTx era
  => SerialiseAsRawBytes (UnsignedTx era)
  where
  serialiseToRawBytes :: UnsignedTx era -> ByteString
serialiseToRawBytes (UnsignedTx Tx era
tx) =
    Version -> Tx era -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
Ledger.serialize' (forall era. Era era => Version
Ledger.eraProtVerHigh @era) Tx era
tx
  deserialiseFromRawBytes :: AsType (UnsignedTx era)
-> ByteString -> Either SerialiseAsRawBytesError (UnsignedTx era)
deserialiseFromRawBytes AsType (UnsignedTx era)
_ =
    (DecoderError -> SerialiseAsRawBytesError)
-> (Tx era -> UnsignedTx era)
-> Either DecoderError (Tx era)
-> Either SerialiseAsRawBytesError (UnsignedTx era)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DecoderError -> SerialiseAsRawBytesError
wrapError Tx era -> UnsignedTx era
forall era. EraTx era => Tx era -> UnsignedTx era
UnsignedTx
      (Either DecoderError (Tx era)
 -> Either SerialiseAsRawBytesError (UnsignedTx era))
-> (ByteString -> Either DecoderError (Tx era))
-> ByteString
-> Either SerialiseAsRawBytesError (UnsignedTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version
-> Text
-> (forall s. Decoder s (Annotator (Tx era)))
-> ByteString
-> Either DecoderError (Tx era)
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
Ledger.decodeFullAnnotator
        (forall era. Era era => Version
Ledger.eraProtVerHigh @era)
        Text
"UnsignedTx"
        Decoder s (Annotator (Tx era))
forall s. Decoder s (Annotator (Tx era))
forall a s. DecCBOR a => Decoder s a
Ledger.decCBOR
      (ByteString -> Either DecoderError (Tx era))
-> (ByteString -> ByteString)
-> ByteString
-> Either DecoderError (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
   where
    wrapError
      :: Ledger.DecoderError -> SerialiseAsRawBytesError
    wrapError :: DecoderError -> SerialiseAsRawBytesError
wrapError = [Char] -> SerialiseAsRawBytesError
SerialiseAsRawBytesError ([Char] -> SerialiseAsRawBytesError)
-> (DecoderError -> [Char])
-> DecoderError
-> SerialiseAsRawBytesError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> [Char]
forall e. Exception e => e -> [Char]
displayException

deriving instance Eq (UnsignedTx era)

deriving instance Show (UnsignedTx era)