module Hydra.API.ServerOutputFilter where

import Hydra.API.ServerOutput (ServerOutput (..), TimedServerOutput, output)
import Hydra.Cardano.Api (
  Tx,
  serialiseToBech32,
  txOuts',
  pattern ShelleyAddressInEra,
  pattern TxOut,
 )
import Hydra.Prelude hiding (seq)
import Hydra.Tx (
  Snapshot (..),
 )

newtype ServerOutputFilter tx = ServerOutputFilter
  { forall tx.
ServerOutputFilter tx -> TimedServerOutput tx -> Text -> Bool
txContainsAddr :: TimedServerOutput tx -> Text -> Bool
  }

serverOutputFilter :: ServerOutputFilter Tx
ServerOutputFilter Tx
serverOutputFilter :: ServerOutputFilter Tx =
  ServerOutputFilter
    { $sel:txContainsAddr:ServerOutputFilter :: TimedServerOutput Tx -> Text -> Bool
txContainsAddr = \TimedServerOutput Tx
response Text
address ->
        case TimedServerOutput Tx -> ServerOutput Tx
forall tx. TimedServerOutput tx -> ServerOutput tx
output TimedServerOutput Tx
response of
          TxValid{Tx
transaction :: Tx
$sel:transaction:PeerConnected :: forall tx. ServerOutput tx -> tx
transaction} -> Text -> Tx -> Bool
matchingAddr Text
address Tx
transaction
          TxInvalid{Tx
$sel:transaction:PeerConnected :: forall tx. ServerOutput tx -> tx
transaction :: Tx
transaction} -> Text -> Tx -> Bool
matchingAddr Text
address Tx
transaction
          SnapshotConfirmed{$sel:snapshot:PeerConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{[Tx]
confirmed :: [Tx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed}} -> (Tx -> Bool) -> [Tx] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Tx -> Bool
matchingAddr Text
address) [Tx]
confirmed
          ServerOutput Tx
_ -> Bool
True
    }

matchingAddr :: Text -> Tx -> Bool
matchingAddr :: Text -> Tx -> Bool
matchingAddr Text
address Tx
tx =
  Bool -> Bool
not (Bool -> Bool)
-> ([TxOut CtxTx Era] -> Bool) -> [TxOut CtxTx Era] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOut CtxTx Era] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TxOut CtxTx Era] -> Bool) -> [TxOut CtxTx Era] -> Bool
forall a b. (a -> b) -> a -> b
$ ((TxOut CtxTx Era -> Bool)
 -> [TxOut CtxTx Era] -> [TxOut CtxTx Era])
-> [TxOut CtxTx Era]
-> (TxOut CtxTx Era -> Bool)
-> [TxOut CtxTx Era]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TxOut CtxTx Era -> Bool) -> [TxOut CtxTx Era] -> [TxOut CtxTx Era]
forall a. (a -> Bool) -> [a] -> [a]
filter (Tx -> [TxOut CtxTx Era]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx
tx) ((TxOut CtxTx Era -> Bool) -> [TxOut CtxTx Era])
-> (TxOut CtxTx Era -> Bool) -> [TxOut CtxTx Era]
forall a b. (a -> b) -> a -> b
$ \(TxOut AddressInEra
outAddr Value
_ TxOutDatum CtxTx
_ ReferenceScript
_) ->
    case AddressInEra
outAddr of
      ShelleyAddressInEra Address ShelleyAddr
addr -> Address ShelleyAddr -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 Address ShelleyAddr
addr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
address
      AddressInEra
_ -> Bool
False