{-# LANGUAGE OverloadedStrings #-}
module Cardano.Api.TxSubmit.Types
  ( NodeApiEnv (..)
  , SocketPath (..)
  , TxSubmitStatus (..)
  , ApplyMempoolPayloadErr(..)
  , renderTxSubmitStatus
  , textShow
  ) where

import           Cardano.Api.TxSubmit.ErrorRender
import           Cardano.Binary (DecoderError)
import           Cardano.Chain.Byron.API (ApplyMempoolPayloadErr(..))
import qualified Cardano.Chain.Genesis as Genesis
import qualified Cardano.Chain.UTxO as Utxo

import           Cardano.Prelude hiding ((%))

import           Data.Aeson (ToJSON (..), Value (..))
import qualified Data.Aeson as Aeson
import qualified Data.Text as Text

import           Formatting (build, sformat, (%))


data NodeApiEnv = NodeApiEnv
  { NodeApiEnv -> Config
naeConfig :: Genesis.Config
  , NodeApiEnv -> SocketPath
naeSocket :: SocketPath
  }

newtype SocketPath = SocketPath
  { SocketPath -> FilePath
unSocketPath :: FilePath
  }

data TxSubmitStatus
  = TxSubmitOk Utxo.TxId
  | TxSubmitDecodeHex
  | TxSubmitEmpty
  | TxSubmitDecodeFail DecoderError
  | TxSubmitBadTx Text
  | TxSubmitFail ApplyMempoolPayloadErr
  deriving TxSubmitStatus -> TxSubmitStatus -> Bool
(TxSubmitStatus -> TxSubmitStatus -> Bool)
-> (TxSubmitStatus -> TxSubmitStatus -> Bool) -> Eq TxSubmitStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxSubmitStatus -> TxSubmitStatus -> Bool
$c/= :: TxSubmitStatus -> TxSubmitStatus -> Bool
== :: TxSubmitStatus -> TxSubmitStatus -> Bool
$c== :: TxSubmitStatus -> TxSubmitStatus -> Bool
Eq

instance ToJSON TxSubmitStatus where
  toJSON :: TxSubmitStatus -> Value
toJSON = TxSubmitStatus -> Value
convertJson

convertJson :: TxSubmitStatus -> Value
convertJson :: TxSubmitStatus -> Value
convertJson TxSubmitStatus
st =
    [Pair] -> Value
Aeson.object
      [ ( Text
"status", Text -> Value
String Text
statusMsg )
      , ( Text
"message", Text -> Value
String (TxSubmitStatus -> Text
renderTxSubmitStatus TxSubmitStatus
st) )
      ]
  where
    statusMsg :: Text
    statusMsg :: Text
statusMsg =
      case TxSubmitStatus
st of
        TxSubmitOk{} -> Text
"success"
        TxSubmitStatus
_other -> Text
"fail"

renderTxSubmitStatus :: TxSubmitStatus -> Text
renderTxSubmitStatus :: TxSubmitStatus -> Text
renderTxSubmitStatus TxSubmitStatus
st =
  case TxSubmitStatus
st of
    TxSubmitOk TxId
tx -> Format Text (TxId -> Text) -> TxId -> Text
forall a. Format Text a -> a
sformat (Format (TxId -> Text) (TxId -> Text)
"Tx "Format (TxId -> Text) (TxId -> Text)
-> Format Text (TxId -> Text) -> Format Text (TxId -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (TxId -> Text)
forall a r. Buildable a => Format r (a -> r)
build Format Text (TxId -> Text)
-> Format Text Text -> Format Text (TxId -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%Format Text Text
" submitted successfully") TxId
tx
    TxSubmitStatus
TxSubmitDecodeHex -> Text
"Provided data was hex encoded and this webapi expects raw binary"
    TxSubmitStatus
TxSubmitEmpty -> Text
"Provided transaction has zero length"
    TxSubmitDecodeFail DecoderError
err -> Format Text (DecoderError -> Text) -> DecoderError -> Text
forall a. Format Text a -> a
sformat Format Text (DecoderError -> Text)
forall a r. Buildable a => Format r (a -> r)
build DecoderError
err
    TxSubmitBadTx Text
tt -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"Transactions of type '", Text
tt, Text
"' not supported"]
    TxSubmitFail ApplyMempoolPayloadErr
err -> ApplyMempoolPayloadErr -> Text
renderApplyMempoolPayloadErr ApplyMempoolPayloadErr
err

textShow :: Show a => a -> Text
textShow :: a -> Text
textShow = FilePath -> Text
Text.pack (FilePath -> Text) -> (a -> FilePath) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show