module Cooked.MockChain.UtxoSearch
( UtxoSearch,
runUtxoSearch,
allUtxosSearch,
utxosOwnedBySearch,
utxosFromCardanoTxSearch,
txOutByRefSearch,
filterWith,
filterWithPure,
filterWithOptic,
filterWithPred,
filterWithValuePred,
filterWithOnlyAda,
filterWithNotOnlyAda,
onlyValueOutputsAtSearch,
vanillaOutputsAtSearch,
filterWithAlways,
referenceScriptOutputsSearch,
filterWithPureRev,
)
where
import Control.Monad
import Cooked.MockChain.BlockChain
import Cooked.Skeleton
import Data.Maybe
import Ledger.Tx qualified as Ledger
import ListT (ListT (..))
import ListT qualified
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import Plutus.Script.Utils.Value qualified as Script
import PlutusLedgerApi.V1.Value qualified as Api
import PlutusLedgerApi.V3 qualified as Api
type UtxoSearch m a = ListT m (Api.TxOutRef, a)
runUtxoSearch :: (Monad m) => UtxoSearch m a -> m [(Api.TxOutRef, a)]
runUtxoSearch :: forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> m [(TxOutRef, a)]
runUtxoSearch = ListT m (TxOutRef, a) -> m [(TxOutRef, a)]
forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
ListT.toList
allUtxosSearch :: (MonadBlockChain m) => UtxoSearch m TxSkelOut
allUtxosSearch :: forall (m :: * -> *). MonadBlockChain m => UtxoSearch m TxSkelOut
allUtxosSearch = ListT m [(TxOutRef, TxSkelOut)]
forall (m :: * -> *).
MonadBlockChainWithoutValidation m =>
m [(TxOutRef, TxSkelOut)]
allUtxos ListT m [(TxOutRef, TxSkelOut)]
-> ([(TxOutRef, TxSkelOut)] -> ListT m (TxOutRef, TxSkelOut))
-> ListT m (TxOutRef, TxSkelOut)
forall a b. ListT m a -> (a -> ListT m b) -> ListT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(TxOutRef, TxSkelOut)] -> ListT m (TxOutRef, TxSkelOut)
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
f a -> ListT m a
ListT.fromFoldable
utxosOwnedBySearch :: (MonadBlockChainBalancing m, Script.ToAddress addr) => addr -> UtxoSearch m TxSkelOut
utxosOwnedBySearch :: forall (m :: * -> *) addr.
(MonadBlockChainBalancing m, ToAddress addr) =>
addr -> UtxoSearch m TxSkelOut
utxosOwnedBySearch = Address -> ListT m [(TxOutRef, TxSkelOut)]
forall a. ToAddress a => a -> ListT m [(TxOutRef, TxSkelOut)]
forall (m :: * -> *) a.
(MonadBlockChainBalancing m, ToAddress a) =>
a -> m [(TxOutRef, TxSkelOut)]
utxosAt (Address -> ListT m [(TxOutRef, TxSkelOut)])
-> (addr -> Address) -> addr -> ListT m [(TxOutRef, TxSkelOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. addr -> Address
forall a. ToAddress a => a -> Address
Script.toAddress (addr -> ListT m [(TxOutRef, TxSkelOut)])
-> ([(TxOutRef, TxSkelOut)] -> ListT m (TxOutRef, TxSkelOut))
-> addr
-> ListT m (TxOutRef, TxSkelOut)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [(TxOutRef, TxSkelOut)] -> ListT m (TxOutRef, TxSkelOut)
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
f a -> ListT m a
ListT.fromFoldable
txOutByRefSearch :: (MonadBlockChainBalancing m) => [Api.TxOutRef] -> UtxoSearch m TxSkelOut
txOutByRefSearch :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxOutRef] -> UtxoSearch m TxSkelOut
txOutByRefSearch [TxOutRef]
orefs =
(TxOutRef -> m (TxOutRef, TxOutRef))
-> ListT m TxOutRef -> ListT m (TxOutRef, TxOutRef)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ListT m a -> ListT m b
ListT.traverse (\TxOutRef
o -> (TxOutRef, TxOutRef) -> m (TxOutRef, TxOutRef)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxOutRef
o, TxOutRef
o)) ([TxOutRef] -> ListT m TxOutRef
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
f a -> ListT m a
ListT.fromFoldable [TxOutRef]
orefs)
ListT m (TxOutRef, TxOutRef)
-> (TxOutRef -> m (Maybe TxSkelOut)) -> UtxoSearch m TxSkelOut
forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> m (Maybe b)) -> UtxoSearch m b
`filterWith` TxOutRef -> m (Maybe TxSkelOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe TxSkelOut)
txOutByRef
utxosFromCardanoTxSearch :: (MonadBlockChainBalancing m) => Ledger.CardanoTx -> UtxoSearch m TxSkelOut
utxosFromCardanoTxSearch :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
CardanoTx -> UtxoSearch m TxSkelOut
utxosFromCardanoTxSearch = CardanoTx -> ListT m [(TxOutRef, TxSkelOut)]
forall (m :: * -> *).
MonadBlockChainBalancing m =>
CardanoTx -> m [(TxOutRef, TxSkelOut)]
utxosFromCardanoTx (CardanoTx -> ListT m [(TxOutRef, TxSkelOut)])
-> ([(TxOutRef, TxSkelOut)] -> ListT m (TxOutRef, TxSkelOut))
-> CardanoTx
-> ListT m (TxOutRef, TxSkelOut)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [(TxOutRef, TxSkelOut)] -> ListT m (TxOutRef, TxSkelOut)
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
f a -> ListT m a
ListT.fromFoldable
filterWith :: (Monad m) => UtxoSearch m a -> (a -> m (Maybe b)) -> UtxoSearch m b
filterWith :: forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> m (Maybe b)) -> UtxoSearch m b
filterWith (ListT m (Maybe ((TxOutRef, a), ListT m (TxOutRef, a)))
as) a -> m (Maybe b)
f =
m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b)))
-> ListT m (TxOutRef, b)
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b)))
-> ListT m (TxOutRef, b))
-> m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b)))
-> ListT m (TxOutRef, b)
forall a b. (a -> b) -> a -> b
$
m (Maybe ((TxOutRef, a), ListT m (TxOutRef, a)))
as m (Maybe ((TxOutRef, a), ListT m (TxOutRef, a)))
-> (Maybe ((TxOutRef, a), ListT m (TxOutRef, a))
-> m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b))))
-> m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b)))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe ((TxOutRef, a), ListT m (TxOutRef, a))
Nothing -> Maybe ((TxOutRef, b), ListT m (TxOutRef, b))
-> m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ((TxOutRef, b), ListT m (TxOutRef, b))
forall a. Maybe a
Nothing
Just ((TxOutRef
oref, a
a), ListT m (TxOutRef, a)
rest) ->
let filteredRest :: ListT m (TxOutRef, b)
filteredRest@(ListT m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b)))
bs) = ListT m (TxOutRef, a)
-> (a -> m (Maybe b)) -> ListT m (TxOutRef, b)
forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> m (Maybe b)) -> UtxoSearch m b
filterWith ListT m (TxOutRef, a)
rest a -> m (Maybe b)
f
in a -> m (Maybe b)
f a
a m (Maybe b)
-> (Maybe b -> m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b))))
-> m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b)))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe b
Nothing -> m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b)))
bs
Just b
b -> Maybe ((TxOutRef, b), ListT m (TxOutRef, b))
-> m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ((TxOutRef, b), ListT m (TxOutRef, b))
-> m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b))))
-> Maybe ((TxOutRef, b), ListT m (TxOutRef, b))
-> m (Maybe ((TxOutRef, b), ListT m (TxOutRef, b)))
forall a b. (a -> b) -> a -> b
$ ((TxOutRef, b), ListT m (TxOutRef, b))
-> Maybe ((TxOutRef, b), ListT m (TxOutRef, b))
forall a. a -> Maybe a
Just ((TxOutRef
oref, b
b), ListT m (TxOutRef, b)
filteredRest)
filterWithPure :: (Monad m) => UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m b
filterWithPure :: forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m b
filterWithPure UtxoSearch m a
as a -> Maybe b
f = UtxoSearch m a -> (a -> m (Maybe b)) -> UtxoSearch m b
forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> m (Maybe b)) -> UtxoSearch m b
filterWith UtxoSearch m a
as (Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> m (Maybe b)) -> (a -> Maybe b) -> a -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f)
filterWithAlways :: (Monad m) => UtxoSearch m a -> (a -> b) -> UtxoSearch m b
filterWithAlways :: forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> b) -> UtxoSearch m b
filterWithAlways UtxoSearch m a
as a -> b
f = UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m b
forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m b
filterWithPure UtxoSearch m a
as (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
filterWithOptic :: (Is k An_AffineFold, Monad m) => UtxoSearch m a -> Optic' k is a b -> UtxoSearch m b
filterWithOptic :: forall k (m :: * -> *) a (is :: IxList) b.
(Is k An_AffineFold, Monad m) =>
UtxoSearch m a -> Optic' k is a b -> UtxoSearch m b
filterWithOptic UtxoSearch m a
as Optic' k is a b
optic = UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m b
forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m b
filterWithPure UtxoSearch m a
as (a -> Optic' k is a b -> Maybe b
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic' k is a b
optic)
filterWithPred :: (Monad m) => UtxoSearch m a -> (a -> Bool) -> UtxoSearch m a
filterWithPred :: forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> (a -> Bool) -> UtxoSearch m a
filterWithPred UtxoSearch m a
as a -> Bool
f = UtxoSearch m a -> (a -> Maybe a) -> UtxoSearch m a
forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m b
filterWithPure UtxoSearch m a
as ((a -> Maybe a) -> UtxoSearch m a)
-> (a -> Maybe a) -> UtxoSearch m a
forall a b. (a -> b) -> a -> b
$ \a
a -> if a -> Bool
f a
a then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing
filterWithPureRev :: (Monad m) => UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m a
filterWithPureRev :: forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m a
filterWithPureRev UtxoSearch m a
as = UtxoSearch m a -> (a -> Bool) -> UtxoSearch m a
forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> (a -> Bool) -> UtxoSearch m a
filterWithPred UtxoSearch m a
as ((a -> Bool) -> UtxoSearch m a)
-> ((a -> Maybe b) -> a -> Bool)
-> (a -> Maybe b)
-> UtxoSearch m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe b -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe b -> Bool) -> (a -> Maybe b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
filterWithValuePred :: (Monad m) => UtxoSearch m TxSkelOut -> (Api.Value -> Bool) -> UtxoSearch m TxSkelOut
filterWithValuePred :: forall (m :: * -> *).
Monad m =>
UtxoSearch m TxSkelOut -> (Value -> Bool) -> UtxoSearch m TxSkelOut
filterWithValuePred UtxoSearch m TxSkelOut
as Value -> Bool
f = UtxoSearch m TxSkelOut
-> (TxSkelOut -> Bool) -> UtxoSearch m TxSkelOut
forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> (a -> Bool) -> UtxoSearch m a
filterWithPred UtxoSearch m TxSkelOut
as (Value -> Bool
f (Value -> Bool) -> (TxSkelOut -> Value) -> TxSkelOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelOut -> Value
txSkelOutValue)
filterWithOnlyAda :: (Monad m) => UtxoSearch m TxSkelOut -> UtxoSearch m TxSkelOut
filterWithOnlyAda :: forall (m :: * -> *).
Monad m =>
UtxoSearch m TxSkelOut -> UtxoSearch m TxSkelOut
filterWithOnlyAda UtxoSearch m TxSkelOut
as = UtxoSearch m TxSkelOut -> (Value -> Bool) -> UtxoSearch m TxSkelOut
forall (m :: * -> *).
Monad m =>
UtxoSearch m TxSkelOut -> (Value -> Bool) -> UtxoSearch m TxSkelOut
filterWithValuePred UtxoSearch m TxSkelOut
as Value -> Bool
Script.isAdaOnlyValue
filterWithNotOnlyAda :: (Monad m) => UtxoSearch m TxSkelOut -> UtxoSearch m TxSkelOut
filterWithNotOnlyAda :: forall (m :: * -> *).
Monad m =>
UtxoSearch m TxSkelOut -> UtxoSearch m TxSkelOut
filterWithNotOnlyAda UtxoSearch m TxSkelOut
as = UtxoSearch m TxSkelOut -> (Value -> Bool) -> UtxoSearch m TxSkelOut
forall (m :: * -> *).
Monad m =>
UtxoSearch m TxSkelOut -> (Value -> Bool) -> UtxoSearch m TxSkelOut
filterWithValuePred UtxoSearch m TxSkelOut
as (Bool -> Bool
not (Bool -> Bool) -> (Value -> Bool) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Bool
Script.isAdaOnlyValue)
onlyValueOutputsAtSearch :: (MonadBlockChainBalancing m, Script.ToAddress addr) => addr -> UtxoSearch m TxSkelOut
onlyValueOutputsAtSearch :: forall (m :: * -> *) addr.
(MonadBlockChainBalancing m, ToAddress addr) =>
addr -> UtxoSearch m TxSkelOut
onlyValueOutputsAtSearch addr
addr =
addr -> UtxoSearch m TxSkelOut
forall (m :: * -> *) addr.
(MonadBlockChainBalancing m, ToAddress addr) =>
addr -> UtxoSearch m TxSkelOut
utxosOwnedBySearch addr
addr
UtxoSearch m TxSkelOut
-> (TxSkelOut -> Maybe DatumContent) -> UtxoSearch m TxSkelOut
forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m a
`filterWithPureRev` Optic' An_AffineTraversal NoIx TxSkelOut DatumContent
-> TxSkelOut -> Maybe DatumContent
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL Lens' TxSkelOut TxSkelOutDatum
-> Optic
An_AffineTraversal
NoIx
TxSkelOutDatum
TxSkelOutDatum
DatumContent
DatumContent
-> Optic' An_AffineTraversal NoIx TxSkelOut DatumContent
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
An_AffineTraversal
NoIx
TxSkelOutDatum
TxSkelOutDatum
DatumContent
DatumContent
txSkelOutDatumContentAT)
UtxoSearch m TxSkelOut
-> (TxSkelOut -> Maybe StakingCredential) -> UtxoSearch m TxSkelOut
forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m a
`filterWithPureRev` Optic' A_Lens NoIx TxSkelOut (Maybe StakingCredential)
-> TxSkelOut -> Maybe StakingCredential
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TxSkelOut (Maybe StakingCredential)
txSkelOutStakingCredentialL
UtxoSearch m TxSkelOut
-> (TxSkelOut -> Maybe (Versioned Script))
-> UtxoSearch m TxSkelOut
forall (m :: * -> *) a b.
Monad m =>
UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m a
`filterWithPureRev` TxSkelOut -> Maybe (Versioned Script)
txSkelOutReferenceScript
vanillaOutputsAtSearch :: (MonadBlockChainBalancing m, Script.ToAddress addr) => addr -> UtxoSearch m TxSkelOut
vanillaOutputsAtSearch :: forall (m :: * -> *) addr.
(MonadBlockChainBalancing m, ToAddress addr) =>
addr -> UtxoSearch m TxSkelOut
vanillaOutputsAtSearch = UtxoSearch m TxSkelOut -> UtxoSearch m TxSkelOut
forall (m :: * -> *).
Monad m =>
UtxoSearch m TxSkelOut -> UtxoSearch m TxSkelOut
filterWithOnlyAda (UtxoSearch m TxSkelOut -> UtxoSearch m TxSkelOut)
-> (addr -> UtxoSearch m TxSkelOut)
-> addr
-> UtxoSearch m TxSkelOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. addr -> UtxoSearch m TxSkelOut
forall (m :: * -> *) addr.
(MonadBlockChainBalancing m, ToAddress addr) =>
addr -> UtxoSearch m TxSkelOut
onlyValueOutputsAtSearch
referenceScriptOutputsSearch ::
(MonadBlockChain m, Script.ToScriptHash s) => s -> UtxoSearch m TxSkelOut
referenceScriptOutputsSearch :: forall (m :: * -> *) s.
(MonadBlockChain m, ToScriptHash s) =>
s -> UtxoSearch m TxSkelOut
referenceScriptOutputsSearch s
s =
UtxoSearch m TxSkelOut
forall (m :: * -> *). MonadBlockChain m => UtxoSearch m TxSkelOut
allUtxosSearch
UtxoSearch m TxSkelOut
-> (TxSkelOut -> Bool) -> UtxoSearch m TxSkelOut
forall (m :: * -> *) a.
Monad m =>
UtxoSearch m a -> (a -> Bool) -> UtxoSearch m a
`filterWithPred` ((ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just (s -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash s
s) Maybe ScriptHash -> Maybe ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe ScriptHash -> Bool)
-> (TxSkelOut -> Maybe ScriptHash) -> TxSkelOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Versioned Script -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash (Versioned Script -> ScriptHash)
-> Maybe (Versioned Script) -> Maybe ScriptHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (Versioned Script) -> Maybe ScriptHash)
-> (TxSkelOut -> Maybe (Versioned Script))
-> TxSkelOut
-> Maybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelOut -> Maybe (Versioned Script)
txSkelOutReferenceScript)