{-# LANGUAGE UndecidableInstances #-}

module Hydra.API.HTTPServer where

import Hydra.Prelude

import Cardano.Ledger.Binary (encCBOR, toPlainEncoding)
import Cardano.Ledger.Core (PParams)
import Codec.CBOR.Write qualified as CBOR
import Control.Concurrent.STM (TChan, dupTChan, readTChan)
import Data.Aeson (KeyValue ((.=)), object, withObject, (.:), (.:?))
import Data.Aeson qualified as Aeson
import Data.Aeson.Types (Parser, parseEither)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.ByteString.Short ()
import Data.List qualified as List
import Data.Text (pack)
import Hydra.API.APIServerLog (APIServerLog (..), Method (..), PathInfo (..))
import Hydra.API.ClientInput (ClientInput (..))
import Hydra.API.ServerOutput (ApiEncoding (..), ClientMessage (..), CommitInfo (..), ServerOutput (..), TimedServerOutput (..), getConfirmedSnapshot, getSeenSnapshot, getSnapshotUtxo)
import Hydra.API.WireFormat (decodeWire, encodeWire)
import Hydra.CBOR.Orphans ()
import Hydra.Cardano.Api (AddressInEra, LedgerEra, SlotNo, Tx, ledgerEraVersion)
import Hydra.Chain (Chain (..), PostTxError (..))
import Hydra.Chain.ChainState (IsChainState)
import Hydra.Chain.Direct.State ()
import Hydra.Ledger (ValidationError (..))
import Hydra.Logging (Tracer, traceWith)
import Hydra.Node.ApiTransactionTimeout (ApiTransactionTimeout (..))
import Hydra.Node.Environment (Environment (..))
import Hydra.Node.State (NodeState (..))
import Hydra.Tx (CommitBlueprintTx (..), ConfirmedSnapshot, IsTx (..), Snapshot (..), UTxOType)
import Hydra.Tx.DepositPeriod (toNominalDiffTime)
import Network.HTTP.Types (ResponseHeaders, Status, hAccept, hContentType, status200, status202, status400, status404, status500, status503)
import Network.Wai (Application, Request (pathInfo, requestMethod), Response, consumeRequestBodyStrict, rawPathInfo, requestHeaders, responseLBS)

newtype DraftCommitTxResponse tx = DraftCommitTxResponse
  { forall tx. DraftCommitTxResponse tx -> tx
commitTx :: tx
  }
  deriving stock ((forall x.
 DraftCommitTxResponse tx -> Rep (DraftCommitTxResponse tx) x)
-> (forall x.
    Rep (DraftCommitTxResponse tx) x -> DraftCommitTxResponse tx)
-> Generic (DraftCommitTxResponse tx)
forall x.
Rep (DraftCommitTxResponse tx) x -> DraftCommitTxResponse tx
forall x.
DraftCommitTxResponse tx -> Rep (DraftCommitTxResponse tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x.
Rep (DraftCommitTxResponse tx) x -> DraftCommitTxResponse tx
forall tx x.
DraftCommitTxResponse tx -> Rep (DraftCommitTxResponse tx) x
$cfrom :: forall tx x.
DraftCommitTxResponse tx -> Rep (DraftCommitTxResponse tx) x
from :: forall x.
DraftCommitTxResponse tx -> Rep (DraftCommitTxResponse tx) x
$cto :: forall tx x.
Rep (DraftCommitTxResponse tx) x -> DraftCommitTxResponse tx
to :: forall x.
Rep (DraftCommitTxResponse tx) x -> DraftCommitTxResponse tx
Generic)

deriving stock instance Eq tx => Eq (DraftCommitTxResponse tx)
deriving stock instance Show tx => Show (DraftCommitTxResponse tx)

instance IsTx tx => ToJSON (DraftCommitTxResponse tx) where
  toJSON :: DraftCommitTxResponse tx -> Value
toJSON (DraftCommitTxResponse tx
tx) = tx -> Value
forall a. ToJSON a => a -> Value
toJSON tx
tx

instance IsTx tx => FromJSON (DraftCommitTxResponse tx) where
  parseJSON :: Value -> Parser (DraftCommitTxResponse tx)
parseJSON Value
v = tx -> DraftCommitTxResponse tx
forall tx. tx -> DraftCommitTxResponse tx
DraftCommitTxResponse (tx -> DraftCommitTxResponse tx)
-> Parser tx -> Parser (DraftCommitTxResponse tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser tx
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance IsTx tx => ToCBOR (DraftCommitTxResponse tx) where
  toCBOR :: DraftCommitTxResponse tx -> Encoding
toCBOR (DraftCommitTxResponse tx
tx) = tx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR tx
tx

instance IsTx tx => FromCBOR (DraftCommitTxResponse tx) where
  fromCBOR :: forall s. Decoder s (DraftCommitTxResponse tx)
fromCBOR = tx -> DraftCommitTxResponse tx
forall tx. tx -> DraftCommitTxResponse tx
DraftCommitTxResponse (tx -> DraftCommitTxResponse tx)
-> Decoder s tx -> Decoder s (DraftCommitTxResponse tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s tx
forall s. Decoder s tx
forall a s. FromCBOR a => Decoder s a
fromCBOR

data DraftCommitTxRequest tx
  = SimpleCommitRequest
      { forall tx. DraftCommitTxRequest tx -> UTxOType tx
utxoToCommit :: UTxOType tx
      }
  | FullCommitRequest
      { forall tx. DraftCommitTxRequest tx -> tx
blueprintTx :: tx
      , forall tx. DraftCommitTxRequest tx -> UTxOType tx
utxo :: UTxOType tx
      , forall tx. DraftCommitTxRequest tx -> Maybe AddressInEra
changeAddress :: Maybe AddressInEra
      }
  deriving stock ((forall x.
 DraftCommitTxRequest tx -> Rep (DraftCommitTxRequest tx) x)
-> (forall x.
    Rep (DraftCommitTxRequest tx) x -> DraftCommitTxRequest tx)
-> Generic (DraftCommitTxRequest tx)
forall x.
Rep (DraftCommitTxRequest tx) x -> DraftCommitTxRequest tx
forall x.
DraftCommitTxRequest tx -> Rep (DraftCommitTxRequest tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x.
Rep (DraftCommitTxRequest tx) x -> DraftCommitTxRequest tx
forall tx x.
DraftCommitTxRequest tx -> Rep (DraftCommitTxRequest tx) x
$cfrom :: forall tx x.
DraftCommitTxRequest tx -> Rep (DraftCommitTxRequest tx) x
from :: forall x.
DraftCommitTxRequest tx -> Rep (DraftCommitTxRequest tx) x
$cto :: forall tx x.
Rep (DraftCommitTxRequest tx) x -> DraftCommitTxRequest tx
to :: forall x.
Rep (DraftCommitTxRequest tx) x -> DraftCommitTxRequest tx
Generic)

deriving stock instance (Eq tx, Eq (UTxOType tx)) => Eq (DraftCommitTxRequest tx)
deriving stock instance (Show tx, Show (UTxOType tx)) => Show (DraftCommitTxRequest tx)

instance (ToJSON tx, ToJSON (UTxOType tx)) => ToJSON (DraftCommitTxRequest tx) where
  toJSON :: DraftCommitTxRequest tx -> Value
toJSON = \case
    FullCommitRequest{tx
$sel:blueprintTx:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> tx
blueprintTx :: tx
blueprintTx, UTxOType tx
$sel:utxo:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> UTxOType tx
utxo :: UTxOType tx
utxo, Maybe AddressInEra
$sel:changeAddress:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> Maybe AddressInEra
changeAddress :: Maybe AddressInEra
changeAddress} ->
      [Pair] -> Value
object
        [ Key
"blueprintTx" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= tx -> Value
forall a. ToJSON a => a -> Value
toJSON tx
blueprintTx
        , Key
"utxo" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxOType tx -> Value
forall a. ToJSON a => a -> Value
toJSON UTxOType tx
utxo
        , Key
"changeAddress" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe AddressInEra -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe AddressInEra
changeAddress
        ]
    SimpleCommitRequest{UTxOType tx
$sel:utxoToCommit:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> UTxOType tx
utxoToCommit :: UTxOType tx
utxoToCommit} ->
      [Pair] -> Value
object
        [ Key
"utxoToCommit" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxOType tx -> Value
forall a. ToJSON a => a -> Value
toJSON UTxOType tx
utxoToCommit
        ]

instance (FromJSON tx, FromJSON (UTxOType tx)) => FromJSON (DraftCommitTxRequest tx) where
  parseJSON :: Value -> Parser (DraftCommitTxRequest tx)
parseJSON Value
v = Value -> Parser (DraftCommitTxRequest tx)
fullVariant Value
v Parser (DraftCommitTxRequest tx)
-> Parser (DraftCommitTxRequest tx)
-> Parser (DraftCommitTxRequest tx)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (DraftCommitTxRequest tx)
simpleVariant Value
v Parser (DraftCommitTxRequest tx)
-> Parser (DraftCommitTxRequest tx)
-> Parser (DraftCommitTxRequest tx)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (DraftCommitTxRequest tx)
simpleDirectVariant Value
v
   where
    fullVariant :: Value -> Parser (DraftCommitTxRequest tx)
fullVariant = String
-> (Object -> Parser (DraftCommitTxRequest tx))
-> Value
-> Parser (DraftCommitTxRequest tx)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FullCommitRequest" ((Object -> Parser (DraftCommitTxRequest tx))
 -> Value -> Parser (DraftCommitTxRequest tx))
-> (Object -> Parser (DraftCommitTxRequest tx))
-> Value
-> Parser (DraftCommitTxRequest tx)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      tx
blueprintTx :: tx <- Object
o Object -> Key -> Parser tx
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blueprintTx"
      UTxOType tx
utxo <- Object
o Object -> Key -> Parser (UTxOType tx)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"utxo"
      Maybe AddressInEra
changeAddress <- Object
o Object -> Key -> Parser (Maybe AddressInEra)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"changeAddress"
      DraftCommitTxRequest tx -> Parser (DraftCommitTxRequest tx)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FullCommitRequest{tx
$sel:blueprintTx:SimpleCommitRequest :: tx
blueprintTx :: tx
blueprintTx, UTxOType tx
$sel:utxo:SimpleCommitRequest :: UTxOType tx
utxo :: UTxOType tx
utxo, Maybe AddressInEra
$sel:changeAddress:SimpleCommitRequest :: Maybe AddressInEra
changeAddress :: Maybe AddressInEra
changeAddress}

    simpleVariant :: Value -> Parser (DraftCommitTxRequest tx)
simpleVariant = String
-> (Object -> Parser (DraftCommitTxRequest tx))
-> Value
-> Parser (DraftCommitTxRequest tx)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SimpleCommitRequest" ((Object -> Parser (DraftCommitTxRequest tx))
 -> Value -> Parser (DraftCommitTxRequest tx))
-> (Object -> Parser (DraftCommitTxRequest tx))
-> Value
-> Parser (DraftCommitTxRequest tx)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      UTxOType tx
utxoToCommit <- Object
o Object -> Key -> Parser (UTxOType tx)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"utxoToCommit"
      DraftCommitTxRequest tx -> Parser (DraftCommitTxRequest tx)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SimpleCommitRequest{UTxOType tx
$sel:utxoToCommit:SimpleCommitRequest :: UTxOType tx
utxoToCommit :: UTxOType tx
utxoToCommit}

    simpleDirectVariant :: Aeson.Value -> Parser (DraftCommitTxRequest tx)
    simpleDirectVariant :: Value -> Parser (DraftCommitTxRequest tx)
simpleDirectVariant Value
val = UTxOType tx -> DraftCommitTxRequest tx
forall tx. UTxOType tx -> DraftCommitTxRequest tx
SimpleCommitRequest (UTxOType tx -> DraftCommitTxRequest tx)
-> Parser (UTxOType tx) -> Parser (DraftCommitTxRequest tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (UTxOType tx)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val

instance IsTx tx => ToCBOR (DraftCommitTxRequest tx) where
  toCBOR :: DraftCommitTxRequest tx -> Encoding
toCBOR = \case
    SimpleCommitRequest{UTxOType tx
$sel:utxoToCommit:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> UTxOType tx
utxoToCommit :: UTxOType tx
utxoToCommit} ->
      Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"SimpleCommitRequest" :: Text) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UTxOType tx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR UTxOType tx
utxoToCommit
    FullCommitRequest{tx
$sel:blueprintTx:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> tx
blueprintTx :: tx
blueprintTx, UTxOType tx
$sel:utxo:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> UTxOType tx
utxo :: UTxOType tx
utxo, Maybe AddressInEra
$sel:changeAddress:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> Maybe AddressInEra
changeAddress :: Maybe AddressInEra
changeAddress} ->
      Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"FullCommitRequest" :: Text)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR tx
blueprintTx
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UTxOType tx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR UTxOType tx
utxo
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe AddressInEra -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe AddressInEra
changeAddress

instance IsTx tx => FromCBOR (DraftCommitTxRequest tx) where
  fromCBOR :: forall s. Decoder s (DraftCommitTxRequest tx)
fromCBOR =
    Decoder s Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Text
-> (Text -> Decoder s (DraftCommitTxRequest tx))
-> Decoder s (DraftCommitTxRequest tx)
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
      (Text
"SimpleCommitRequest" :: Text) -> UTxOType tx -> DraftCommitTxRequest tx
forall tx. UTxOType tx -> DraftCommitTxRequest tx
SimpleCommitRequest (UTxOType tx -> DraftCommitTxRequest tx)
-> Decoder s (UTxOType tx) -> Decoder s (DraftCommitTxRequest tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (UTxOType tx)
forall s. Decoder s (UTxOType tx)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Text
"FullCommitRequest" -> tx -> UTxOType tx -> Maybe AddressInEra -> DraftCommitTxRequest tx
forall tx.
tx -> UTxOType tx -> Maybe AddressInEra -> DraftCommitTxRequest tx
FullCommitRequest (tx
 -> UTxOType tx -> Maybe AddressInEra -> DraftCommitTxRequest tx)
-> Decoder s tx
-> Decoder
     s (UTxOType tx -> Maybe AddressInEra -> DraftCommitTxRequest tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s tx
forall s. Decoder s tx
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder
  s (UTxOType tx -> Maybe AddressInEra -> DraftCommitTxRequest tx)
-> Decoder s (UTxOType tx)
-> Decoder s (Maybe AddressInEra -> DraftCommitTxRequest tx)
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 (UTxOType tx)
forall s. Decoder s (UTxOType tx)
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Maybe AddressInEra -> DraftCommitTxRequest tx)
-> Decoder s (Maybe AddressInEra)
-> Decoder s (DraftCommitTxRequest tx)
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 (Maybe AddressInEra)
forall s. Decoder s (Maybe AddressInEra)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Text
tag -> String -> Decoder s (DraftCommitTxRequest tx)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (DraftCommitTxRequest tx))
-> String -> Decoder s (DraftCommitTxRequest tx)
forall a b. (a -> b) -> a -> b
$ Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
tag String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a proper CBOR-encoded DraftCommitTxRequest"

newtype SubmitTxRequest tx = SubmitTxRequest
  { forall tx. SubmitTxRequest tx -> tx
txToSubmit :: tx
  }
  deriving newtype (SubmitTxRequest tx -> SubmitTxRequest tx -> Bool
(SubmitTxRequest tx -> SubmitTxRequest tx -> Bool)
-> (SubmitTxRequest tx -> SubmitTxRequest tx -> Bool)
-> Eq (SubmitTxRequest tx)
forall tx.
Eq tx =>
SubmitTxRequest tx -> SubmitTxRequest tx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tx.
Eq tx =>
SubmitTxRequest tx -> SubmitTxRequest tx -> Bool
== :: SubmitTxRequest tx -> SubmitTxRequest tx -> Bool
$c/= :: forall tx.
Eq tx =>
SubmitTxRequest tx -> SubmitTxRequest tx -> Bool
/= :: SubmitTxRequest tx -> SubmitTxRequest tx -> Bool
Eq, Int -> SubmitTxRequest tx -> ShowS
[SubmitTxRequest tx] -> ShowS
SubmitTxRequest tx -> String
(Int -> SubmitTxRequest tx -> ShowS)
-> (SubmitTxRequest tx -> String)
-> ([SubmitTxRequest tx] -> ShowS)
-> Show (SubmitTxRequest tx)
forall tx. Show tx => Int -> SubmitTxRequest tx -> ShowS
forall tx. Show tx => [SubmitTxRequest tx] -> ShowS
forall tx. Show tx => SubmitTxRequest tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall tx. Show tx => Int -> SubmitTxRequest tx -> ShowS
showsPrec :: Int -> SubmitTxRequest tx -> ShowS
$cshow :: forall tx. Show tx => SubmitTxRequest tx -> String
show :: SubmitTxRequest tx -> String
$cshowList :: forall tx. Show tx => [SubmitTxRequest tx] -> ShowS
showList :: [SubmitTxRequest tx] -> ShowS
Show)
  deriving newtype ([SubmitTxRequest tx] -> Value
[SubmitTxRequest tx] -> Encoding
SubmitTxRequest tx -> Bool
SubmitTxRequest tx -> Value
SubmitTxRequest tx -> Encoding
(SubmitTxRequest tx -> Value)
-> (SubmitTxRequest tx -> Encoding)
-> ([SubmitTxRequest tx] -> Value)
-> ([SubmitTxRequest tx] -> Encoding)
-> (SubmitTxRequest tx -> Bool)
-> ToJSON (SubmitTxRequest tx)
forall tx. ToJSON tx => [SubmitTxRequest tx] -> Value
forall tx. ToJSON tx => [SubmitTxRequest tx] -> Encoding
forall tx. ToJSON tx => SubmitTxRequest tx -> Bool
forall tx. ToJSON tx => SubmitTxRequest tx -> Value
forall tx. ToJSON tx => SubmitTxRequest tx -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall tx. ToJSON tx => SubmitTxRequest tx -> Value
toJSON :: SubmitTxRequest tx -> Value
$ctoEncoding :: forall tx. ToJSON tx => SubmitTxRequest tx -> Encoding
toEncoding :: SubmitTxRequest tx -> Encoding
$ctoJSONList :: forall tx. ToJSON tx => [SubmitTxRequest tx] -> Value
toJSONList :: [SubmitTxRequest tx] -> Value
$ctoEncodingList :: forall tx. ToJSON tx => [SubmitTxRequest tx] -> Encoding
toEncodingList :: [SubmitTxRequest tx] -> Encoding
$comitField :: forall tx. ToJSON tx => SubmitTxRequest tx -> Bool
omitField :: SubmitTxRequest tx -> Bool
ToJSON, Maybe (SubmitTxRequest tx)
Value -> Parser [SubmitTxRequest tx]
Value -> Parser (SubmitTxRequest tx)
(Value -> Parser (SubmitTxRequest tx))
-> (Value -> Parser [SubmitTxRequest tx])
-> Maybe (SubmitTxRequest tx)
-> FromJSON (SubmitTxRequest tx)
forall tx. FromJSON tx => Maybe (SubmitTxRequest tx)
forall tx. FromJSON tx => Value -> Parser [SubmitTxRequest tx]
forall tx. FromJSON tx => Value -> Parser (SubmitTxRequest tx)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall tx. FromJSON tx => Value -> Parser (SubmitTxRequest tx)
parseJSON :: Value -> Parser (SubmitTxRequest tx)
$cparseJSONList :: forall tx. FromJSON tx => Value -> Parser [SubmitTxRequest tx]
parseJSONList :: Value -> Parser [SubmitTxRequest tx]
$comittedField :: forall tx. FromJSON tx => Maybe (SubmitTxRequest tx)
omittedField :: Maybe (SubmitTxRequest tx)
FromJSON)

deriving newtype instance (Typeable tx, ToCBOR tx) => ToCBOR (SubmitTxRequest tx)
deriving newtype instance (Typeable tx, FromCBOR tx) => FromCBOR (SubmitTxRequest tx)

data TransactionSubmitted = TransactionSubmitted
  deriving stock (TransactionSubmitted -> TransactionSubmitted -> Bool
(TransactionSubmitted -> TransactionSubmitted -> Bool)
-> (TransactionSubmitted -> TransactionSubmitted -> Bool)
-> Eq TransactionSubmitted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransactionSubmitted -> TransactionSubmitted -> Bool
== :: TransactionSubmitted -> TransactionSubmitted -> Bool
$c/= :: TransactionSubmitted -> TransactionSubmitted -> Bool
/= :: TransactionSubmitted -> TransactionSubmitted -> Bool
Eq, Int -> TransactionSubmitted -> ShowS
[TransactionSubmitted] -> ShowS
TransactionSubmitted -> String
(Int -> TransactionSubmitted -> ShowS)
-> (TransactionSubmitted -> String)
-> ([TransactionSubmitted] -> ShowS)
-> Show TransactionSubmitted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransactionSubmitted -> ShowS
showsPrec :: Int -> TransactionSubmitted -> ShowS
$cshow :: TransactionSubmitted -> String
show :: TransactionSubmitted -> String
$cshowList :: [TransactionSubmitted] -> ShowS
showList :: [TransactionSubmitted] -> ShowS
Show, (forall x. TransactionSubmitted -> Rep TransactionSubmitted x)
-> (forall x. Rep TransactionSubmitted x -> TransactionSubmitted)
-> Generic TransactionSubmitted
forall x. Rep TransactionSubmitted x -> TransactionSubmitted
forall x. TransactionSubmitted -> Rep TransactionSubmitted x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TransactionSubmitted -> Rep TransactionSubmitted x
from :: forall x. TransactionSubmitted -> Rep TransactionSubmitted x
$cto :: forall x. Rep TransactionSubmitted x -> TransactionSubmitted
to :: forall x. Rep TransactionSubmitted x -> TransactionSubmitted
Generic)

instance ToJSON TransactionSubmitted where
  toJSON :: TransactionSubmitted -> Value
toJSON TransactionSubmitted
_ =
    [Pair] -> Value
object
      [ Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"TransactionSubmitted"
      ]

instance FromJSON TransactionSubmitted where
  parseJSON :: Value -> Parser TransactionSubmitted
parseJSON = String
-> (Object -> Parser TransactionSubmitted)
-> Value
-> Parser TransactionSubmitted
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TransactionSubmitted" ((Object -> Parser TransactionSubmitted)
 -> Value -> Parser TransactionSubmitted)
-> (Object -> Parser TransactionSubmitted)
-> Value
-> Parser TransactionSubmitted
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
tag <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag"
    case Text
tag :: Text of
      Text
"TransactionSubmitted" ->
        TransactionSubmitted -> Parser TransactionSubmitted
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransactionSubmitted
TransactionSubmitted
      Text
_ -> String -> Parser TransactionSubmitted
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected tag to be TransactionSubmitted"

instance ToCBOR TransactionSubmitted where
  toCBOR :: TransactionSubmitted -> Encoding
toCBOR TransactionSubmitted
TransactionSubmitted = Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"TransactionSubmitted" :: Text)

instance FromCBOR TransactionSubmitted where
  fromCBOR :: forall s. Decoder s TransactionSubmitted
fromCBOR =
    Decoder s Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Text
-> (Text -> Decoder s TransactionSubmitted)
-> Decoder s TransactionSubmitted
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
      (Text
"TransactionSubmitted" :: Text) -> TransactionSubmitted -> Decoder s TransactionSubmitted
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransactionSubmitted
TransactionSubmitted
      Text
tag -> String -> Decoder s TransactionSubmitted
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s TransactionSubmitted)
-> String -> Decoder s TransactionSubmitted
forall a b. (a -> b) -> a -> b
$ Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
tag String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a proper CBOR-encoded TransactionSubmitted"

newtype SideLoadSnapshotRequest tx = SideLoadSnapshotRequest
  { forall tx. SideLoadSnapshotRequest tx -> ConfirmedSnapshot tx
snapshot :: ConfirmedSnapshot tx
  }
  deriving newtype (SideLoadSnapshotRequest tx -> SideLoadSnapshotRequest tx -> Bool
(SideLoadSnapshotRequest tx -> SideLoadSnapshotRequest tx -> Bool)
-> (SideLoadSnapshotRequest tx
    -> SideLoadSnapshotRequest tx -> Bool)
-> Eq (SideLoadSnapshotRequest tx)
forall tx.
IsTx tx =>
SideLoadSnapshotRequest tx -> SideLoadSnapshotRequest tx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tx.
IsTx tx =>
SideLoadSnapshotRequest tx -> SideLoadSnapshotRequest tx -> Bool
== :: SideLoadSnapshotRequest tx -> SideLoadSnapshotRequest tx -> Bool
$c/= :: forall tx.
IsTx tx =>
SideLoadSnapshotRequest tx -> SideLoadSnapshotRequest tx -> Bool
/= :: SideLoadSnapshotRequest tx -> SideLoadSnapshotRequest tx -> Bool
Eq, Int -> SideLoadSnapshotRequest tx -> ShowS
[SideLoadSnapshotRequest tx] -> ShowS
SideLoadSnapshotRequest tx -> String
(Int -> SideLoadSnapshotRequest tx -> ShowS)
-> (SideLoadSnapshotRequest tx -> String)
-> ([SideLoadSnapshotRequest tx] -> ShowS)
-> Show (SideLoadSnapshotRequest tx)
forall tx. IsTx tx => Int -> SideLoadSnapshotRequest tx -> ShowS
forall tx. IsTx tx => [SideLoadSnapshotRequest tx] -> ShowS
forall tx. IsTx tx => SideLoadSnapshotRequest tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall tx. IsTx tx => Int -> SideLoadSnapshotRequest tx -> ShowS
showsPrec :: Int -> SideLoadSnapshotRequest tx -> ShowS
$cshow :: forall tx. IsTx tx => SideLoadSnapshotRequest tx -> String
show :: SideLoadSnapshotRequest tx -> String
$cshowList :: forall tx. IsTx tx => [SideLoadSnapshotRequest tx] -> ShowS
showList :: [SideLoadSnapshotRequest tx] -> ShowS
Show, (forall x.
 SideLoadSnapshotRequest tx -> Rep (SideLoadSnapshotRequest tx) x)
-> (forall x.
    Rep (SideLoadSnapshotRequest tx) x -> SideLoadSnapshotRequest tx)
-> Generic (SideLoadSnapshotRequest tx)
forall x.
Rep (SideLoadSnapshotRequest tx) x -> SideLoadSnapshotRequest tx
forall x.
SideLoadSnapshotRequest tx -> Rep (SideLoadSnapshotRequest tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x.
Rep (SideLoadSnapshotRequest tx) x -> SideLoadSnapshotRequest tx
forall tx x.
SideLoadSnapshotRequest tx -> Rep (SideLoadSnapshotRequest tx) x
$cfrom :: forall tx x.
SideLoadSnapshotRequest tx -> Rep (SideLoadSnapshotRequest tx) x
from :: forall x.
SideLoadSnapshotRequest tx -> Rep (SideLoadSnapshotRequest tx) x
$cto :: forall tx x.
Rep (SideLoadSnapshotRequest tx) x -> SideLoadSnapshotRequest tx
to :: forall x.
Rep (SideLoadSnapshotRequest tx) x -> SideLoadSnapshotRequest tx
Generic)
  deriving newtype ([SideLoadSnapshotRequest tx] -> Value
[SideLoadSnapshotRequest tx] -> Encoding
SideLoadSnapshotRequest tx -> Bool
SideLoadSnapshotRequest tx -> Value
SideLoadSnapshotRequest tx -> Encoding
(SideLoadSnapshotRequest tx -> Value)
-> (SideLoadSnapshotRequest tx -> Encoding)
-> ([SideLoadSnapshotRequest tx] -> Value)
-> ([SideLoadSnapshotRequest tx] -> Encoding)
-> (SideLoadSnapshotRequest tx -> Bool)
-> ToJSON (SideLoadSnapshotRequest tx)
forall tx. IsTx tx => [SideLoadSnapshotRequest tx] -> Value
forall tx. IsTx tx => [SideLoadSnapshotRequest tx] -> Encoding
forall tx. IsTx tx => SideLoadSnapshotRequest tx -> Bool
forall tx. IsTx tx => SideLoadSnapshotRequest tx -> Value
forall tx. IsTx tx => SideLoadSnapshotRequest tx -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall tx. IsTx tx => SideLoadSnapshotRequest tx -> Value
toJSON :: SideLoadSnapshotRequest tx -> Value
$ctoEncoding :: forall tx. IsTx tx => SideLoadSnapshotRequest tx -> Encoding
toEncoding :: SideLoadSnapshotRequest tx -> Encoding
$ctoJSONList :: forall tx. IsTx tx => [SideLoadSnapshotRequest tx] -> Value
toJSONList :: [SideLoadSnapshotRequest tx] -> Value
$ctoEncodingList :: forall tx. IsTx tx => [SideLoadSnapshotRequest tx] -> Encoding
toEncodingList :: [SideLoadSnapshotRequest tx] -> Encoding
$comitField :: forall tx. IsTx tx => SideLoadSnapshotRequest tx -> Bool
omitField :: SideLoadSnapshotRequest tx -> Bool
ToJSON, Maybe (SideLoadSnapshotRequest tx)
Value -> Parser [SideLoadSnapshotRequest tx]
Value -> Parser (SideLoadSnapshotRequest tx)
(Value -> Parser (SideLoadSnapshotRequest tx))
-> (Value -> Parser [SideLoadSnapshotRequest tx])
-> Maybe (SideLoadSnapshotRequest tx)
-> FromJSON (SideLoadSnapshotRequest tx)
forall tx. IsTx tx => Maybe (SideLoadSnapshotRequest tx)
forall tx. IsTx tx => Value -> Parser [SideLoadSnapshotRequest tx]
forall tx. IsTx tx => Value -> Parser (SideLoadSnapshotRequest tx)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall tx. IsTx tx => Value -> Parser (SideLoadSnapshotRequest tx)
parseJSON :: Value -> Parser (SideLoadSnapshotRequest tx)
$cparseJSONList :: forall tx. IsTx tx => Value -> Parser [SideLoadSnapshotRequest tx]
parseJSONList :: Value -> Parser [SideLoadSnapshotRequest tx]
$comittedField :: forall tx. IsTx tx => Maybe (SideLoadSnapshotRequest tx)
omittedField :: Maybe (SideLoadSnapshotRequest tx)
FromJSON)

deriving newtype instance IsTx tx => ToCBOR (SideLoadSnapshotRequest tx)
deriving newtype instance IsTx tx => FromCBOR (SideLoadSnapshotRequest tx)

-- | Request to submit a transaction to the head
newtype SubmitL2TxRequest tx = SubmitL2TxRequest
  { forall tx. SubmitL2TxRequest tx -> tx
submitL2Tx :: tx
  }
  deriving newtype (SubmitL2TxRequest tx -> SubmitL2TxRequest tx -> Bool
(SubmitL2TxRequest tx -> SubmitL2TxRequest tx -> Bool)
-> (SubmitL2TxRequest tx -> SubmitL2TxRequest tx -> Bool)
-> Eq (SubmitL2TxRequest tx)
forall tx.
Eq tx =>
SubmitL2TxRequest tx -> SubmitL2TxRequest tx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tx.
Eq tx =>
SubmitL2TxRequest tx -> SubmitL2TxRequest tx -> Bool
== :: SubmitL2TxRequest tx -> SubmitL2TxRequest tx -> Bool
$c/= :: forall tx.
Eq tx =>
SubmitL2TxRequest tx -> SubmitL2TxRequest tx -> Bool
/= :: SubmitL2TxRequest tx -> SubmitL2TxRequest tx -> Bool
Eq, Int -> SubmitL2TxRequest tx -> ShowS
[SubmitL2TxRequest tx] -> ShowS
SubmitL2TxRequest tx -> String
(Int -> SubmitL2TxRequest tx -> ShowS)
-> (SubmitL2TxRequest tx -> String)
-> ([SubmitL2TxRequest tx] -> ShowS)
-> Show (SubmitL2TxRequest tx)
forall tx. Show tx => Int -> SubmitL2TxRequest tx -> ShowS
forall tx. Show tx => [SubmitL2TxRequest tx] -> ShowS
forall tx. Show tx => SubmitL2TxRequest tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall tx. Show tx => Int -> SubmitL2TxRequest tx -> ShowS
showsPrec :: Int -> SubmitL2TxRequest tx -> ShowS
$cshow :: forall tx. Show tx => SubmitL2TxRequest tx -> String
show :: SubmitL2TxRequest tx -> String
$cshowList :: forall tx. Show tx => [SubmitL2TxRequest tx] -> ShowS
showList :: [SubmitL2TxRequest tx] -> ShowS
Show)
  deriving newtype ([SubmitL2TxRequest tx] -> Value
[SubmitL2TxRequest tx] -> Encoding
SubmitL2TxRequest tx -> Bool
SubmitL2TxRequest tx -> Value
SubmitL2TxRequest tx -> Encoding
(SubmitL2TxRequest tx -> Value)
-> (SubmitL2TxRequest tx -> Encoding)
-> ([SubmitL2TxRequest tx] -> Value)
-> ([SubmitL2TxRequest tx] -> Encoding)
-> (SubmitL2TxRequest tx -> Bool)
-> ToJSON (SubmitL2TxRequest tx)
forall tx. ToJSON tx => [SubmitL2TxRequest tx] -> Value
forall tx. ToJSON tx => [SubmitL2TxRequest tx] -> Encoding
forall tx. ToJSON tx => SubmitL2TxRequest tx -> Bool
forall tx. ToJSON tx => SubmitL2TxRequest tx -> Value
forall tx. ToJSON tx => SubmitL2TxRequest tx -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall tx. ToJSON tx => SubmitL2TxRequest tx -> Value
toJSON :: SubmitL2TxRequest tx -> Value
$ctoEncoding :: forall tx. ToJSON tx => SubmitL2TxRequest tx -> Encoding
toEncoding :: SubmitL2TxRequest tx -> Encoding
$ctoJSONList :: forall tx. ToJSON tx => [SubmitL2TxRequest tx] -> Value
toJSONList :: [SubmitL2TxRequest tx] -> Value
$ctoEncodingList :: forall tx. ToJSON tx => [SubmitL2TxRequest tx] -> Encoding
toEncodingList :: [SubmitL2TxRequest tx] -> Encoding
$comitField :: forall tx. ToJSON tx => SubmitL2TxRequest tx -> Bool
omitField :: SubmitL2TxRequest tx -> Bool
ToJSON, Maybe (SubmitL2TxRequest tx)
Value -> Parser [SubmitL2TxRequest tx]
Value -> Parser (SubmitL2TxRequest tx)
(Value -> Parser (SubmitL2TxRequest tx))
-> (Value -> Parser [SubmitL2TxRequest tx])
-> Maybe (SubmitL2TxRequest tx)
-> FromJSON (SubmitL2TxRequest tx)
forall tx. FromJSON tx => Maybe (SubmitL2TxRequest tx)
forall tx. FromJSON tx => Value -> Parser [SubmitL2TxRequest tx]
forall tx. FromJSON tx => Value -> Parser (SubmitL2TxRequest tx)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall tx. FromJSON tx => Value -> Parser (SubmitL2TxRequest tx)
parseJSON :: Value -> Parser (SubmitL2TxRequest tx)
$cparseJSONList :: forall tx. FromJSON tx => Value -> Parser [SubmitL2TxRequest tx]
parseJSONList :: Value -> Parser [SubmitL2TxRequest tx]
$comittedField :: forall tx. FromJSON tx => Maybe (SubmitL2TxRequest tx)
omittedField :: Maybe (SubmitL2TxRequest tx)
FromJSON)

deriving newtype instance (Typeable tx, ToCBOR tx) => ToCBOR (SubmitL2TxRequest tx)
deriving newtype instance (Typeable tx, FromCBOR tx) => FromCBOR (SubmitL2TxRequest tx)

-- | Response for transaction submission
data SubmitL2TxResponse
  = -- | Transaction was included in a confirmed snapshot
    SubmitTxConfirmed Integer
  | -- | Transaction was rejected due to validation errors
    SubmitTxInvalidResponse Text
  | -- | Transaction was rejected due to node out of sync
    SubmitTxRejectedResponse Text
  | -- | Transaction was accepted but not yet confirmed
    SubmitTxSubmitted
  deriving stock (SubmitL2TxResponse -> SubmitL2TxResponse -> Bool
(SubmitL2TxResponse -> SubmitL2TxResponse -> Bool)
-> (SubmitL2TxResponse -> SubmitL2TxResponse -> Bool)
-> Eq SubmitL2TxResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubmitL2TxResponse -> SubmitL2TxResponse -> Bool
== :: SubmitL2TxResponse -> SubmitL2TxResponse -> Bool
$c/= :: SubmitL2TxResponse -> SubmitL2TxResponse -> Bool
/= :: SubmitL2TxResponse -> SubmitL2TxResponse -> Bool
Eq, Int -> SubmitL2TxResponse -> ShowS
[SubmitL2TxResponse] -> ShowS
SubmitL2TxResponse -> String
(Int -> SubmitL2TxResponse -> ShowS)
-> (SubmitL2TxResponse -> String)
-> ([SubmitL2TxResponse] -> ShowS)
-> Show SubmitL2TxResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubmitL2TxResponse -> ShowS
showsPrec :: Int -> SubmitL2TxResponse -> ShowS
$cshow :: SubmitL2TxResponse -> String
show :: SubmitL2TxResponse -> String
$cshowList :: [SubmitL2TxResponse] -> ShowS
showList :: [SubmitL2TxResponse] -> ShowS
Show, (forall x. SubmitL2TxResponse -> Rep SubmitL2TxResponse x)
-> (forall x. Rep SubmitL2TxResponse x -> SubmitL2TxResponse)
-> Generic SubmitL2TxResponse
forall x. Rep SubmitL2TxResponse x -> SubmitL2TxResponse
forall x. SubmitL2TxResponse -> Rep SubmitL2TxResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubmitL2TxResponse -> Rep SubmitL2TxResponse x
from :: forall x. SubmitL2TxResponse -> Rep SubmitL2TxResponse x
$cto :: forall x. Rep SubmitL2TxResponse x -> SubmitL2TxResponse
to :: forall x. Rep SubmitL2TxResponse x -> SubmitL2TxResponse
Generic)

instance ToJSON SubmitL2TxResponse where
  toJSON :: SubmitL2TxResponse -> Value
toJSON = \case
    SubmitTxConfirmed Integer
snapshotNumber ->
      [Pair] -> Value
object
        [ Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"SubmitTxConfirmed"
        , Key
"snapshotNumber" Key -> Integer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Integer
snapshotNumber
        ]
    SubmitTxInvalidResponse Text
validationError ->
      [Pair] -> Value
object
        [ Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"SubmitTxInvalid"
        , Key
"validationError" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
validationError
        ]
    SubmitTxRejectedResponse Text
reason ->
      [Pair] -> Value
object
        [ Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"SubmitTxRejected"
        , Key
"reason" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
reason
        ]
    SubmitL2TxResponse
SubmitTxSubmitted -> [Pair] -> Value
object [Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"SubmitTxSubmitted"]

instance FromJSON SubmitL2TxResponse where
  parseJSON :: Value -> Parser SubmitL2TxResponse
parseJSON = String
-> (Object -> Parser SubmitL2TxResponse)
-> Value
-> Parser SubmitL2TxResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SubmitTxResponse" ((Object -> Parser SubmitL2TxResponse)
 -> Value -> Parser SubmitL2TxResponse)
-> (Object -> Parser SubmitL2TxResponse)
-> Value
-> Parser SubmitL2TxResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
tag <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag"
    case Text
tag :: Text of
      Text
"SubmitTxConfirmed" -> Integer -> SubmitL2TxResponse
SubmitTxConfirmed (Integer -> SubmitL2TxResponse)
-> Parser Integer -> Parser SubmitL2TxResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"snapshotNumber"
      Text
"SubmitTxInvalid" -> Text -> SubmitL2TxResponse
SubmitTxInvalidResponse (Text -> SubmitL2TxResponse)
-> Parser Text -> Parser SubmitL2TxResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"validationError"
      Text
"SubmitTxRejected" -> Text -> SubmitL2TxResponse
SubmitTxRejectedResponse (Text -> SubmitL2TxResponse)
-> Parser Text -> Parser SubmitL2TxResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reason"
      Text
"SubmitTxSubmitted" -> SubmitL2TxResponse -> Parser SubmitL2TxResponse
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubmitL2TxResponse
SubmitTxSubmitted
      Text
_ -> String -> Parser SubmitL2TxResponse
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected tag to be SubmitTxConfirmed, SubmitTxInvalid, SubmitTxRejected, or SubmitTxSubmitted"

-- NOTE: Tags are kept consistent with the JSON encoding above.
instance ToCBOR SubmitL2TxResponse where
  toCBOR :: SubmitL2TxResponse -> Encoding
toCBOR = \case
    SubmitTxConfirmed Integer
snapshotNumber ->
      Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"SubmitTxConfirmed" :: Text) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Integer
snapshotNumber
    SubmitTxInvalidResponse Text
validationError ->
      Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"SubmitTxInvalid" :: Text) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Text
validationError
    SubmitTxRejectedResponse Text
reason ->
      Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"SubmitTxRejected" :: Text) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Text
reason
    SubmitL2TxResponse
SubmitTxSubmitted ->
      Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"SubmitTxSubmitted" :: Text)

instance FromCBOR SubmitL2TxResponse where
  fromCBOR :: forall s. Decoder s SubmitL2TxResponse
fromCBOR =
    Decoder s Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Text
-> (Text -> Decoder s SubmitL2TxResponse)
-> Decoder s SubmitL2TxResponse
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
      (Text
"SubmitTxConfirmed" :: Text) -> Integer -> SubmitL2TxResponse
SubmitTxConfirmed (Integer -> SubmitL2TxResponse)
-> Decoder s Integer -> Decoder s SubmitL2TxResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Text
"SubmitTxInvalid" -> Text -> SubmitL2TxResponse
SubmitTxInvalidResponse (Text -> SubmitL2TxResponse)
-> Decoder s Text -> Decoder s SubmitL2TxResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Text
"SubmitTxRejected" -> Text -> SubmitL2TxResponse
SubmitTxRejectedResponse (Text -> SubmitL2TxResponse)
-> Decoder s Text -> Decoder s SubmitL2TxResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Text
"SubmitTxSubmitted" -> SubmitL2TxResponse -> Decoder s SubmitL2TxResponse
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubmitL2TxResponse
SubmitTxSubmitted
      Text
tag -> String -> Decoder s SubmitL2TxResponse
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s SubmitL2TxResponse)
-> String -> Decoder s SubmitL2TxResponse
forall a b. (a -> b) -> a -> b
$ Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
tag String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a proper CBOR-encoded SubmitL2TxResponse"

data HeadInitializationDetails
  = HeadInitializationDetails
  { HeadInitializationDetails -> UTCTime
time :: UTCTime
  , HeadInitializationDetails -> SlotNo
slot :: SlotNo
  }
  deriving stock (HeadInitializationDetails -> HeadInitializationDetails -> Bool
(HeadInitializationDetails -> HeadInitializationDetails -> Bool)
-> (HeadInitializationDetails -> HeadInitializationDetails -> Bool)
-> Eq HeadInitializationDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeadInitializationDetails -> HeadInitializationDetails -> Bool
== :: HeadInitializationDetails -> HeadInitializationDetails -> Bool
$c/= :: HeadInitializationDetails -> HeadInitializationDetails -> Bool
/= :: HeadInitializationDetails -> HeadInitializationDetails -> Bool
Eq, Int -> HeadInitializationDetails -> ShowS
[HeadInitializationDetails] -> ShowS
HeadInitializationDetails -> String
(Int -> HeadInitializationDetails -> ShowS)
-> (HeadInitializationDetails -> String)
-> ([HeadInitializationDetails] -> ShowS)
-> Show HeadInitializationDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeadInitializationDetails -> ShowS
showsPrec :: Int -> HeadInitializationDetails -> ShowS
$cshow :: HeadInitializationDetails -> String
show :: HeadInitializationDetails -> String
$cshowList :: [HeadInitializationDetails] -> ShowS
showList :: [HeadInitializationDetails] -> ShowS
Show)

jsonContent :: ResponseHeaders
jsonContent :: ResponseHeaders
jsonContent = [(HeaderName
hContentType, ByteString
"application/json")]

cborContent :: ResponseHeaders
cborContent :: ResponseHeaders
cborContent = [(HeaderName
hContentType, ByteString
"application/cbor")]

-- | Response body sent when an operation was accepted but did not finish
-- within the API transaction timeout.
data OperationTimedOut = OperationTimedOut
  { OperationTimedOut -> Text
tag :: Text
  , OperationTimedOut -> Text
timeoutMessage :: Text
  }
  deriving stock (OperationTimedOut -> OperationTimedOut -> Bool
(OperationTimedOut -> OperationTimedOut -> Bool)
-> (OperationTimedOut -> OperationTimedOut -> Bool)
-> Eq OperationTimedOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OperationTimedOut -> OperationTimedOut -> Bool
== :: OperationTimedOut -> OperationTimedOut -> Bool
$c/= :: OperationTimedOut -> OperationTimedOut -> Bool
/= :: OperationTimedOut -> OperationTimedOut -> Bool
Eq, Int -> OperationTimedOut -> ShowS
[OperationTimedOut] -> ShowS
OperationTimedOut -> String
(Int -> OperationTimedOut -> ShowS)
-> (OperationTimedOut -> String)
-> ([OperationTimedOut] -> ShowS)
-> Show OperationTimedOut
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OperationTimedOut -> ShowS
showsPrec :: Int -> OperationTimedOut -> ShowS
$cshow :: OperationTimedOut -> String
show :: OperationTimedOut -> String
$cshowList :: [OperationTimedOut] -> ShowS
showList :: [OperationTimedOut] -> ShowS
Show, (forall x. OperationTimedOut -> Rep OperationTimedOut x)
-> (forall x. Rep OperationTimedOut x -> OperationTimedOut)
-> Generic OperationTimedOut
forall x. Rep OperationTimedOut x -> OperationTimedOut
forall x. OperationTimedOut -> Rep OperationTimedOut x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OperationTimedOut -> Rep OperationTimedOut x
from :: forall x. OperationTimedOut -> Rep OperationTimedOut x
$cto :: forall x. Rep OperationTimedOut x -> OperationTimedOut
to :: forall x. Rep OperationTimedOut x -> OperationTimedOut
Generic)

-- NOTE: Encoded with a "timeout" key for backwards compatibility (the field
-- is named differently to avoid clashing with 'Hydra.Prelude.timeout').
instance ToJSON OperationTimedOut where
  toJSON :: OperationTimedOut -> Value
toJSON OperationTimedOut{Text
$sel:tag:OperationTimedOut :: OperationTimedOut -> Text
tag :: Text
tag, Text
$sel:timeoutMessage:OperationTimedOut :: OperationTimedOut -> Text
timeoutMessage :: Text
timeoutMessage} =
    [Pair] -> Value
object [Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tag, Key
"timeout" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
timeoutMessage]

instance FromJSON OperationTimedOut where
  parseJSON :: Value -> Parser OperationTimedOut
parseJSON = String
-> (Object -> Parser OperationTimedOut)
-> Value
-> Parser OperationTimedOut
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OperationTimedOut" ((Object -> Parser OperationTimedOut)
 -> Value -> Parser OperationTimedOut)
-> (Object -> Parser OperationTimedOut)
-> Value
-> Parser OperationTimedOut
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> OperationTimedOut
OperationTimedOut (Text -> Text -> OperationTimedOut)
-> Parser Text -> Parser (Text -> OperationTimedOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag" Parser (Text -> OperationTimedOut)
-> Parser Text -> Parser OperationTimedOut
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timeout"

instance ToCBOR OperationTimedOut where
  toCBOR :: OperationTimedOut -> Encoding
toCBOR OperationTimedOut{Text
$sel:tag:OperationTimedOut :: OperationTimedOut -> Text
tag :: Text
tag, Text
$sel:timeoutMessage:OperationTimedOut :: OperationTimedOut -> Text
timeoutMessage :: Text
timeoutMessage} =
    Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"OperationTimedOut" :: Text) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Text
tag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Text
timeoutMessage

instance FromCBOR OperationTimedOut where
  fromCBOR :: forall s. Decoder s OperationTimedOut
fromCBOR =
    Decoder s Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Text
-> (Text -> Decoder s OperationTimedOut)
-> Decoder s OperationTimedOut
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
      (Text
"OperationTimedOut" :: Text) -> Text -> Text -> OperationTimedOut
OperationTimedOut (Text -> Text -> OperationTimedOut)
-> Decoder s Text -> Decoder s (Text -> OperationTimedOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Text -> OperationTimedOut)
-> Decoder s Text -> Decoder s OperationTimedOut
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 Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Text
other -> String -> Decoder s OperationTimedOut
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s OperationTimedOut)
-> String -> Decoder s OperationTimedOut
forall a b. (a -> b) -> a -> b
$ Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
other String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a proper CBOR-encoded OperationTimedOut"

operationTimedOut :: Text -> ApiTransactionTimeout -> OperationTimedOut
operationTimedOut :: Text -> ApiTransactionTimeout -> OperationTimedOut
operationTimedOut Text
tag ApiTransactionTimeout
apiTransactionTimeout =
  OperationTimedOut
    { Text
$sel:tag:OperationTimedOut :: Text
tag :: Text
tag
    , $sel:timeoutMessage:OperationTimedOut :: Text
timeoutMessage = Text
"Operation timed out after " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (ApiTransactionTimeout -> String
forall b a. (Show a, IsString b) => a -> b
show ApiTransactionTimeout
apiTransactionTimeout) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" seconds"
    }

-- | Which encoding the client wants for the response, negotiated via the
-- @Accept@ header. Anything but @application/cbor@ (including no header)
-- yields JSON.
responseEncodingFor :: Request -> ApiEncoding
responseEncodingFor :: Request -> ApiEncoding
responseEncodingFor Request
request =
  case HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup HeaderName
hAccept (Request -> ResponseHeaders
requestHeaders Request
request) of
    Just ByteString
accept | ByteString
"application/cbor" ByteString -> ByteString -> Bool
`BS.isInfixOf` ByteString
accept -> ApiEncoding
CborEncoding
    Maybe ByteString
_ -> ApiEncoding
JsonEncoding

-- | Which encoding the request body uses, negotiated via the @Content-Type@
-- header. Anything but @application/cbor@ (including no header) is treated
-- as JSON.
requestEncodingFor :: Request -> ApiEncoding
requestEncodingFor :: Request -> ApiEncoding
requestEncodingFor Request
request =
  case HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup HeaderName
hContentType (Request -> ResponseHeaders
requestHeaders Request
request) of
    Just ByteString
contentType | ByteString
"application/cbor" ByteString -> ByteString -> Bool
`BS.isInfixOf` ByteString
contentType -> ApiEncoding
CborEncoding
    Maybe ByteString
_ -> ApiEncoding
JsonEncoding

-- | Respond in the given encoding, with matching @Content-Type@.
respondApi :: (ToJSON a, ToCBOR a) => ApiEncoding -> Status -> a -> Response
respondApi :: forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
apiEncoding Status
status a
a =
  Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status ResponseHeaders
contentType (ApiEncoding -> a -> ByteString
forall a. (ToJSON a, ToCBOR a) => ApiEncoding -> a -> ByteString
encodeWire ApiEncoding
apiEncoding a
a)
 where
  contentType :: ResponseHeaders
contentType = case ApiEncoding
apiEncoding of
    ApiEncoding
JsonEncoding -> ResponseHeaders
jsonContent
    ApiEncoding
CborEncoding -> ResponseHeaders
cborContent

-- | Hydra HTTP server
httpApp ::
  forall tx.
  IsChainState tx =>
  Tracer IO APIServerLog ->
  -- | Pre-rendered effective configuration (served at GET /config).
  Aeson.Value ->
  Chain tx IO ->
  Environment ->
  PParams LedgerEra ->
  -- | Get latest 'NodeState'.
  IO (NodeState tx) ->
  -- | A means to get commit info.
  IO CommitInfo ->
  -- | Get the pending commits (deposits)
  IO [TxIdType tx] ->
  -- | Callback to yield a 'ClientInput' to the main event loop.
  (ClientInput tx -> IO ()) ->
  -- | Timeout for transaction submission
  ApiTransactionTimeout ->
  -- | Channel to listen for events
  TChan (Either (TimedServerOutput tx) (ClientMessage tx)) ->
  Application
httpApp :: forall tx.
IsChainState tx =>
Tracer IO APIServerLog
-> Value
-> Chain tx IO
-> Environment
-> PParams LedgerEra
-> IO (NodeState tx)
-> IO CommitInfo
-> IO [TxIdType tx]
-> (ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> Application
httpApp Tracer IO APIServerLog
tracer Value
configDoc Chain tx IO
directChain Environment
env PParams LedgerEra
pparams IO (NodeState tx)
getNodeState IO CommitInfo
getCommitInfo IO [TxIdType tx]
getPendingDeposits ClientInput tx -> IO ()
putClientInput ApiTransactionTimeout
apiTransactionTimeout TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel Request
request Response -> IO ResponseReceived
respond = do
  Tracer IO APIServerLog -> APIServerLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO APIServerLog
tracer (APIServerLog -> IO ()) -> APIServerLog -> IO ()
forall a b. (a -> b) -> a -> b
$
    APIHTTPRequestReceived
      { $sel:method:APIServerStarted :: Method
method = ByteString -> Method
Method (ByteString -> Method) -> ByteString -> Method
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
requestMethod Request
request
      , $sel:path:APIServerStarted :: PathInfo
path = ByteString -> PathInfo
PathInfo (ByteString -> PathInfo) -> ByteString -> PathInfo
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
rawPathInfo Request
request
      }
  case (Request -> ByteString
requestMethod Request
request, Request -> [Text]
pathInfo Request
request) of
    (ByteString
"GET", [Text
"config"]) ->
      Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Value -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200 Value
configDoc
    (ByteString
"GET", [Text
"head"]) ->
      IO (NodeState tx)
getNodeState IO (NodeState tx)
-> (NodeState tx -> IO ResponseReceived) -> IO ResponseReceived
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> (HeadState tx -> Response)
-> HeadState tx
-> IO ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiEncoding -> Status -> HeadState tx -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200) (HeadState tx -> IO ResponseReceived)
-> (NodeState tx -> HeadState tx)
-> NodeState tx
-> IO ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeState tx -> HeadState tx
forall tx. NodeState tx -> HeadState tx
headState
    (ByteString
"GET", [Text
"snapshot"]) -> do
      HeadState tx
hs <- NodeState tx -> HeadState tx
forall tx. NodeState tx -> HeadState tx
headState (NodeState tx -> HeadState tx)
-> IO (NodeState tx) -> IO (HeadState tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (NodeState tx)
getNodeState
      case HeadState tx -> Maybe (ConfirmedSnapshot tx)
forall tx. HeadState tx -> Maybe (ConfirmedSnapshot tx)
getConfirmedSnapshot HeadState tx
hs of
        Just ConfirmedSnapshot tx
confirmedSnapshot -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> ConfirmedSnapshot tx -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200 ConfirmedSnapshot tx
confirmedSnapshot
        Maybe (ConfirmedSnapshot tx)
Nothing -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Response
notFound ApiEncoding
respEnc
    (ByteString
"GET", [Text
"snapshot", Text
"utxo"]) -> do
      HeadState tx
hs <- NodeState tx -> HeadState tx
forall tx. NodeState tx -> HeadState tx
headState (NodeState tx -> HeadState tx)
-> IO (NodeState tx) -> IO (HeadState tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (NodeState tx)
getNodeState
      case HeadState tx -> Maybe (UTxOType tx)
forall tx. IsTx tx => HeadState tx -> Maybe (UTxOType tx)
getSnapshotUtxo HeadState tx
hs of
        Just UTxOType tx
utxo -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> UTxOType tx -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200 UTxOType tx
utxo
        Maybe (UTxOType tx)
_ -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Response
notFound ApiEncoding
respEnc
    (ByteString
"GET", [Text
"snapshot", Text
"last-seen"]) -> do
      HeadState tx
hs <- NodeState tx -> HeadState tx
forall tx. NodeState tx -> HeadState tx
headState (NodeState tx -> HeadState tx)
-> IO (NodeState tx) -> IO (HeadState tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (NodeState tx)
getNodeState
      Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> (SeenSnapshot tx -> Response)
-> SeenSnapshot tx
-> IO ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiEncoding -> Status -> SeenSnapshot tx -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200 (SeenSnapshot tx -> IO ResponseReceived)
-> SeenSnapshot tx -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ HeadState tx -> SeenSnapshot tx
forall tx. IsTx tx => HeadState tx -> SeenSnapshot tx
getSeenSnapshot HeadState tx
hs
    (ByteString
"POST", [Text
"snapshot"]) ->
      Request -> IO ByteString
consumeRequestBodyStrict Request
request
        IO ByteString -> (ByteString -> IO Response) -> IO Response
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
forall tx.
IsChainState tx =>
(ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
handleSideLoadSnapshot ClientInput tx -> IO ()
putClientInput ApiTransactionTimeout
apiTransactionTimeout TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel ApiEncoding
reqEnc ApiEncoding
respEnc
        IO Response
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO ResponseReceived
respond
    (ByteString
"POST", [Text
"commit"]) ->
      Request -> IO ByteString
consumeRequestBodyStrict Request
request
        IO ByteString -> (ByteString -> IO Response) -> IO Response
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tracer IO APIServerLog
-> Environment
-> PParams LedgerEra
-> Chain tx IO
-> IO (NodeState tx)
-> IO CommitInfo
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
forall tx.
IsChainState tx =>
Tracer IO APIServerLog
-> Environment
-> PParams LedgerEra
-> Chain tx IO
-> IO (NodeState tx)
-> IO CommitInfo
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
handleDraftCommitUtxo Tracer IO APIServerLog
tracer Environment
env PParams LedgerEra
pparams Chain tx IO
directChain IO (NodeState tx)
getNodeState IO CommitInfo
getCommitInfo ApiEncoding
reqEnc ApiEncoding
respEnc
        IO Response
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO ResponseReceived
respond
    (ByteString
"DELETE", [Text
"commits", Text
_]) ->
      Request -> IO ByteString
consumeRequestBodyStrict Request
request
        IO ByteString -> (ByteString -> IO Response) -> IO Response
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> Text
-> ApiEncoding
-> ByteString
-> IO Response
forall tx.
IsChainState tx =>
(ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> Text
-> ApiEncoding
-> ByteString
-> IO Response
handleRecoverCommitUtxo ClientInput tx -> IO ()
putClientInput ApiTransactionTimeout
apiTransactionTimeout TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel (NonEmpty Text -> Text
forall (f :: * -> *) a. IsNonEmpty f a a "last" => f a -> a
last (NonEmpty Text -> Text)
-> ([Text] -> NonEmpty Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (NonEmpty Text)] -> NonEmpty Text
[Text] -> NonEmpty Text
forall l. IsList l => [Item l] -> l
fromList ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Request -> [Text]
pathInfo Request
request) ApiEncoding
respEnc
        IO Response
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO ResponseReceived
respond
    (ByteString
"GET", [Text
"commits"]) ->
      IO [TxIdType tx]
getPendingDeposits IO [TxIdType tx]
-> ([TxIdType tx] -> IO ResponseReceived) -> IO ResponseReceived
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> ([TxIdType tx] -> Response)
-> [TxIdType tx]
-> IO ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiEncoding -> Status -> [TxIdType tx] -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200
    (ByteString
"POST", [Text
"decommit"]) ->
      Request -> IO ByteString
consumeRequestBodyStrict Request
request
        IO ByteString -> (ByteString -> IO Response) -> IO Response
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
forall tx.
(FromJSON tx, FromCBOR tx) =>
(ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
handleDecommit ClientInput tx -> IO ()
putClientInput ApiTransactionTimeout
apiTransactionTimeout TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel ApiEncoding
reqEnc ApiEncoding
respEnc
        IO Response
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO ResponseReceived
respond
    (ByteString
"GET", [Text
"protocol-parameters"]) ->
      Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> PParams LedgerEra -> Response
respondPParams ApiEncoding
respEnc PParams LedgerEra
pparams
    (ByteString
"POST", [Text
"cardano-transaction"]) ->
      Request -> IO ByteString
consumeRequestBodyStrict Request
request
        IO ByteString -> (ByteString -> IO Response) -> IO Response
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Chain tx IO
-> ApiEncoding -> ApiEncoding -> ByteString -> IO Response
forall tx.
(FromJSON tx, FromCBOR tx) =>
Chain tx IO
-> ApiEncoding -> ApiEncoding -> ByteString -> IO Response
handleSubmitUserTx Chain tx IO
directChain ApiEncoding
reqEnc ApiEncoding
respEnc
        IO Response
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO ResponseReceived
respond
    (ByteString
"POST", [Text
"transaction"]) ->
      Request -> IO ByteString
consumeRequestBodyStrict Request
request
        IO ByteString -> (ByteString -> IO Response) -> IO Response
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
forall tx.
IsChainState tx =>
(ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
handleSubmitL2Tx ClientInput tx -> IO ()
putClientInput ApiTransactionTimeout
apiTransactionTimeout TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel ApiEncoding
reqEnc ApiEncoding
respEnc
        IO Response
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response -> IO ResponseReceived
respond
    (ByteString, [Text])
_ ->
      Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (Text
"Resource not found" :: Text)
 where
  reqEnc :: ApiEncoding
reqEnc = Request -> ApiEncoding
requestEncodingFor Request
request
  respEnc :: ApiEncoding
respEnc = Request -> ApiEncoding
responseEncodingFor Request
request

-- | Respond with protocol parameters; the ledger 'PParams' have no plain
-- 'ToCBOR' instance, so the CBOR case goes through the ledger's 'EncCBOR'.
respondPParams :: ApiEncoding -> PParams LedgerEra -> Response
respondPParams :: ApiEncoding -> PParams LedgerEra -> Response
respondPParams ApiEncoding
apiEncoding PParams LedgerEra
pparams =
  case ApiEncoding
apiEncoding of
    ApiEncoding
JsonEncoding -> Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 ResponseHeaders
jsonContent (PParams ConwayEra -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode PParams ConwayEra
PParams LedgerEra
pparams)
    ApiEncoding
CborEncoding ->
      Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 ResponseHeaders
cborContent (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$
        Encoding -> ByteString
CBOR.toLazyByteString (Version -> Encoding -> Encoding
toPlainEncoding Version
ledgerEraVersion (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ PParams ConwayEra -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR PParams ConwayEra
PParams LedgerEra
pparams)

-- * Handlers

-- FIXME: Api specification for /commit is broken in the spec/docs.

-- | Handle request to obtain a draft commit tx.
handleDraftCommitUtxo ::
  forall tx.
  IsChainState tx =>
  Tracer IO APIServerLog ->
  Environment ->
  PParams LedgerEra ->
  Chain tx IO ->
  -- | Get latest 'NodeState'.
  IO (NodeState tx) ->
  -- | A means to get commit info.
  IO CommitInfo ->
  -- | Request body encoding.
  ApiEncoding ->
  -- | Response encoding.
  ApiEncoding ->
  -- | Request body.
  LBS.ByteString ->
  IO Response
handleDraftCommitUtxo :: forall tx.
IsChainState tx =>
Tracer IO APIServerLog
-> Environment
-> PParams LedgerEra
-> Chain tx IO
-> IO (NodeState tx)
-> IO CommitInfo
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
handleDraftCommitUtxo Tracer IO APIServerLog
tracer Environment
env PParams LedgerEra
pparams Chain tx IO
directChain IO (NodeState tx)
getNodeState IO CommitInfo
getCommitInfo ApiEncoding
reqEnc ApiEncoding
respEnc ByteString
body = do
  case ApiEncoding
-> ByteString -> Either String (DraftCommitTxRequest tx)
forall a.
(FromJSON a, FromCBOR a) =>
ApiEncoding -> ByteString -> Either String a
decodeWire ApiEncoding
reqEnc ByteString
body :: Either String (DraftCommitTxRequest tx) of
    Left String
err -> do
      Tracer IO APIServerLog -> APIServerLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO APIServerLog
tracer (APIServerLog -> IO ()) -> APIServerLog -> IO ()
forall a b. (a -> b) -> a -> b
$
        APIInvalidInput
          { $sel:reason:APIServerStarted :: String
reason = String
"Failed to parse request to DraftCommitTxRequest: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall b a. (Show a, IsString b) => a -> b
show String
err
          , $sel:inputReceived:APIServerStarted :: Text
inputReceived = ByteString -> Text
forall b a. (Show a, IsString b) => a -> b
show ByteString
body
          }
      Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (String -> Text
pack String
err)
    Right DraftCommitTxRequest tx
someCommitRequest ->
      IO CommitInfo
getCommitInfo IO CommitInfo -> (CommitInfo -> IO Response) -> IO Response
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        IncrementalCommit HeadId
headId -> do
          case DraftCommitTxRequest tx
someCommitRequest of
            FullCommitRequest{tx
$sel:blueprintTx:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> tx
blueprintTx :: tx
blueprintTx, UTxOType tx
$sel:utxo:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> UTxOType tx
utxo :: UTxOType tx
utxo, Maybe AddressInEra
$sel:changeAddress:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> Maybe AddressInEra
changeAddress :: Maybe AddressInEra
changeAddress} -> do
              HeadId -> CommitBlueprintTx tx -> Maybe AddressInEra -> IO Response
deposit HeadId
headId CommitBlueprintTx{tx
blueprintTx :: tx
$sel:blueprintTx:CommitBlueprintTx :: tx
blueprintTx, $sel:lookupUTxO:CommitBlueprintTx :: UTxOType tx
lookupUTxO = UTxOType tx
utxo} Maybe AddressInEra
changeAddress
            SimpleCommitRequest{UTxOType tx
$sel:utxoToCommit:SimpleCommitRequest :: forall tx. DraftCommitTxRequest tx -> UTxOType tx
utxoToCommit :: UTxOType tx
utxoToCommit} ->
              HeadId -> CommitBlueprintTx tx -> Maybe AddressInEra -> IO Response
deposit HeadId
headId CommitBlueprintTx{$sel:blueprintTx:CommitBlueprintTx :: tx
blueprintTx = UTxOType tx -> tx
forall tx. IsTx tx => UTxOType tx -> tx
txSpendingUTxO UTxOType tx
utxoToCommit, $sel:lookupUTxO:CommitBlueprintTx :: UTxOType tx
lookupUTxO = UTxOType tx
utxoToCommit} Maybe AddressInEra
forall a. Maybe a
Nothing
        CommitInfo
CannotCommit -> do
          Tracer IO APIServerLog -> APIServerLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO APIServerLog
tracer (APIServerLog -> IO ()) -> APIServerLog -> IO ()
forall a b. (a -> b) -> a -> b
$
            APIInvalidInput
              { $sel:reason:APIServerStarted :: String
reason = String
"CannotCommit: Hydra node does not have an open Head."
              , $sel:inputReceived:APIServerStarted :: Text
inputReceived = ByteString -> Text
forall b a. (Show a, IsString b) => a -> b
show ByteString
body
              }
          Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (Text
"Head is not open" :: Text)
 where
  deposit :: HeadId -> CommitBlueprintTx tx -> Maybe AddressInEra -> IO Response
deposit HeadId
headId CommitBlueprintTx tx
commitBlueprint Maybe AddressInEra
changeAddress = do
    NodeState tx
nodeState <- IO (NodeState tx)
getNodeState
    case HeadState tx -> Maybe (ConfirmedSnapshot tx)
forall tx. HeadState tx -> Maybe (ConfirmedSnapshot tx)
getConfirmedSnapshot (NodeState tx -> HeadState tx
forall tx. NodeState tx -> HeadState tx
headState NodeState tx
nodeState) of
      Maybe (ConfirmedSnapshot tx)
Nothing -> do
        Tracer IO APIServerLog -> APIServerLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO APIServerLog
tracer (APIServerLog -> IO ()) -> APIServerLog -> IO ()
forall a b. (a -> b) -> a -> b
$
          APIInvalidInput
            { $sel:reason:APIServerStarted :: String
reason = String
"Cannot commit: Hydra node does not have an open Head."
            , $sel:inputReceived:APIServerStarted :: Text
inputReceived = ByteString -> Text
forall b a. (Show a, IsString b) => a -> b
show ByteString
body
            }
        Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (Text
"Head is not open" :: Text)
      Just ConfirmedSnapshot tx
currentSnapshot -> do
        -- NOTE: The deadline splits into three independent windows: a deposit
        -- matures (becomes active) after 'depositActivation', stays active for one
        -- 'depositPeriod', and can be recovered one 'depositPeriod' before the
        -- deadline. Hence deadline = now + depositActivation + 2 x depositPeriod.
        UTCTime
deadline <-
          NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (DepositPeriod -> NominalDiffTime
toNominalDiffTime DepositPeriod
depositActivation NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
2 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* DepositPeriod -> NominalDiffTime
toNominalDiffTime DepositPeriod
depositPeriod)
            (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
        Either (PostTxError tx) tx
result <- MonadThrow IO =>
HeadId
-> PParams LedgerEra
-> ConfirmedSnapshot tx
-> CommitBlueprintTx tx
-> UTCTime
-> Maybe AddressInEra
-> IO (Either (PostTxError tx) tx)
HeadId
-> PParams LedgerEra
-> ConfirmedSnapshot tx
-> CommitBlueprintTx tx
-> UTCTime
-> Maybe AddressInEra
-> IO (Either (PostTxError tx) tx)
draftDepositTx HeadId
headId PParams LedgerEra
pparams ConfirmedSnapshot tx
currentSnapshot CommitBlueprintTx tx
commitBlueprint UTCTime
deadline Maybe AddressInEra
changeAddress
        case Either (PostTxError tx) tx
result of
          Left PostTxError tx
e ->
            case PostTxError tx
e of
              UnsupportedLegacyOutput Address ByronAddr
_ -> Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> PostTxError tx -> Response
forall tx.
IsChainState tx =>
ApiEncoding -> PostTxError tx -> Response
badRequest ApiEncoding
respEnc PostTxError tx
e
              DepositTooLow Coin
_ Coin
_ -> Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> PostTxError tx -> Response
forall tx.
IsChainState tx =>
ApiEncoding -> PostTxError tx -> Response
badRequest ApiEncoding
respEnc PostTxError tx
e
              DepositTooLarge{} -> Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> PostTxError tx -> Response
forall tx.
IsChainState tx =>
ApiEncoding -> PostTxError tx -> Response
badRequest ApiEncoding
respEnc PostTxError tx
e
              FailedToConstructDepositTx Text
_ -> Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> PostTxError tx -> Response
forall tx.
IsChainState tx =>
ApiEncoding -> PostTxError tx -> Response
badRequest ApiEncoding
respEnc PostTxError tx
e
              PostTxError tx
_ -> do
                Tracer IO APIServerLog -> APIServerLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO APIServerLog
tracer (APIServerLog -> IO ()) -> APIServerLog -> IO ()
forall a b. (a -> b) -> a -> b
$
                  APIReturnedError
                    { $sel:reason:APIServerStarted :: String
reason = String
"Failed to draft deposit transaction: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PostTxError tx -> String
forall b a. (Show a, IsString b) => a -> b
show PostTxError tx
e
                    }
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> PostTxError tx -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status500 PostTxError tx
e
          Right tx
depositTx -> Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> DraftCommitTxResponse tx -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200 (DraftCommitTxResponse tx -> Response)
-> DraftCommitTxResponse tx -> Response
forall a b. (a -> b) -> a -> b
$ tx -> DraftCommitTxResponse tx
forall tx. tx -> DraftCommitTxResponse tx
DraftCommitTxResponse tx
depositTx

  Chain{MonadThrow IO =>
HeadId
-> PParams LedgerEra
-> ConfirmedSnapshot tx
-> CommitBlueprintTx tx
-> UTCTime
-> Maybe AddressInEra
-> IO (Either (PostTxError tx) tx)
draftDepositTx :: MonadThrow IO =>
HeadId
-> PParams LedgerEra
-> ConfirmedSnapshot tx
-> CommitBlueprintTx tx
-> UTCTime
-> Maybe AddressInEra
-> IO (Either (PostTxError tx) tx)
$sel:draftDepositTx:Chain :: forall tx (m :: * -> *).
Chain tx m
-> MonadThrow m =>
   HeadId
   -> PParams LedgerEra
   -> ConfirmedSnapshot tx
   -> CommitBlueprintTx tx
   -> UTCTime
   -> Maybe AddressInEra
   -> m (Either (PostTxError tx) tx)
draftDepositTx} = Chain tx IO
directChain

  Environment{DepositPeriod
depositPeriod :: DepositPeriod
$sel:depositPeriod:Environment :: Environment -> DepositPeriod
depositPeriod, DepositPeriod
depositActivation :: DepositPeriod
$sel:depositActivation:Environment :: Environment -> DepositPeriod
depositActivation} = Environment
env

-- | Handle request to recover a pending deposit.
handleRecoverCommitUtxo ::
  forall tx.
  IsChainState tx =>
  (ClientInput tx -> IO ()) ->
  ApiTransactionTimeout ->
  TChan (Either (TimedServerOutput tx) (ClientMessage tx)) ->
  Text ->
  ApiEncoding ->
  LBS.ByteString ->
  IO Response
handleRecoverCommitUtxo :: forall tx.
IsChainState tx =>
(ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> Text
-> ApiEncoding
-> ByteString
-> IO Response
handleRecoverCommitUtxo ClientInput tx -> IO ()
putClientInput ApiTransactionTimeout
apiTransactionTimeout TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel Text
recoverPath ApiEncoding
respEnc ByteString
_body = do
  case Text -> Either Response (TxIdType tx)
parseTxIdFromPath Text
recoverPath of
    Left Response
err -> Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
err
    Right TxIdType tx
recoverTxId -> do
      TChan (Either (TimedServerOutput tx) (ClientMessage tx))
dupChannel <- STM IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
-> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
 -> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx))))
-> STM
     IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
-> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a b. (a -> b) -> a -> b
$ TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> STM (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a. TChan a -> STM (TChan a)
dupTChan TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel
      ClientInput tx -> IO ()
putClientInput Recover{TxIdType tx
recoverTxId :: TxIdType tx
$sel:recoverTxId:Init :: TxIdType tx
recoverTxId}
      let wait :: IO Response
wait = do
            Either (TimedServerOutput tx) (ClientMessage tx)
event <- STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
-> IO (Either (TimedServerOutput tx) (ClientMessage tx))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
 -> IO (Either (TimedServerOutput tx) (ClientMessage tx)))
-> STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
-> IO (Either (TimedServerOutput tx) (ClientMessage tx))
forall a b. (a -> b) -> a -> b
$ TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> STM (Either (TimedServerOutput tx) (ClientMessage tx))
forall a. TChan a -> STM a
readTChan TChan (Either (TimedServerOutput tx) (ClientMessage tx))
dupChannel
            case Either (TimedServerOutput tx) (ClientMessage tx)
event of
              Left TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = CommitRecovered{}} ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200 (Text
"OK" :: Text)
              Right (CommandFailed{$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput = Recover{}}) ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (Text
"Recover failed" :: Text)
              Right (RejectedInputBecauseUnsynced{$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput = Recover{}, NominalDiffTime
drift :: NominalDiffTime
$sel:drift:CommandFailed :: forall tx. ClientMessage tx -> NominalDiffTime
drift}) ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status503 (Text
"Recover failed because node is out of sync with chain, drift: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show NominalDiffTime
drift :: Text)
              Either (TimedServerOutput tx) (ClientMessage tx)
_ -> IO Response
wait
      DiffTime -> IO Response -> IO (Maybe Response)
forall a. DiffTime -> IO a -> IO (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout (NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (ApiTransactionTimeout -> NominalDiffTime
apiTransactionTimeoutNominalDiffTime ApiTransactionTimeout
apiTransactionTimeout)) IO Response
wait IO (Maybe Response)
-> (Maybe Response -> IO Response) -> IO Response
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Response
r -> Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
r
        Maybe Response
Nothing ->
          Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> OperationTimedOut -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status202 (OperationTimedOut -> Response) -> OperationTimedOut -> Response
forall a b. (a -> b) -> a -> b
$ Text -> ApiTransactionTimeout -> OperationTimedOut
operationTimedOut Text
"RecoverSubmitted" ApiTransactionTimeout
apiTransactionTimeout
 where
  parseTxIdFromPath :: Text -> Either Response (TxIdType tx)
  parseTxIdFromPath :: Text -> Either Response (TxIdType tx)
parseTxIdFromPath Text
txIdStr =
    -- First try parsing as a raw JSON value (for backwards compatibility with numeric IDs)
    -- then fall back to parsing as a JSON String (for hex-encoded TxIds)
    case ByteString -> Either String (TxIdType tx)
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
txIdStr) of
      Right TxIdType tx
txid -> TxIdType tx -> Either Response (TxIdType tx)
forall a b. b -> Either a b
Right TxIdType tx
txid
      Left String
_ -> case (Value -> Parser (TxIdType tx))
-> Value -> Either String (TxIdType tx)
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser (TxIdType tx)
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Value
Aeson.String Text
txIdStr) of
        Right TxIdType tx
txid -> TxIdType tx -> Either Response (TxIdType tx)
forall a b. b -> Either a b
Right TxIdType tx
txid
        Left String
e -> Response -> Either Response (TxIdType tx)
forall a b. a -> Either a b
Left (Response -> Either Response (TxIdType tx))
-> Response -> Either Response (TxIdType tx)
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (Text
"Cannot recover funds. Failed to parse TxId: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
e)

-- | Handle request to submit a cardano transaction.
handleSubmitUserTx ::
  forall tx.
  (FromJSON tx, FromCBOR tx) =>
  Chain tx IO ->
  -- | Request body encoding.
  ApiEncoding ->
  -- | Response encoding.
  ApiEncoding ->
  -- | Request body.
  LBS.ByteString ->
  IO Response
handleSubmitUserTx :: forall tx.
(FromJSON tx, FromCBOR tx) =>
Chain tx IO
-> ApiEncoding -> ApiEncoding -> ByteString -> IO Response
handleSubmitUserTx Chain tx IO
directChain ApiEncoding
reqEnc ApiEncoding
respEnc ByteString
body = do
  case ApiEncoding -> ByteString -> Either String tx
forall a.
(FromJSON a, FromCBOR a) =>
ApiEncoding -> ByteString -> Either String a
decodeWire ApiEncoding
reqEnc ByteString
body of
    Left String
err ->
      Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (String -> Text
pack String
err)
    Right tx
txToSubmit -> do
      IO () -> IO (Either (PostTxError Tx) ())
forall e a. Exception e => IO a -> IO (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (tx -> IO ()
MonadThrow IO => tx -> IO ()
submitTx tx
txToSubmit) IO (Either (PostTxError Tx) ())
-> (Either (PostTxError Tx) () -> Response) -> IO Response
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Left (PostTxError Tx
e :: PostTxError Tx) -> ApiEncoding -> PostTxError Tx -> Response
forall tx.
IsChainState tx =>
ApiEncoding -> PostTxError tx -> Response
badRequest ApiEncoding
respEnc PostTxError Tx
e
        Right ()
_ ->
          ApiEncoding -> Status -> TransactionSubmitted -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200 TransactionSubmitted
TransactionSubmitted
 where
  Chain{MonadThrow IO => tx -> IO ()
submitTx :: MonadThrow IO => tx -> IO ()
$sel:submitTx:Chain :: forall tx (m :: * -> *). Chain tx m -> MonadThrow m => tx -> m ()
submitTx} = Chain tx IO
directChain

handleDecommit ::
  forall tx.
  (FromJSON tx, FromCBOR tx) =>
  (ClientInput tx -> IO ()) ->
  ApiTransactionTimeout ->
  TChan (Either (TimedServerOutput tx) (ClientMessage tx)) ->
  ApiEncoding ->
  ApiEncoding ->
  LBS.ByteString ->
  IO Response
handleDecommit :: forall tx.
(FromJSON tx, FromCBOR tx) =>
(ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
handleDecommit ClientInput tx -> IO ()
putClientInput ApiTransactionTimeout
apiTransactionTimeout TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel ApiEncoding
reqEnc ApiEncoding
respEnc ByteString
body =
  case ApiEncoding -> ByteString -> Either String tx
forall a.
(FromJSON a, FromCBOR a) =>
ApiEncoding -> ByteString -> Either String a
decodeWire ApiEncoding
reqEnc ByteString
body :: Either String tx of
    Left String
err ->
      Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (String -> Text
pack String
err)
    Right tx
decommitTx -> do
      TChan (Either (TimedServerOutput tx) (ClientMessage tx))
dupChannel <- STM IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
-> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
 -> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx))))
-> STM
     IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
-> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a b. (a -> b) -> a -> b
$ TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> STM (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a. TChan a -> STM (TChan a)
dupTChan TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel
      ClientInput tx -> IO ()
putClientInput Decommit{tx
decommitTx :: tx
$sel:decommitTx:Init :: tx
decommitTx}
      let wait :: IO Response
wait = do
            Either (TimedServerOutput tx) (ClientMessage tx)
event <- STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
-> IO (Either (TimedServerOutput tx) (ClientMessage tx))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
 -> IO (Either (TimedServerOutput tx) (ClientMessage tx)))
-> STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
-> IO (Either (TimedServerOutput tx) (ClientMessage tx))
forall a b. (a -> b) -> a -> b
$ TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> STM (Either (TimedServerOutput tx) (ClientMessage tx))
forall a. TChan a -> STM a
readTChan TChan (Either (TimedServerOutput tx) (ClientMessage tx))
dupChannel
            case Either (TimedServerOutput tx) (ClientMessage tx)
event of
              Left TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = DecommitFinalized{}} ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200 (Text
"OK" :: Text)
              Left TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = DecommitInvalid{}} ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (Text
"Decommit invalid" :: Text)
              Right (CommandFailed{$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput = Decommit{}}) ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (Text
"Decommit failed" :: Text)
              Right (RejectedInputBecauseUnsynced{$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput = Decommit{}, NominalDiffTime
$sel:drift:CommandFailed :: forall tx. ClientMessage tx -> NominalDiffTime
drift :: NominalDiffTime
drift}) ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status503 (Text
"Decommit failed because because node is out of sync with chain, drift: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show NominalDiffTime
drift :: Text)
              Either (TimedServerOutput tx) (ClientMessage tx)
_ -> IO Response
wait
      DiffTime -> IO Response -> IO (Maybe Response)
forall a. DiffTime -> IO a -> IO (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout (NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (ApiTransactionTimeout -> NominalDiffTime
apiTransactionTimeoutNominalDiffTime ApiTransactionTimeout
apiTransactionTimeout)) IO Response
wait IO (Maybe Response)
-> (Maybe Response -> IO Response) -> IO Response
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Response
r -> Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
r
        Maybe Response
Nothing ->
          Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> OperationTimedOut -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status202 (OperationTimedOut -> Response) -> OperationTimedOut -> Response
forall a b. (a -> b) -> a -> b
$ Text -> ApiTransactionTimeout -> OperationTimedOut
operationTimedOut Text
"DecommitSubmitted" ApiTransactionTimeout
apiTransactionTimeout

-- | Handle request to side load confirmed snapshot.
handleSideLoadSnapshot ::
  forall tx.
  IsChainState tx =>
  (ClientInput tx -> IO ()) ->
  ApiTransactionTimeout ->
  TChan (Either (TimedServerOutput tx) (ClientMessage tx)) ->
  ApiEncoding ->
  ApiEncoding ->
  LBS.ByteString ->
  IO Response
handleSideLoadSnapshot :: forall tx.
IsChainState tx =>
(ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
handleSideLoadSnapshot ClientInput tx -> IO ()
putClientInput ApiTransactionTimeout
apiTransactionTimeout TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel ApiEncoding
reqEnc ApiEncoding
respEnc ByteString
body = do
  case ApiEncoding
-> ByteString -> Either String (SideLoadSnapshotRequest tx)
forall a.
(FromJSON a, FromCBOR a) =>
ApiEncoding -> ByteString -> Either String a
decodeWire ApiEncoding
reqEnc ByteString
body :: Either String (SideLoadSnapshotRequest tx) of
    Left String
err ->
      Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (String -> Text
pack String
err)
    Right SideLoadSnapshotRequest{ConfirmedSnapshot tx
$sel:snapshot:SideLoadSnapshotRequest :: forall tx. SideLoadSnapshotRequest tx -> ConfirmedSnapshot tx
snapshot :: ConfirmedSnapshot tx
snapshot} -> do
      TChan (Either (TimedServerOutput tx) (ClientMessage tx))
dupChannel <- STM IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
-> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
 -> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx))))
-> STM
     IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
-> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a b. (a -> b) -> a -> b
$ TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> STM (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a. TChan a -> STM (TChan a)
dupTChan TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel
      ClientInput tx -> IO ()
putClientInput (ClientInput tx -> IO ()) -> ClientInput tx -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfirmedSnapshot tx -> ClientInput tx
forall tx. ConfirmedSnapshot tx -> ClientInput tx
SideLoadSnapshot ConfirmedSnapshot tx
snapshot
      let wait :: IO Response
wait = do
            Either (TimedServerOutput tx) (ClientMessage tx)
event <- STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
-> IO (Either (TimedServerOutput tx) (ClientMessage tx))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
 -> IO (Either (TimedServerOutput tx) (ClientMessage tx)))
-> STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
-> IO (Either (TimedServerOutput tx) (ClientMessage tx))
forall a b. (a -> b) -> a -> b
$ TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> STM (Either (TimedServerOutput tx) (ClientMessage tx))
forall a. TChan a -> STM a
readTChan TChan (Either (TimedServerOutput tx) (ClientMessage tx))
dupChannel
            case Either (TimedServerOutput tx) (ClientMessage tx)
event of
              Left TimedServerOutput{$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output = SnapshotSideLoaded{}} ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200 (Text
"OK" :: Text)
              Right (SideLoadSnapshotRejected{$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput = SideLoadSnapshot{}, SideLoadRequirementFailure tx
requirementFailure :: SideLoadRequirementFailure tx
$sel:requirementFailure:CommandFailed :: forall tx. ClientMessage tx -> SideLoadRequirementFailure tx
requirementFailure}) ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> SideLoadRequirementFailure tx -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 SideLoadRequirementFailure tx
requirementFailure
              Right (CommandFailed{$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput = SideLoadSnapshot{}}) ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (Text
"Side-load snapshot failed" :: Text)
              Right (RejectedInputBecauseUnsynced{$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput = SideLoadSnapshot{}, NominalDiffTime
$sel:drift:CommandFailed :: forall tx. ClientMessage tx -> NominalDiffTime
drift :: NominalDiffTime
drift}) ->
                Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status503 (Text
"Side-load snapshot failed because node is out of sync with chain, drift: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show NominalDiffTime
drift :: Text)
              Either (TimedServerOutput tx) (ClientMessage tx)
_ -> IO Response
wait
      DiffTime -> IO Response -> IO (Maybe Response)
forall a. DiffTime -> IO a -> IO (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout (NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (ApiTransactionTimeout -> NominalDiffTime
apiTransactionTimeoutNominalDiffTime ApiTransactionTimeout
apiTransactionTimeout)) IO Response
wait IO (Maybe Response)
-> (Maybe Response -> IO Response) -> IO Response
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Response
r -> Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
r
        Maybe Response
Nothing ->
          Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> OperationTimedOut -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status202 (OperationTimedOut -> Response) -> OperationTimedOut -> Response
forall a b. (a -> b) -> a -> b
$ Text -> ApiTransactionTimeout -> OperationTimedOut
operationTimedOut Text
"SideLoadSnapshotSubmitted" ApiTransactionTimeout
apiTransactionTimeout

-- | Handle request to submit a transaction to the head.
handleSubmitL2Tx ::
  forall tx.
  IsChainState tx =>
  (ClientInput tx -> IO ()) ->
  ApiTransactionTimeout ->
  TChan (Either (TimedServerOutput tx) (ClientMessage tx)) ->
  ApiEncoding ->
  ApiEncoding ->
  LBS.ByteString ->
  IO Response
handleSubmitL2Tx :: forall tx.
IsChainState tx =>
(ClientInput tx -> IO ())
-> ApiTransactionTimeout
-> TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> ApiEncoding
-> ApiEncoding
-> ByteString
-> IO Response
handleSubmitL2Tx ClientInput tx -> IO ()
putClientInput ApiTransactionTimeout
apiTransactionTimeout TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel ApiEncoding
reqEnc ApiEncoding
respEnc ByteString
body = do
  case forall a.
(FromJSON a, FromCBOR a) =>
ApiEncoding -> ByteString -> Either String a
decodeWire @(SubmitL2TxRequest tx) ApiEncoding
reqEnc ByteString
body of
    Left String
err ->
      Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (String -> Text
pack String
err)
    Right SubmitL2TxRequest{tx
$sel:submitL2Tx:SubmitL2TxRequest :: forall tx. SubmitL2TxRequest tx -> tx
submitL2Tx :: tx
submitL2Tx} -> do
      -- Duplicate the channel to avoid consuming messages from other consumers.
      TChan (Either (TimedServerOutput tx) (ClientMessage tx))
dupChannel <- STM IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
-> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
 -> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx))))
-> STM
     IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
-> IO (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a b. (a -> b) -> a -> b
$ TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> STM (TChan (Either (TimedServerOutput tx) (ClientMessage tx)))
forall a. TChan a -> STM (TChan a)
dupTChan TChan (Either (TimedServerOutput tx) (ClientMessage tx))
responseChannel

      -- Submit the transaction to the head
      ClientInput tx -> IO ()
putClientInput (tx -> ClientInput tx
forall tx. tx -> ClientInput tx
NewTx tx
submitL2Tx)

      let txid :: TxIdType tx
txid = tx -> TxIdType tx
forall tx. IsTx tx => tx -> TxIdType tx
txId tx
submitL2Tx
      Maybe SubmitL2TxResponse
result <-
        DiffTime -> IO SubmitL2TxResponse -> IO (Maybe SubmitL2TxResponse)
forall a. DiffTime -> IO a -> IO (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout
          (NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (ApiTransactionTimeout -> NominalDiffTime
apiTransactionTimeoutNominalDiffTime ApiTransactionTimeout
apiTransactionTimeout))
          (TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> TxIdType tx -> IO SubmitL2TxResponse
waitForTransactionResult TChan (Either (TimedServerOutput tx) (ClientMessage tx))
dupChannel TxIdType tx
txid)

      case Maybe SubmitL2TxResponse
result of
        Just (SubmitTxConfirmed Integer
snapshotNumber) ->
          Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> SubmitL2TxResponse -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status200 (Integer -> SubmitL2TxResponse
SubmitTxConfirmed Integer
snapshotNumber)
        Just (SubmitTxInvalidResponse Text
validationError) ->
          Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> SubmitL2TxResponse -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status400 (Text -> SubmitL2TxResponse
SubmitTxInvalidResponse Text
validationError)
        Just (SubmitTxRejectedResponse Text
reason) ->
          Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> SubmitL2TxResponse -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status503 (Text -> SubmitL2TxResponse
SubmitTxRejectedResponse Text
reason)
        Just SubmitL2TxResponse
SubmitTxSubmitted ->
          Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ ApiEncoding -> Status -> SubmitL2TxResponse -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status202 SubmitL2TxResponse
SubmitTxSubmitted
        Maybe SubmitL2TxResponse
Nothing ->
          -- Timeout occurred - return 202 Accepted with timeout info
          Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$
            ApiEncoding -> Status -> OperationTimedOut -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
respEnc Status
status202 (OperationTimedOut -> Response) -> OperationTimedOut -> Response
forall a b. (a -> b) -> a -> b
$
              OperationTimedOut
                { $sel:tag:OperationTimedOut :: Text
tag = Text
"SubmitTxSubmitted"
                , $sel:timeoutMessage:OperationTimedOut :: Text
timeoutMessage = Text
"Transaction submission timed out after " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (ApiTransactionTimeout -> String
forall b a. (Show a, IsString b) => a -> b
show ApiTransactionTimeout
apiTransactionTimeout) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" seconds"
                }
 where
  --  Wait for transaction result by listening to events
  waitForTransactionResult :: TChan (Either (TimedServerOutput tx) (ClientMessage tx)) -> TxIdType tx -> IO SubmitL2TxResponse
  waitForTransactionResult :: TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> TxIdType tx -> IO SubmitL2TxResponse
waitForTransactionResult TChan (Either (TimedServerOutput tx) (ClientMessage tx))
dupChannel TxIdType tx
txid = IO SubmitL2TxResponse
go
   where
    go :: IO SubmitL2TxResponse
go = do
      Either (TimedServerOutput tx) (ClientMessage tx)
event <- STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
-> IO (Either (TimedServerOutput tx) (ClientMessage tx))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
 -> IO (Either (TimedServerOutput tx) (ClientMessage tx)))
-> STM IO (Either (TimedServerOutput tx) (ClientMessage tx))
-> IO (Either (TimedServerOutput tx) (ClientMessage tx))
forall a b. (a -> b) -> a -> b
$ TChan (Either (TimedServerOutput tx) (ClientMessage tx))
-> STM (Either (TimedServerOutput tx) (ClientMessage tx))
forall a. TChan a -> STM a
readTChan TChan (Either (TimedServerOutput tx) (ClientMessage tx))
dupChannel
      case Either (TimedServerOutput tx) (ClientMessage tx)
event of
        Right (RejectedInputBecauseUnsynced{$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput = NewTx{}, NominalDiffTime
$sel:drift:CommandFailed :: forall tx. ClientMessage tx -> NominalDiffTime
drift :: NominalDiffTime
drift}) -> do
          SubmitL2TxResponse -> IO SubmitL2TxResponse
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubmitL2TxResponse -> IO SubmitL2TxResponse)
-> SubmitL2TxResponse -> IO SubmitL2TxResponse
forall a b. (a -> b) -> a -> b
$ Text -> SubmitL2TxResponse
SubmitTxRejectedResponse (Text -> SubmitL2TxResponse) -> Text -> SubmitL2TxResponse
forall a b. (a -> b) -> a -> b
$ Text
"Node is out of sync with chain, drift: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show NominalDiffTime
drift
        Left (TimedServerOutput{ServerOutput tx
$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output :: ServerOutput tx
output}) -> case ServerOutput tx
output of
          TxValid{TxIdType tx
transactionId :: TxIdType tx
$sel:transactionId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
transactionId}
            | TxIdType tx
transactionId TxIdType tx -> TxIdType tx -> Bool
forall a. Eq a => a -> a -> Bool
== TxIdType tx
txid ->
                SubmitL2TxResponse -> IO SubmitL2TxResponse
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubmitL2TxResponse
SubmitTxSubmitted
          TxInvalid{tx
transaction :: tx
$sel:transaction:NetworkConnected :: forall tx. ServerOutput tx -> tx
transaction, $sel:validationError:NetworkConnected :: forall tx. ServerOutput tx -> ValidationError
validationError = ValidationError Text
reason}
            | tx -> TxIdType tx
forall tx. IsTx tx => tx -> TxIdType tx
txId tx
transaction TxIdType tx -> TxIdType tx -> Bool
forall a. Eq a => a -> a -> Bool
== TxIdType tx
txid ->
                SubmitL2TxResponse -> IO SubmitL2TxResponse
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubmitL2TxResponse -> IO SubmitL2TxResponse)
-> SubmitL2TxResponse -> IO SubmitL2TxResponse
forall a b. (a -> b) -> a -> b
$ Text -> SubmitL2TxResponse
SubmitTxInvalidResponse Text
reason
          SnapshotConfirmed{Snapshot tx
snapshot :: Snapshot tx
$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot} ->
            -- Check if the transaction is in the confirmed snapshot
            if TxIdType tx
txid TxIdType tx -> [TxIdType tx] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (tx -> TxIdType tx) -> [tx] -> [TxIdType tx]
forall a b. (a -> b) -> [a] -> [b]
map tx -> TxIdType tx
forall tx. IsTx tx => tx -> TxIdType tx
txId (Snapshot tx -> [tx]
forall tx. Snapshot tx -> [tx]
confirmed Snapshot tx
snapshot)
              then SubmitL2TxResponse -> IO SubmitL2TxResponse
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubmitL2TxResponse -> IO SubmitL2TxResponse)
-> SubmitL2TxResponse -> IO SubmitL2TxResponse
forall a b. (a -> b) -> a -> b
$ Integer -> SubmitL2TxResponse
SubmitTxConfirmed (SnapshotNumber -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SnapshotNumber -> Integer) -> SnapshotNumber -> Integer
forall a b. (a -> b) -> a -> b
$ Snapshot tx -> SnapshotNumber
forall tx. Snapshot tx -> SnapshotNumber
number Snapshot tx
snapshot)
              else IO SubmitL2TxResponse
go
          ServerOutput tx
_ -> IO SubmitL2TxResponse
go
        Right ClientMessage tx
_ -> IO SubmitL2TxResponse
go

badRequest :: IsChainState tx => ApiEncoding -> PostTxError tx -> Response
badRequest :: forall tx.
IsChainState tx =>
ApiEncoding -> PostTxError tx -> Response
badRequest ApiEncoding
apiEncoding = ApiEncoding -> Status -> PostTxError tx -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
apiEncoding Status
status400

notFound :: ApiEncoding -> Response
notFound :: ApiEncoding -> Response
notFound ApiEncoding
apiEncoding = ApiEncoding -> Status -> Text -> Response
forall a.
(ToJSON a, ToCBOR a) =>
ApiEncoding -> Status -> a -> Response
respondApi ApiEncoding
apiEncoding Status
status404 (Text
"" :: Text)