module Cooked.Tweak.TamperDatum
( tamperDatumTweak,
TamperDatumLbl (..),
malformDatumTweak,
MalformDatumLbl (..),
)
where
import Control.Monad
import Cooked.Output
import Cooked.Pretty.Class
import Cooked.Skeleton
import Cooked.Tweak.Common
import Cooked.Tweak.Labels
import Optics.Core
import PlutusLedgerApi.V3 qualified as Api
import Type.Reflection
tamperDatumTweak ::
forall a m.
( MonadTweak m,
Show a,
PrettyCooked a,
Api.ToData a,
Api.FromData a,
Typeable a
) =>
(a -> Maybe a) ->
m [a]
tamperDatumTweak :: forall a (m :: * -> *).
(MonadTweak m, Show a, PrettyCooked a, ToData a, FromData a,
Typeable a) =>
(a -> Maybe a) -> m [a]
tamperDatumTweak a -> Maybe a
change = do
[a]
beforeModification <-
Optic' A_Traversal '[] TxSkel a -> (a -> Maybe a) -> m [a]
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Traversal) =>
Optic' k is TxSkel a -> (a -> Maybe a) -> m [a]
overMaybeTweak
( Lens' TxSkel [TxSkelOut]
txSkelOutsL
Lens' TxSkel [TxSkelOut]
-> Optic
A_Traversal '[] [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
-> Optic A_Traversal '[] TxSkel TxSkel TxSkelOut TxSkelOut
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 A_Traversal '[] [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
Optic A_Traversal '[] TxSkel TxSkel TxSkelOut TxSkelOut
-> Optic An_AffineTraversal '[] TxSkelOut TxSkelOut a a
-> Optic' A_Traversal '[] TxSkel a
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
% forall a. (FromData a, Typeable a) => AffineTraversal' TxSkelOut a
txSkelOutputDatumTypeAT @a
)
a -> Maybe a
change
Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> ([a] -> Bool) -> [a] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> m ()) -> [a] -> m ()
forall a b. (a -> b) -> a -> b
$ [a]
beforeModification
TamperDatumLbl -> m ()
forall (m :: * -> *) x. (MonadTweak m, LabelConstrs x) => x -> m ()
addLabelTweak TamperDatumLbl
TamperDatumLbl
[a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
beforeModification
data TamperDatumLbl = TamperDatumLbl deriving (Int -> TamperDatumLbl -> ShowS
[TamperDatumLbl] -> ShowS
TamperDatumLbl -> String
(Int -> TamperDatumLbl -> ShowS)
-> (TamperDatumLbl -> String)
-> ([TamperDatumLbl] -> ShowS)
-> Show TamperDatumLbl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TamperDatumLbl -> ShowS
showsPrec :: Int -> TamperDatumLbl -> ShowS
$cshow :: TamperDatumLbl -> String
show :: TamperDatumLbl -> String
$cshowList :: [TamperDatumLbl] -> ShowS
showList :: [TamperDatumLbl] -> ShowS
Show, TamperDatumLbl -> TamperDatumLbl -> Bool
(TamperDatumLbl -> TamperDatumLbl -> Bool)
-> (TamperDatumLbl -> TamperDatumLbl -> Bool) -> Eq TamperDatumLbl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TamperDatumLbl -> TamperDatumLbl -> Bool
== :: TamperDatumLbl -> TamperDatumLbl -> Bool
$c/= :: TamperDatumLbl -> TamperDatumLbl -> Bool
/= :: TamperDatumLbl -> TamperDatumLbl -> Bool
Eq, Eq TamperDatumLbl
Eq TamperDatumLbl =>
(TamperDatumLbl -> TamperDatumLbl -> Ordering)
-> (TamperDatumLbl -> TamperDatumLbl -> Bool)
-> (TamperDatumLbl -> TamperDatumLbl -> Bool)
-> (TamperDatumLbl -> TamperDatumLbl -> Bool)
-> (TamperDatumLbl -> TamperDatumLbl -> Bool)
-> (TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl)
-> (TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl)
-> Ord TamperDatumLbl
TamperDatumLbl -> TamperDatumLbl -> Bool
TamperDatumLbl -> TamperDatumLbl -> Ordering
TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TamperDatumLbl -> TamperDatumLbl -> Ordering
compare :: TamperDatumLbl -> TamperDatumLbl -> Ordering
$c< :: TamperDatumLbl -> TamperDatumLbl -> Bool
< :: TamperDatumLbl -> TamperDatumLbl -> Bool
$c<= :: TamperDatumLbl -> TamperDatumLbl -> Bool
<= :: TamperDatumLbl -> TamperDatumLbl -> Bool
$c> :: TamperDatumLbl -> TamperDatumLbl -> Bool
> :: TamperDatumLbl -> TamperDatumLbl -> Bool
$c>= :: TamperDatumLbl -> TamperDatumLbl -> Bool
>= :: TamperDatumLbl -> TamperDatumLbl -> Bool
$cmax :: TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl
max :: TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl
$cmin :: TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl
min :: TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl
Ord)
instance PrettyCooked TamperDatumLbl where
prettyCooked :: TamperDatumLbl -> DocCooked
prettyCooked TamperDatumLbl
_ = DocCooked
"TamperDatum"
malformDatumTweak ::
forall a m.
( MonadTweak m,
Api.ToData a,
Api.FromData a,
Typeable a
) =>
(a -> [Api.BuiltinData]) ->
m ()
malformDatumTweak :: forall a (m :: * -> *).
(MonadTweak m, ToData a, FromData a, Typeable a) =>
(a -> [BuiltinData]) -> m ()
malformDatumTweak a -> [BuiltinData]
change = do
[TxSkelOut]
outputs <- Optic A_Traversal '[] TxSkel TxSkel TxSkelOut TxSkelOut
-> m [TxSkelOut]
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Fold) =>
Optic' k is TxSkel a -> m [a]
viewAllTweak (Lens' TxSkel [TxSkelOut]
txSkelOutsL Lens' TxSkel [TxSkelOut]
-> Optic
A_Traversal '[] [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
-> Optic A_Traversal '[] TxSkel TxSkel TxSkelOut TxSkelOut
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 A_Traversal '[] [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed)
let modifiedOutputs :: [[TxSkelOut]]
modifiedOutputs = (TxSkelOut -> [TxSkelOut]) -> [TxSkelOut] -> [[TxSkelOut]]
forall a b. (a -> b) -> [a] -> [b]
map (\TxSkelOut
output -> TxSkelOut
output TxSkelOut -> [TxSkelOut] -> [TxSkelOut]
forall a. a -> [a] -> [a]
: TxSkelOut -> [TxSkelOut]
changeOutput TxSkelOut
output) [TxSkelOut]
outputs
modifiedOutputGroups :: [[TxSkelOut]]
modifiedOutputGroups = [[TxSkelOut]] -> [[TxSkelOut]]
forall a. HasCallStack => [a] -> [a]
tail ([[TxSkelOut]] -> [[TxSkelOut]]) -> [[TxSkelOut]] -> [[TxSkelOut]]
forall a b. (a -> b) -> a -> b
$ [[TxSkelOut]] -> [[TxSkelOut]]
forall a. [[a]] -> [[a]]
allCombinations [[TxSkelOut]]
modifiedOutputs
[m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([m ()] -> m ()) -> [m ()] -> m ()
forall a b. (a -> b) -> a -> b
$ ([TxSkelOut] -> m ()) -> [[TxSkelOut]] -> [m ()]
forall a b. (a -> b) -> [a] -> [b]
map (Lens' TxSkel [TxSkelOut] -> [TxSkelOut] -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> m ()
setTweak Lens' TxSkel [TxSkelOut]
txSkelOutsL) [[TxSkelOut]]
modifiedOutputGroups
MalformDatumLbl -> m ()
forall (m :: * -> *) x. (MonadTweak m, LabelConstrs x) => x -> m ()
addLabelTweak MalformDatumLbl
MalformDatumLbl
where
changeOutput :: TxSkelOut -> [TxSkelOut]
changeOutput :: TxSkelOut -> [TxSkelOut]
changeOutput (Pays o
out) =
let datums :: [TxSkelOutDatum]
datums = TxSkelOutDatum -> [TxSkelOutDatum]
changeTxSkelOutDatum (TxSkelOutDatum -> [TxSkelOutDatum])
-> TxSkelOutDatum -> [TxSkelOutDatum]
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens '[] o TxSkelOutDatum -> o -> TxSkelOutDatum
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' o (DatumType o)
Optic' A_Lens '[] o TxSkelOutDatum
forall o. IsAbstractOutput o => Lens' o (DatumType o)
outputDatumL o
out
in (TxSkelOutDatum -> TxSkelOut) -> [TxSkelOutDatum] -> [TxSkelOut]
forall a b. (a -> b) -> [a] -> [b]
map
( \TxSkelOutDatum
datum ->
ConcreteOutput
(OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall o.
(Show o, Typeable o, IsTxInfoOutput o,
IsTxSkelOutAllowedOwner (OwnerType o), Typeable (OwnerType o),
ToCredential (OwnerType o), DatumType o ~ TxSkelOutDatum,
ValueType o ~ Value, ToVersionedScript (ReferenceScriptType o),
Show (OwnerType o), Show (ReferenceScriptType o),
Typeable (ReferenceScriptType o)) =>
o -> TxSkelOut
Pays (ConcreteOutput
(OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut)
-> ConcreteOutput
(OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall a b. (a -> b) -> a -> b
$
OwnerType o
-> Maybe StakingCredential
-> TxSkelOutDatum
-> Value
-> Maybe (ReferenceScriptType o)
-> ConcreteOutput
(OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
forall ownerType datumType valueType referenceScriptType.
ownerType
-> Maybe StakingCredential
-> datumType
-> valueType
-> Maybe referenceScriptType
-> ConcreteOutput ownerType datumType valueType referenceScriptType
ConcreteOutput
(o
out o -> Optic' A_Lens '[] o (OwnerType o) -> OwnerType o
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] o (OwnerType o)
forall o. IsAbstractOutput o => Lens' o (OwnerType o)
outputOwnerL)
(o
out o
-> Optic' A_Lens '[] o (Maybe StakingCredential)
-> Maybe StakingCredential
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] o (Maybe StakingCredential)
forall o. IsAbstractOutput o => Lens' o (Maybe StakingCredential)
outputStakingCredentialL)
TxSkelOutDatum
datum
(o
out o -> Optic' A_Lens '[] o Value -> Value
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] o Value
Lens' o (ValueType o)
forall o. IsAbstractOutput o => Lens' o (ValueType o)
outputValueL)
(o
out o
-> Optic' A_Lens '[] o (Maybe (ReferenceScriptType o))
-> Maybe (ReferenceScriptType o)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] o (Maybe (ReferenceScriptType o))
forall o.
IsAbstractOutput o =>
Lens' o (Maybe (ReferenceScriptType o))
outputReferenceScriptL)
)
[TxSkelOutDatum]
datums
changeTxSkelOutDatum :: TxSkelOutDatum -> [TxSkelOutDatum]
changeTxSkelOutDatum :: TxSkelOutDatum -> [TxSkelOutDatum]
changeTxSkelOutDatum TxSkelOutDatum
TxSkelOutNoDatum = []
changeTxSkelOutDatum (TxSkelOutDatum a
datum) = (BuiltinData -> TxSkelOutDatum)
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> [a] -> [b]
map BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatum ([BuiltinData] -> [TxSkelOutDatum])
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> a -> b
$ a -> [BuiltinData]
forall b. Typeable b => b -> [BuiltinData]
changeOnCorrectType a
datum
changeTxSkelOutDatum (TxSkelOutDatumHash a
datum) = (BuiltinData -> TxSkelOutDatum)
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> [a] -> [b]
map BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatumHash ([BuiltinData] -> [TxSkelOutDatum])
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> a -> b
$ a -> [BuiltinData]
forall b. Typeable b => b -> [BuiltinData]
changeOnCorrectType a
datum
changeTxSkelOutDatum (TxSkelOutInlineDatum a
datum) = (BuiltinData -> TxSkelOutDatum)
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> [a] -> [b]
map BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutInlineDatum ([BuiltinData] -> [TxSkelOutDatum])
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> a -> b
$ a -> [BuiltinData]
forall b. Typeable b => b -> [BuiltinData]
changeOnCorrectType a
datum
changeOnCorrectType :: (Typeable b) => b -> [Api.BuiltinData]
changeOnCorrectType :: forall b. Typeable b => b -> [BuiltinData]
changeOnCorrectType b
datum = case b -> TypeRep b
forall a. Typeable a => a -> TypeRep a
typeOf b
datum TypeRep b -> TypeRep a -> Maybe (b :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) of
Just b :~~: a
HRefl -> a -> [BuiltinData]
change a
b
datum
Maybe (b :~~: a)
Nothing -> []
data MalformDatumLbl = MalformDatumLbl deriving (Int -> MalformDatumLbl -> ShowS
[MalformDatumLbl] -> ShowS
MalformDatumLbl -> String
(Int -> MalformDatumLbl -> ShowS)
-> (MalformDatumLbl -> String)
-> ([MalformDatumLbl] -> ShowS)
-> Show MalformDatumLbl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MalformDatumLbl -> ShowS
showsPrec :: Int -> MalformDatumLbl -> ShowS
$cshow :: MalformDatumLbl -> String
show :: MalformDatumLbl -> String
$cshowList :: [MalformDatumLbl] -> ShowS
showList :: [MalformDatumLbl] -> ShowS
Show, MalformDatumLbl -> MalformDatumLbl -> Bool
(MalformDatumLbl -> MalformDatumLbl -> Bool)
-> (MalformDatumLbl -> MalformDatumLbl -> Bool)
-> Eq MalformDatumLbl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MalformDatumLbl -> MalformDatumLbl -> Bool
== :: MalformDatumLbl -> MalformDatumLbl -> Bool
$c/= :: MalformDatumLbl -> MalformDatumLbl -> Bool
/= :: MalformDatumLbl -> MalformDatumLbl -> Bool
Eq, Eq MalformDatumLbl
Eq MalformDatumLbl =>
(MalformDatumLbl -> MalformDatumLbl -> Ordering)
-> (MalformDatumLbl -> MalformDatumLbl -> Bool)
-> (MalformDatumLbl -> MalformDatumLbl -> Bool)
-> (MalformDatumLbl -> MalformDatumLbl -> Bool)
-> (MalformDatumLbl -> MalformDatumLbl -> Bool)
-> (MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl)
-> (MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl)
-> Ord MalformDatumLbl
MalformDatumLbl -> MalformDatumLbl -> Bool
MalformDatumLbl -> MalformDatumLbl -> Ordering
MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MalformDatumLbl -> MalformDatumLbl -> Ordering
compare :: MalformDatumLbl -> MalformDatumLbl -> Ordering
$c< :: MalformDatumLbl -> MalformDatumLbl -> Bool
< :: MalformDatumLbl -> MalformDatumLbl -> Bool
$c<= :: MalformDatumLbl -> MalformDatumLbl -> Bool
<= :: MalformDatumLbl -> MalformDatumLbl -> Bool
$c> :: MalformDatumLbl -> MalformDatumLbl -> Bool
> :: MalformDatumLbl -> MalformDatumLbl -> Bool
$c>= :: MalformDatumLbl -> MalformDatumLbl -> Bool
>= :: MalformDatumLbl -> MalformDatumLbl -> Bool
$cmax :: MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl
max :: MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl
$cmin :: MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl
min :: MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl
Ord)
instance PrettyCooked MalformDatumLbl where
prettyCooked :: MalformDatumLbl -> DocCooked
prettyCooked MalformDatumLbl
_ = DocCooked
"MalformDatum"
allCombinations :: [[a]] -> [[a]]
allCombinations :: forall a. [[a]] -> [[a]]
allCombinations [] = [[]]
allCombinations [[]] = []
allCombinations ([a]
first : [[a]]
rest) = [a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs | a
x <- [a]
first, [a]
xs <- [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
allCombinations [[a]]
rest]