module Hydra.API.ServerOutputFilter where

import Hydra.API.ServerOutput (ServerOutput (..), TimedServerOutput, output)
import Hydra.Cardano.Api (
  AddressInEra,
  Tx,
  deserialiseAddress,
  isSignedByAddress,
  proxyToAsType,
  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
          SnapshotConfirmed{$sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{[Tx]
confirmed :: [Tx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed}} ->
            -- A snapshot can confirm no transaction at all, settling only a
            -- deposit or a decommit. There is then no address to match
            -- against, so it reaches every client rather than none: this
            -- filter narrows what a client sees, it does not withhold
            -- events that carry no address.
            [Tx] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tx]
confirmed Bool -> Bool -> Bool
|| (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
    }

-- | Whether a transaction involves the given address, by paying to it or by
-- spending from it.
--
-- Both directions matter to a client watching its own address: the snapshot in
-- which its funds leave the head is the one it most needs, and a transaction
-- that spends a UTxO in full leaves no output behind to match on.
matchingAddr :: Text -> Tx -> Bool
matchingAddr :: Text -> Tx -> Bool
matchingAddr Text
address Tx
tx =
  Bool
paysToAddress Bool -> Bool -> Bool
|| Bool
spendsFromAddress
 where
  paysToAddress :: Bool
paysToAddress =
    Bool -> Bool
not (Bool -> Bool)
-> ([TxOut CtxTx ConwayEra] -> Bool)
-> [TxOut CtxTx ConwayEra]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxOut CtxTx ConwayEra] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TxOut CtxTx ConwayEra] -> Bool)
-> [TxOut CtxTx ConwayEra] -> Bool
forall a b. (a -> b) -> a -> b
$ ((TxOut CtxTx ConwayEra -> Bool)
 -> [TxOut CtxTx ConwayEra] -> [TxOut CtxTx ConwayEra])
-> [TxOut CtxTx ConwayEra]
-> (TxOut CtxTx ConwayEra -> Bool)
-> [TxOut CtxTx ConwayEra]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TxOut CtxTx ConwayEra -> Bool)
-> [TxOut CtxTx ConwayEra] -> [TxOut CtxTx ConwayEra]
forall a. (a -> Bool) -> [a] -> [a]
filter (Tx -> [TxOut CtxTx ConwayEra]
forall era. Tx era -> [TxOut CtxTx era]
txOuts' Tx
tx) ((TxOut CtxTx ConwayEra -> Bool) -> [TxOut CtxTx ConwayEra])
-> (TxOut CtxTx ConwayEra -> Bool) -> [TxOut CtxTx ConwayEra]
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

  -- Spending is matched on the payment credential rather than the serialised
  -- address, since a transaction's inputs do not carry the address they were
  -- locked to.
  spendsFromAddress :: Bool
spendsFromAddress =
    Bool -> (AddressInEra -> Bool) -> Maybe AddressInEra -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (AddressInEra -> Tx -> Bool
`isSignedByAddress` Tx
tx) Maybe AddressInEra
parsedAddress

  parsedAddress :: Maybe AddressInEra
parsedAddress =
    AsType AddressInEra -> Text -> Maybe AddressInEra
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
deserialiseAddress (Proxy AddressInEra -> AsType AddressInEra
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AddressInEra)) Text
address