module Cooked.Attack.DatumHijacking
( redirectOutputTweakAny,
datumHijackingAttackAny,
datumHijackingAttack,
redirectOutputTweakAll,
datumHijackingAttackAll,
DatumHijackingLbl (..),
)
where
import Control.Monad
import Cooked.Output
import Cooked.Pretty.Class
import Cooked.Skeleton
import Cooked.Tweak
import Data.Maybe
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import Prettyprinter ((<+>))
redirectOutputTweakAll ::
forall owner owner' m.
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput owner TxSkelOutDatum TxSkelOutValue (Script.Versioned Script.Script) -> Maybe owner') ->
(Integer -> Bool) ->
m [ConcreteOutput owner TxSkelOutDatum TxSkelOutValue (Script.Versioned Script.Script)]
redirectOutputTweakAll :: forall owner owner' (m :: * -> *).
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe owner')
-> (Integer -> Bool)
-> m [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
redirectOutputTweakAll ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe owner'
outputPred Integer -> Bool
indexPred = do
[TxSkelOut]
outputs <- Optic' A_Lens NoIx TxSkel [TxSkelOut] -> m [TxSkelOut]
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Getter) =>
Optic' k is TxSkel a -> m a
viewTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL
let ([Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))]
changed, [TxSkelOut]
newOutputs) = [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
-> ([Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))],
[TxSkelOut])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
-> ([Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))],
[TxSkelOut]))
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
-> ([Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))],
[TxSkelOut])
forall a b. (a -> b) -> a -> b
$ [TxSkelOut]
-> Integer
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
go [TxSkelOut]
outputs Integer
0
Optic' A_Lens NoIx TxSkel [TxSkelOut] -> [TxSkelOut] -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> m ()
setTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL [TxSkelOut]
newOutputs
[ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
-> m [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
-> m [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)])
-> [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
-> m [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
forall a b. (a -> b) -> a -> b
$ [Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))]
-> [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))]
changed
where
modifyOutputOwner :: TxSkelOut -> a -> TxSkelOut
modifyOutputOwner (Pays o
out) = ConcreteOutput
a
(DatumType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
(ValueType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
(ReferenceScriptType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
-> TxSkelOut
forall o.
(Show o, Typeable o, IsTxInfoOutput o,
OwnerConstraints (OwnerType o), DatumType o ~ TxSkelOutDatum,
ValueType o ~ TxSkelOutValue,
ReferenceScriptConstraints (ReferenceScriptType o)) =>
o -> TxSkelOut
Pays (ConcreteOutput
a
(DatumType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
(ValueType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
(ReferenceScriptType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
-> TxSkelOut)
-> (a
-> ConcreteOutput
a
(DatumType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
(ValueType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
(ReferenceScriptType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o))))
-> a
-> TxSkelOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConcreteOutput
(OwnerType o) TxSkelOutDatum TxSkelOutValue (ReferenceScriptType o)
-> a
-> ConcreteOutput
a
(DatumType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
(ValueType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
(ReferenceScriptType
(ConcreteOutput
(OwnerType o)
TxSkelOutDatum
TxSkelOutValue
(ReferenceScriptType o)))
forall out owner.
IsAbstractOutput out =>
out
-> owner
-> ConcreteOutput
owner (DatumType out) (ValueType out) (ReferenceScriptType out)
setOwner (o
-> ConcreteOutput
(OwnerType o) (DatumType o) (ValueType o) (ReferenceScriptType o)
forall out.
IsAbstractOutput out =>
out
-> ConcreteOutput
(OwnerType out)
(DatumType out)
(ValueType out)
(ReferenceScriptType out)
fromAbstractOutput o
out)
go :: [TxSkelOut]
-> Integer
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
go [] Integer
_ = []
go (TxSkelOut
out : [TxSkelOut]
l) Integer
n =
case ( do
ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
out' <- Optic'
A_Prism
NoIx
TxSkelOut
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
-> TxSkelOut
-> Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic'
A_Prism
NoIx
TxSkelOut
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall ownerType.
OwnerConstraints ownerType =>
Prism'
TxSkelOut
(ConcreteOutput
ownerType TxSkelOutDatum TxSkelOutValue (Versioned Script))
txSkelOutOwnerTypeP TxSkelOut
out
owner'
newOwner <- ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe owner'
outputPred ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
out'
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script),
owner')
-> Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script),
owner')
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
out', owner'
newOwner)
) of
Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script),
owner')
Nothing -> (Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall a. Maybe a
Nothing, TxSkelOut
out) (Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
forall a. a -> [a] -> [a]
: [TxSkelOut]
-> Integer
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
go [TxSkelOut]
l Integer
n
Just (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
out', owner'
newOwner) | Integer -> Bool
indexPred Integer
n -> (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall a. a -> Maybe a
Just ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
out', TxSkelOut -> owner' -> TxSkelOut
forall {a}.
(Show a, Typeable a, ToCredential a, IsTxSkelOutAllowedOwner a) =>
TxSkelOut -> a -> TxSkelOut
modifyOutputOwner TxSkelOut
out owner'
newOwner) (Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
forall a. a -> [a] -> [a]
: [TxSkelOut]
-> Integer
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
go [TxSkelOut]
l (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script),
owner')
_ -> (Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall a. Maybe a
Nothing, TxSkelOut
out) (Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
forall a. a -> [a] -> [a]
: [TxSkelOut]
-> Integer
-> [(Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)),
TxSkelOut)]
go [TxSkelOut]
l (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
redirectOutputTweakAny ::
forall owner owner' m.
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput owner TxSkelOutDatum TxSkelOutValue (Script.Versioned Script.Script) -> Maybe owner') ->
(Integer -> Bool) ->
m (ConcreteOutput owner TxSkelOutDatum TxSkelOutValue (Script.Versioned Script.Script))
redirectOutputTweakAny :: forall owner owner' (m :: * -> *).
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe owner')
-> (Integer -> Bool)
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
redirectOutputTweakAny ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe owner'
outputPred Integer -> Bool
indexPred = Optic' A_Lens NoIx TxSkel [TxSkelOut] -> m [TxSkelOut]
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Getter) =>
Optic' k is TxSkel a -> m a
viewTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL m [TxSkelOut]
-> ([TxSkelOut]
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)))
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TxSkelOut]
-> Integer
-> [TxSkelOut]
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
go [] Integer
0
where
go :: [TxSkelOut]
-> Integer
-> [TxSkelOut]
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
go [TxSkelOut]
_ Integer
_ [] = m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
go [TxSkelOut]
l' Integer
n (TxSkelOut
out : [TxSkelOut]
l)
| Integer -> Bool
indexPred Integer
n =
m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
-> Maybe
(m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)))
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall a. a -> Maybe a -> a
fromMaybe
([TxSkelOut]
-> Integer
-> [TxSkelOut]
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
go ([TxSkelOut]
l' [TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. [a] -> [a] -> [a]
++ [TxSkelOut
out]) (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) [TxSkelOut]
l)
( do
ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
out' <- Optic'
A_Prism
NoIx
TxSkelOut
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
-> TxSkelOut
-> Maybe
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic'
A_Prism
NoIx
TxSkelOut
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall ownerType.
OwnerConstraints ownerType =>
Prism'
TxSkelOut
(ConcreteOutput
ownerType TxSkelOutDatum TxSkelOutValue (Versioned Script))
txSkelOutOwnerTypeP TxSkelOut
out
owner'
newOwner <- ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe owner'
outputPred ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
out'
m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
-> Maybe
(m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
-> Maybe
(m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))))
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
-> Maybe
(m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)))
forall a b. (a -> b) -> a -> b
$
m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
(Optic' A_Lens NoIx TxSkel [TxSkelOut] -> [TxSkelOut] -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> m ()
setTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL ([TxSkelOut]
l' [TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. [a] -> [a] -> [a]
++ ConcreteOutput
owner' TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> TxSkelOut
forall o.
(Show o, Typeable o, IsTxInfoOutput o,
OwnerConstraints (OwnerType o), DatumType o ~ TxSkelOutDatum,
ValueType o ~ TxSkelOutValue,
ReferenceScriptConstraints (ReferenceScriptType o)) =>
o -> TxSkelOut
Pays (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> owner'
-> ConcreteOutput
owner'
(DatumType
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)))
(ValueType
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)))
(ReferenceScriptType
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)))
forall out owner.
IsAbstractOutput out =>
out
-> owner
-> ConcreteOutput
owner (DatumType out) (ValueType out) (ReferenceScriptType out)
setOwner ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
out' owner'
newOwner) TxSkelOut -> [TxSkelOut] -> [TxSkelOut]
forall a. a -> [a] -> [a]
: [TxSkelOut]
l) m ()
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
out')
([TxSkelOut]
-> Integer
-> [TxSkelOut]
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
go ([TxSkelOut]
l' [TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. [a] -> [a] -> [a]
++ [TxSkelOut
out]) (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) [TxSkelOut]
l)
)
go [TxSkelOut]
l' Integer
n (TxSkelOut
out : [TxSkelOut]
l) = [TxSkelOut]
-> Integer
-> [TxSkelOut]
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
go ([TxSkelOut]
l' [TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. [a] -> [a] -> [a]
++ [TxSkelOut
out]) Integer
n [TxSkelOut]
l
datumHijackingAttackAll ::
forall owner owner' m.
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput owner TxSkelOutDatum TxSkelOutValue (Script.Versioned Script.Script) -> Bool) ->
(Integer -> Bool) ->
owner' ->
m [ConcreteOutput owner TxSkelOutDatum TxSkelOutValue (Script.Versioned Script.Script)]
datumHijackingAttackAll :: forall owner owner' (m :: * -> *).
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Bool)
-> (Integer -> Bool)
-> owner'
-> m [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
datumHijackingAttackAll ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Bool
change Integer -> Bool
select owner'
thief = do
[ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
redirected <- (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe owner')
-> (Integer -> Bool)
-> m [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
forall owner owner' (m :: * -> *).
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe owner')
-> (Integer -> Bool)
-> m [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
redirectOutputTweakAll (\ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
output -> if ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Bool
change ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
output then owner' -> Maybe owner'
forall a. a -> Maybe a
Just owner'
thief else Maybe owner'
forall a. Maybe a
Nothing) Integer -> Bool
select
Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> (Bool -> Bool) -> Bool -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
redirected
DatumHijackingLbl -> m ()
forall (m :: * -> *) x. (MonadTweak m, LabelConstrs x) => x -> m ()
addLabelTweak (DatumHijackingLbl -> m ()) -> DatumHijackingLbl -> m ()
forall a b. (a -> b) -> a -> b
$ Credential -> DatumHijackingLbl
DatumHijackingLbl (Credential -> DatumHijackingLbl)
-> Credential -> DatumHijackingLbl
forall a b. (a -> b) -> a -> b
$ owner' -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential owner'
thief
[ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
-> m [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)]
redirected
datumHijackingAttackAny ::
forall owner owner' m.
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput owner TxSkelOutDatum TxSkelOutValue (Script.Versioned Script.Script) -> Bool) ->
(Integer -> Bool) ->
owner' ->
m (ConcreteOutput owner TxSkelOutDatum TxSkelOutValue (Script.Versioned Script.Script))
datumHijackingAttackAny :: forall owner owner' (m :: * -> *).
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Bool)
-> (Integer -> Bool)
-> owner'
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
datumHijackingAttackAny ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Bool
change Integer -> Bool
select owner'
thief = do
ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
redirected <- (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe owner')
-> (Integer -> Bool)
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall owner owner' (m :: * -> *).
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Maybe owner')
-> (Integer -> Bool)
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
redirectOutputTweakAny (\ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
output -> if ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Bool
change ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
output then owner' -> Maybe owner'
forall a. a -> Maybe a
Just owner'
thief else Maybe owner'
forall a. Maybe a
Nothing) Integer -> Bool
select
DatumHijackingLbl -> m ()
forall (m :: * -> *) x. (MonadTweak m, LabelConstrs x) => x -> m ()
addLabelTweak (DatumHijackingLbl -> m ()) -> DatumHijackingLbl -> m ()
forall a b. (a -> b) -> a -> b
$ Credential -> DatumHijackingLbl
DatumHijackingLbl (Credential -> DatumHijackingLbl)
-> Credential -> DatumHijackingLbl
forall a b. (a -> b) -> a -> b
$ owner' -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential owner'
thief
ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
redirected
datumHijackingAttack ::
forall owner owner' m.
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
owner' ->
m (ConcreteOutput owner TxSkelOutDatum TxSkelOutValue (Script.Versioned Script.Script))
datumHijackingAttack :: forall owner owner' (m :: * -> *).
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
owner'
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
datumHijackingAttack = (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Bool)
-> (Integer -> Bool)
-> owner'
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
forall owner owner' (m :: * -> *).
(MonadTweak m, OwnerConstraints owner, OwnerConstraints owner') =>
(ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Bool)
-> (Integer -> Bool)
-> owner'
-> m (ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script))
datumHijackingAttackAny (Bool
-> ConcreteOutput
owner TxSkelOutDatum TxSkelOutValue (Versioned Script)
-> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> Integer -> Bool
forall a b. a -> b -> a
const Bool
True)
newtype DatumHijackingLbl = DatumHijackingLbl Api.Credential
deriving (Int -> DatumHijackingLbl -> ShowS
[DatumHijackingLbl] -> ShowS
DatumHijackingLbl -> String
(Int -> DatumHijackingLbl -> ShowS)
-> (DatumHijackingLbl -> String)
-> ([DatumHijackingLbl] -> ShowS)
-> Show DatumHijackingLbl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatumHijackingLbl -> ShowS
showsPrec :: Int -> DatumHijackingLbl -> ShowS
$cshow :: DatumHijackingLbl -> String
show :: DatumHijackingLbl -> String
$cshowList :: [DatumHijackingLbl] -> ShowS
showList :: [DatumHijackingLbl] -> ShowS
Show, DatumHijackingLbl -> DatumHijackingLbl -> Bool
(DatumHijackingLbl -> DatumHijackingLbl -> Bool)
-> (DatumHijackingLbl -> DatumHijackingLbl -> Bool)
-> Eq DatumHijackingLbl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
== :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
$c/= :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
/= :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
Eq, Eq DatumHijackingLbl
Eq DatumHijackingLbl =>
(DatumHijackingLbl -> DatumHijackingLbl -> Ordering)
-> (DatumHijackingLbl -> DatumHijackingLbl -> Bool)
-> (DatumHijackingLbl -> DatumHijackingLbl -> Bool)
-> (DatumHijackingLbl -> DatumHijackingLbl -> Bool)
-> (DatumHijackingLbl -> DatumHijackingLbl -> Bool)
-> (DatumHijackingLbl -> DatumHijackingLbl -> DatumHijackingLbl)
-> (DatumHijackingLbl -> DatumHijackingLbl -> DatumHijackingLbl)
-> Ord DatumHijackingLbl
DatumHijackingLbl -> DatumHijackingLbl -> Bool
DatumHijackingLbl -> DatumHijackingLbl -> Ordering
DatumHijackingLbl -> DatumHijackingLbl -> DatumHijackingLbl
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 :: DatumHijackingLbl -> DatumHijackingLbl -> Ordering
compare :: DatumHijackingLbl -> DatumHijackingLbl -> Ordering
$c< :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
< :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
$c<= :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
<= :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
$c> :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
> :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
$c>= :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
>= :: DatumHijackingLbl -> DatumHijackingLbl -> Bool
$cmax :: DatumHijackingLbl -> DatumHijackingLbl -> DatumHijackingLbl
max :: DatumHijackingLbl -> DatumHijackingLbl -> DatumHijackingLbl
$cmin :: DatumHijackingLbl -> DatumHijackingLbl -> DatumHijackingLbl
min :: DatumHijackingLbl -> DatumHijackingLbl -> DatumHijackingLbl
Ord)
instance PrettyCooked DatumHijackingLbl where
prettyCookedOpt :: PrettyCookedOpts -> DatumHijackingLbl -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (DatumHijackingLbl Credential
address) = DocCooked
"DatumHijacking" DocCooked -> DocCooked -> DocCooked
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyCookedOpts -> Credential -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts Credential
address