{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds         #-}
{-# LANGUAGE TypeFamilies      #-}

-- | This module provides the type of LocalMsgProtocol via LocalTxSubmission
--
module DMQ.Protocol.LocalMsgSubmission.Type
  ( module DMQ.Protocol.LocalMsgSubmission.Type
    -- * re-exports
  , module Core
  , module Ouroboros
  ) where

import Data.Aeson
import Data.Text (Text)
import Network.TypedProtocol.Core as Core
import Ouroboros.Network.Protocol.LocalTxSubmission.Type as Ouroboros
import Ouroboros.Network.Util.ShowProxy

-- | The LocalMsgSubmission protocol is an alias for the LocalTxSubmission
--
type LocalMsgSubmission sig = Ouroboros.LocalTxSubmission sig SigMempoolFail

-- | The type of failures when adding to the mempool
--
data SigMempoolFail =
    SigInvalid Text
  | SigDuplicate
  | SigExpired
  | SigResultOther Text
  deriving (SigMempoolFail -> SigMempoolFail -> Bool
(SigMempoolFail -> SigMempoolFail -> Bool)
-> (SigMempoolFail -> SigMempoolFail -> Bool) -> Eq SigMempoolFail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigMempoolFail -> SigMempoolFail -> Bool
== :: SigMempoolFail -> SigMempoolFail -> Bool
$c/= :: SigMempoolFail -> SigMempoolFail -> Bool
/= :: SigMempoolFail -> SigMempoolFail -> Bool
Eq, Int -> SigMempoolFail -> ShowS
[SigMempoolFail] -> ShowS
SigMempoolFail -> String
(Int -> SigMempoolFail -> ShowS)
-> (SigMempoolFail -> String)
-> ([SigMempoolFail] -> ShowS)
-> Show SigMempoolFail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigMempoolFail -> ShowS
showsPrec :: Int -> SigMempoolFail -> ShowS
$cshow :: SigMempoolFail -> String
show :: SigMempoolFail -> String
$cshowList :: [SigMempoolFail] -> ShowS
showList :: [SigMempoolFail] -> ShowS
Show)

instance ShowProxy SigMempoolFail where

instance ToJSON SigMempoolFail where
  toJSON :: SigMempoolFail -> Value
toJSON SigMempoolFail
SigDuplicate = Text -> Value
String Text
"duplicate"
  toJSON SigMempoolFail
SigExpired   = Text -> Value
String Text
"expired"
  toJSON (SigInvalid Text
txt) = [Pair] -> Value
object
    [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"invalid"
    , 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
txt
    ]
  toJSON (SigResultOther Text
txt) = [Pair] -> Value
object
    [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"other"
    , 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
txt
    ]