Move applyTxErrorToJson

IntersectMBO · May 15, 2022 · 5c6cc63 · 5c6cc63
1 parent 727b4fd
commit 5c6cc63
Showing 1 changed file with 43 additions and 16 deletions.
diff --git a/cardano-api/src/Cardano/Api/InMode.hs b/cardano-api/src/Cardano/Api/InMode.hs
@@ -1,9 +1,21 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE DisambiguateRecordFields   #-}
+{-# LANGUAGE EmptyCase                  #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NamedFieldPuns             #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE QuantifiedConstraints      #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE UndecidableInstances       #-}
 
 -- | Transactions in the context of a consensus mode, and other types used in
 -- the transaction submission protocol.
@@ -25,26 +37,29 @@ module Cardano.Api.InMode (
     fromConsensusApplyTxErr,
   ) where
 
+import           Cardano.Api.Eras
+import           Cardano.Api.InMode.ToJson ()
+import           Cardano.Api.Modes
+import           Cardano.Api.Orphans ()
+import           Cardano.Api.Tx
+import           Cardano.Api.TxBody
+import           Data.Aeson (ToJSON(..), Value(..))
+import           Data.SOP.Strict (NS (S, Z))
+import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch)
 import           Prelude
 
-import           Data.Aeson (ToJSON(..))
+import qualified Cardano.Ledger.AuxiliaryData as Core
+import qualified Cardano.Ledger.Core as Core
+import qualified Cardano.Ledger.Era as Ledger
+import qualified Cardano.Ledger.Shelley.Rules.Bbody as Ledger
 import qualified Data.Aeson as Aeson
-import           Data.SOP.Strict (NS (S, Z))
-
 import qualified Ouroboros.Consensus.Byron.Ledger as Consensus
 import qualified Ouroboros.Consensus.Cardano.Block as Consensus
 import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
-import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch)
 import qualified Ouroboros.Consensus.HardFork.Combinator.Degenerate as Consensus
 import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
 import qualified Ouroboros.Consensus.TypeFamilyWrappers as Consensus
-import           Cardano.Api.InMode.Export (applyTxErrorToJson)
-
-import           Cardano.Api.Eras
-import           Cardano.Api.Modes
-import           Cardano.Api.Tx
-import           Cardano.Api.TxBody
 
 
 -- ----------------------------------------------------------------------------
@@ -337,3 +352,15 @@ fromConsensusApplyTxErr CardanoMode (Consensus.ApplyTxErrAlonzo err) =
 fromConsensusApplyTxErr CardanoMode (Consensus.ApplyTxErrWrongEra err) =
     TxValidationEraMismatch err
 
+
+applyTxErrorToJson ::
+  ( Consensus.ShelleyBasedEra era
+  , ToJSON (Core.AuxiliaryDataHash (Ledger.Crypto era))
+  , ToJSON (Core.TxOut era)
+  , ToJSON (Core.Value era)
+  , ToJSON (Ledger.PredicateFailure (Core.EraRule "DELEGS" era))
+  , ToJSON (Ledger.PredicateFailure (Core.EraRule "PPUP" era))
+  , ToJSON (Ledger.PredicateFailure (Core.EraRule "UTXO" era))
+  , ToJSON (Ledger.PredicateFailure (Core.EraRule "UTXOW" era))
+  ) => Consensus.ApplyTxErr (Consensus.ShelleyBlock era) -> Value
+applyTxErrorToJson (Consensus.ApplyTxError predicateFailures) = toJSON (fmap toJSON predicateFailures)