{-# LANGUAGE AllowAmbiguousTypes #-}

-- | This module provides an automated attack to try and redirect outputs to a
-- certain target with a similar datum type.
module Cooked.Attack.DatumHijacking
  ( redirectOutputTweakAll,
    DatumHijackingParams (..),
    DatumHijackingLabel (..),
    redirectOutputTweakAny,
    datumHijackingAttack,
    ownedByDatumHijackingParams,
    scriptsDatumHijackingParams,
    defaultDatumHijackingParams,
    datumOfDatumHijackingParams,
    txSkelOutPredDatumHijackingParams,
  )
where

import Control.Monad
import Cooked.Pretty.Class
import Cooked.Skeleton
import Cooked.Tweak
import Data.Bifunctor
import Data.Kind (Type)
import Data.Maybe
import Data.Typeable
import Optics.Core

-- | The 'DatumHijackingLabel' stores the outputs that have been redirected,
-- before their destination were changed.
newtype DatumHijackingLabel = DatumHijackingLabel [TxSkelOut]
  deriving (Int -> DatumHijackingLabel -> ShowS
[DatumHijackingLabel] -> ShowS
DatumHijackingLabel -> String
(Int -> DatumHijackingLabel -> ShowS)
-> (DatumHijackingLabel -> String)
-> ([DatumHijackingLabel] -> ShowS)
-> Show DatumHijackingLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatumHijackingLabel -> ShowS
showsPrec :: Int -> DatumHijackingLabel -> ShowS
$cshow :: DatumHijackingLabel -> String
show :: DatumHijackingLabel -> String
$cshowList :: [DatumHijackingLabel] -> ShowS
showList :: [DatumHijackingLabel] -> ShowS
Show, DatumHijackingLabel -> DatumHijackingLabel -> Bool
(DatumHijackingLabel -> DatumHijackingLabel -> Bool)
-> (DatumHijackingLabel -> DatumHijackingLabel -> Bool)
-> Eq DatumHijackingLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
== :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
$c/= :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
/= :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
Eq, Eq DatumHijackingLabel
Eq DatumHijackingLabel =>
(DatumHijackingLabel -> DatumHijackingLabel -> Ordering)
-> (DatumHijackingLabel -> DatumHijackingLabel -> Bool)
-> (DatumHijackingLabel -> DatumHijackingLabel -> Bool)
-> (DatumHijackingLabel -> DatumHijackingLabel -> Bool)
-> (DatumHijackingLabel -> DatumHijackingLabel -> Bool)
-> (DatumHijackingLabel
    -> DatumHijackingLabel -> DatumHijackingLabel)
-> (DatumHijackingLabel
    -> DatumHijackingLabel -> DatumHijackingLabel)
-> Ord DatumHijackingLabel
DatumHijackingLabel -> DatumHijackingLabel -> Bool
DatumHijackingLabel -> DatumHijackingLabel -> Ordering
DatumHijackingLabel -> DatumHijackingLabel -> DatumHijackingLabel
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 :: DatumHijackingLabel -> DatumHijackingLabel -> Ordering
compare :: DatumHijackingLabel -> DatumHijackingLabel -> Ordering
$c< :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
< :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
$c<= :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
<= :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
$c> :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
> :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
$c>= :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
>= :: DatumHijackingLabel -> DatumHijackingLabel -> Bool
$cmax :: DatumHijackingLabel -> DatumHijackingLabel -> DatumHijackingLabel
max :: DatumHijackingLabel -> DatumHijackingLabel -> DatumHijackingLabel
$cmin :: DatumHijackingLabel -> DatumHijackingLabel -> DatumHijackingLabel
min :: DatumHijackingLabel -> DatumHijackingLabel -> DatumHijackingLabel
Ord)

instance PrettyCooked DatumHijackingLabel where
  prettyCookedOpt :: PrettyCookedOpts -> DatumHijackingLabel -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (DatumHijackingLabel [TxSkelOut]
txSkelOuts) = PrettyCookedOpts
-> DocCooked -> DocCooked -> [TxSkelOut] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"Redirected outputs" DocCooked
"-" [TxSkelOut]
txSkelOuts

-- | Parameters of the datum hijacking attacks. They state precisely which
-- outputs should have their owner changed, wich owner should be assigned, to
-- each of these outputs, and whether several modified outputs should be
-- combined in a single transaction, or instead spread out multiple branches.
data DatumHijackingParams where
  DatumHijackingParams ::
    (IsTxSkelOutAllowedOwner owner) =>
    { -- | Return 'Just' the new owner, or 'Nothing' if you want to leave this
      -- output unchanged.
      ()
dhpOutputPred :: TxSkelOut -> Maybe owner,
      -- | The redirection described by the previous argument might apply to more
      -- than one of the outputs of the transaction. Use this predicate to select
      -- which of the redirectable outputs to actually redirect. We count the
      -- redirectable outputs from the left to the right, starting with zero.
      DatumHijackingParams -> Integer -> Bool
dhpIndexPred :: Integer -> Bool,
      -- | Whether all the outputs targetted by the predicates should be
      -- redirected in the same transaction, or one at a time, each in a
      -- distinct transaction.
      DatumHijackingParams -> Bool
dhpAllOutputs :: Bool
    } ->
    DatumHijackingParams

-- | Targets all the outputs for which the focus of a given optic exists, and
-- redirects each of them in a separate transaction.
defaultDatumHijackingParams :: (IsTxSkelOutAllowedOwner owner, Is k An_AffineFold) => Optic' k is TxSkelOut x -> owner -> DatumHijackingParams
defaultDatumHijackingParams :: forall owner k (is :: IxList) x.
(IsTxSkelOutAllowedOwner owner, Is k An_AffineFold) =>
Optic' k is TxSkelOut x -> owner -> DatumHijackingParams
defaultDatumHijackingParams Optic' k is TxSkelOut x
optic owner
thief =
  (TxSkelOut -> Maybe owner)
-> (Integer -> Bool) -> Bool -> DatumHijackingParams
forall owner.
IsTxSkelOutAllowedOwner owner =>
(TxSkelOut -> Maybe owner)
-> (Integer -> Bool) -> Bool -> DatumHijackingParams
DatumHijackingParams
    ((owner
thief owner -> Maybe x -> Maybe owner
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (Maybe x -> Maybe owner)
-> (TxSkelOut -> Maybe x) -> TxSkelOut -> Maybe owner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' k is TxSkelOut x -> TxSkelOut -> Maybe x
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' k is TxSkelOut x
optic)
    (Bool -> Integer -> Bool
forall a b. a -> b -> a
const Bool
True)
    Bool
False

-- | Targets all the outputs satisfying a given predicate, and redirects each of
-- them in a separate transaction.
txSkelOutPredDatumHijackingParams :: (IsTxSkelOutAllowedOwner owner) => (TxSkelOut -> Bool) -> owner -> DatumHijackingParams
txSkelOutPredDatumHijackingParams :: forall owner.
IsTxSkelOutAllowedOwner owner =>
(TxSkelOut -> Bool) -> owner -> DatumHijackingParams
txSkelOutPredDatumHijackingParams TxSkelOut -> Bool
predicate = Optic' A_Prism NoIx TxSkelOut TxSkelOut
-> owner -> DatumHijackingParams
forall owner k (is :: IxList) x.
(IsTxSkelOutAllowedOwner owner, Is k An_AffineFold) =>
Optic' k is TxSkelOut x -> owner -> DatumHijackingParams
defaultDatumHijackingParams ((TxSkelOut -> Bool) -> Optic' A_Prism NoIx TxSkelOut TxSkelOut
forall a. (a -> Bool) -> Prism' a a
selectP TxSkelOut -> Bool
predicate)

-- | Datum hijacking parameters targetting all the outputs owned by a certain
-- type of owner, and redirecting each of them in a separate transaction.
ownedByDatumHijackingParams :: forall (oldOwner :: Type) owner. (IsTxSkelOutAllowedOwner owner, Typeable oldOwner) => owner -> DatumHijackingParams
ownedByDatumHijackingParams :: forall oldOwner owner.
(IsTxSkelOutAllowedOwner owner, Typeable oldOwner) =>
owner -> DatumHijackingParams
ownedByDatumHijackingParams = Optic' An_AffineFold NoIx TxSkelOut oldOwner
-> owner -> DatumHijackingParams
forall owner k (is :: IxList) x.
(IsTxSkelOutAllowedOwner owner, Is k An_AffineFold) =>
Optic' k is TxSkelOut x -> owner -> DatumHijackingParams
defaultDatumHijackingParams (Lens' TxSkelOut (User 'IsEither 'Allocation)
txSkelOutOwnerL Lens' TxSkelOut (User 'IsEither 'Allocation)
-> Optic
     An_AffineFold
     NoIx
     (User 'IsEither 'Allocation)
     (User 'IsEither 'Allocation)
     oldOwner
     oldOwner
-> Optic' An_AffineFold NoIx TxSkelOut oldOwner
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 user (kind :: UserKind) (mode :: UserMode).
Typeable user =>
AffineFold (User kind mode) user
userTypedAF @oldOwner)

-- | Datum hijacking parameters targetting all the outputs owned by a script,
-- and redirecting each of them in a separate transaction.
scriptsDatumHijackingParams :: (IsTxSkelOutAllowedOwner owner) => owner -> DatumHijackingParams
scriptsDatumHijackingParams :: forall owner.
IsTxSkelOutAllowedOwner owner =>
owner -> DatumHijackingParams
scriptsDatumHijackingParams = Optic' An_AffineFold NoIx TxSkelOut ScriptHash
-> owner -> DatumHijackingParams
forall owner k (is :: IxList) x.
(IsTxSkelOutAllowedOwner owner, Is k An_AffineFold) =>
Optic' k is TxSkelOut x -> owner -> DatumHijackingParams
defaultDatumHijackingParams (Lens' TxSkelOut (User 'IsEither 'Allocation)
txSkelOutOwnerL Lens' TxSkelOut (User 'IsEither 'Allocation)
-> Optic
     An_AffineFold
     NoIx
     (User 'IsEither 'Allocation)
     (User 'IsEither 'Allocation)
     ScriptHash
     ScriptHash
-> Optic' An_AffineFold NoIx TxSkelOut ScriptHash
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_AffineFold
  NoIx
  (User 'IsEither 'Allocation)
  (User 'IsEither 'Allocation)
  ScriptHash
  ScriptHash
forall (kind :: UserKind) (mode :: UserMode).
AffineFold (User kind mode) ScriptHash
userScriptHashAF)

-- | Datum hijacking parameters targetting all the outputs with a certain type
-- of datum, and redirecting each of them in a separate transaction.
datumOfDatumHijackingParams :: forall dat owner. (IsTxSkelOutAllowedOwner owner, DatumConstrs dat) => owner -> DatumHijackingParams
datumOfDatumHijackingParams :: forall dat owner.
(IsTxSkelOutAllowedOwner owner, DatumConstrs dat) =>
owner -> DatumHijackingParams
datumOfDatumHijackingParams = Optic' An_AffineTraversal NoIx TxSkelOut dat
-> owner -> DatumHijackingParams
forall owner k (is :: IxList) x.
(IsTxSkelOutAllowedOwner owner, Is k An_AffineFold) =>
Optic' k is TxSkelOut x -> owner -> DatumHijackingParams
defaultDatumHijackingParams (Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL Lens' TxSkelOut TxSkelOutDatum
-> Optic
     An_AffineTraversal NoIx TxSkelOutDatum TxSkelOutDatum dat dat
-> Optic' An_AffineTraversal NoIx TxSkelOut dat
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 b.
(DatumConstrs a, DatumConstrs b) =>
AffineTraversal TxSkelOutDatum TxSkelOutDatum a b
txSkelOutDatumTypedAT @dat)

-- | Redirects, in the same transaction, all the outputs targetted by an output
-- and an index predicates. See 'DatumHijackingParams' for more information on
-- those predicates. Returns a pair of the old outputs before they were
-- redirected, and the new updated list of outputs.
redirectOutputTweakAll ::
  (MonadTweak m, IsTxSkelOutAllowedOwner owner) =>
  (TxSkelOut -> Maybe owner) ->
  (Integer -> Bool) ->
  m ([TxSkelOut], [TxSkelOut])
redirectOutputTweakAll :: forall (m :: * -> *) owner.
(MonadTweak m, IsTxSkelOutAllowedOwner owner) =>
(TxSkelOut -> Maybe owner)
-> (Integer -> Bool) -> m ([TxSkelOut], [TxSkelOut])
redirectOutputTweakAll TxSkelOut -> 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
  ([TxSkelOut], [TxSkelOut]) -> m ([TxSkelOut], [TxSkelOut])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (([TxSkelOut], [TxSkelOut]) -> m ([TxSkelOut], [TxSkelOut]))
-> ([TxSkelOut], [TxSkelOut]) -> m ([TxSkelOut], [TxSkelOut])
forall a b. (a -> b) -> a -> b
$ [TxSkelOut] -> Integer -> ([TxSkelOut], [TxSkelOut])
go [TxSkelOut]
outputs Integer
0
  where
    go :: [TxSkelOut] -> Integer -> ([TxSkelOut], [TxSkelOut])
go [] Integer
_ = ([], [])
    go (TxSkelOut
out : [TxSkelOut]
l) Integer
n =
      case TxSkelOut -> Maybe owner
outputPred TxSkelOut
out of
        Maybe owner
Nothing -> ([TxSkelOut] -> [TxSkelOut])
-> ([TxSkelOut], [TxSkelOut]) -> ([TxSkelOut], [TxSkelOut])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (TxSkelOut
out TxSkelOut -> [TxSkelOut] -> [TxSkelOut]
forall a. a -> [a] -> [a]
:) (([TxSkelOut], [TxSkelOut]) -> ([TxSkelOut], [TxSkelOut]))
-> ([TxSkelOut], [TxSkelOut]) -> ([TxSkelOut], [TxSkelOut])
forall a b. (a -> b) -> a -> b
$ [TxSkelOut] -> Integer -> ([TxSkelOut], [TxSkelOut])
go [TxSkelOut]
l Integer
n
        Just owner
newOwner | Integer -> Bool
indexPred Integer
n -> ([TxSkelOut] -> [TxSkelOut])
-> ([TxSkelOut] -> [TxSkelOut])
-> ([TxSkelOut], [TxSkelOut])
-> ([TxSkelOut], [TxSkelOut])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TxSkelOut
out TxSkelOut -> [TxSkelOut] -> [TxSkelOut]
forall a. a -> [a] -> [a]
:) ((TxSkelOut
out TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut (User 'IsEither 'Allocation)
txSkelOutOwnerL Lens' TxSkelOut (User 'IsEither 'Allocation)
-> User 'IsEither 'Allocation -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ owner -> User 'IsEither 'Allocation
forall a.
IsTxSkelOutAllowedOwner a =>
a -> User 'IsEither 'Allocation
toPKHOrVScript owner
newOwner) TxSkelOut -> [TxSkelOut] -> [TxSkelOut]
forall a. a -> [a] -> [a]
:) (([TxSkelOut], [TxSkelOut]) -> ([TxSkelOut], [TxSkelOut]))
-> ([TxSkelOut], [TxSkelOut]) -> ([TxSkelOut], [TxSkelOut])
forall a b. (a -> b) -> a -> b
$ [TxSkelOut] -> Integer -> ([TxSkelOut], [TxSkelOut])
go [TxSkelOut]
l (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
        Maybe owner
_ -> ([TxSkelOut] -> [TxSkelOut])
-> ([TxSkelOut], [TxSkelOut]) -> ([TxSkelOut], [TxSkelOut])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (TxSkelOut
out TxSkelOut -> [TxSkelOut] -> [TxSkelOut]
forall a. a -> [a] -> [a]
:) (([TxSkelOut], [TxSkelOut]) -> ([TxSkelOut], [TxSkelOut]))
-> ([TxSkelOut], [TxSkelOut]) -> ([TxSkelOut], [TxSkelOut])
forall a b. (a -> b) -> a -> b
$ [TxSkelOut] -> Integer -> ([TxSkelOut], [TxSkelOut])
go [TxSkelOut]
l (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)

-- | Redirects, each in their own transaction, all the outputs targetted by an
-- output and an index predicates. See 'DatumHijackingParams' for more
-- information on those predicates.
redirectOutputTweakAny ::
  (MonadTweak m, IsTxSkelOutAllowedOwner owner) =>
  (TxSkelOut -> Maybe owner) ->
  (Integer -> Bool) ->
  m ([TxSkelOut], [TxSkelOut])
redirectOutputTweakAny :: forall (m :: * -> *) owner.
(MonadTweak m, IsTxSkelOutAllowedOwner owner) =>
(TxSkelOut -> Maybe owner)
-> (Integer -> Bool) -> m ([TxSkelOut], [TxSkelOut])
redirectOutputTweakAny TxSkelOut -> 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 ([TxSkelOut], [TxSkelOut]))
-> m ([TxSkelOut], [TxSkelOut])
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 ([TxSkelOut], [TxSkelOut])
go [] Integer
0
  where
    go :: [TxSkelOut]
-> Integer -> [TxSkelOut] -> m ([TxSkelOut], [TxSkelOut])
go [TxSkelOut]
_ Integer
_ [] = m ([TxSkelOut], [TxSkelOut])
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 ([TxSkelOut], [TxSkelOut])
-> Maybe (m ([TxSkelOut], [TxSkelOut]))
-> m ([TxSkelOut], [TxSkelOut])
forall a. a -> Maybe a -> a
fromMaybe
            ([TxSkelOut]
-> Integer -> [TxSkelOut] -> m ([TxSkelOut], [TxSkelOut])
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
                owner
newOwner <- TxSkelOut -> Maybe owner
outputPred TxSkelOut
out
                m ([TxSkelOut], [TxSkelOut])
-> Maybe (m ([TxSkelOut], [TxSkelOut]))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (m ([TxSkelOut], [TxSkelOut])
 -> Maybe (m ([TxSkelOut], [TxSkelOut])))
-> m ([TxSkelOut], [TxSkelOut])
-> Maybe (m ([TxSkelOut], [TxSkelOut]))
forall a b. (a -> b) -> a -> b
$
                  m ([TxSkelOut], [TxSkelOut])
-> m ([TxSkelOut], [TxSkelOut]) -> m ([TxSkelOut], [TxSkelOut])
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
                    (([TxSkelOut], [TxSkelOut]) -> m ([TxSkelOut], [TxSkelOut])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TxSkelOut
out], [TxSkelOut]
l' [TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. [a] -> [a] -> [a]
++ (TxSkelOut
out TxSkelOut -> (TxSkelOut -> TxSkelOut) -> TxSkelOut
forall a b. a -> (a -> b) -> b
& Lens' TxSkelOut (User 'IsEither 'Allocation)
txSkelOutOwnerL Lens' TxSkelOut (User 'IsEither 'Allocation)
-> User 'IsEither 'Allocation -> TxSkelOut -> TxSkelOut
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ owner -> User 'IsEither 'Allocation
forall a.
IsTxSkelOutAllowedOwner a =>
a -> User 'IsEither 'Allocation
toPKHOrVScript owner
newOwner) TxSkelOut -> [TxSkelOut] -> [TxSkelOut]
forall a. a -> [a] -> [a]
: [TxSkelOut]
l))
                    ([TxSkelOut]
-> Integer -> [TxSkelOut] -> m ([TxSkelOut], [TxSkelOut])
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 ([TxSkelOut], [TxSkelOut])
go ([TxSkelOut]
l' [TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. [a] -> [a] -> [a]
++ [TxSkelOut
out]) Integer
n [TxSkelOut]
l

-- | A datum hijacking attack, simplified: This attack tries to substitute a
-- different recipient on certain outputs based on a 'DatumHijackingParams'.
--
-- A 'DatumHijackingLabel' is added to the labels of the 'TxSkel' using
-- 'addLabelTweak'. It contains the outputs that have been redirected, which
-- also corresponds to the returned value of this tweak. The tweak fails if no
-- such outputs have been redirected.
datumHijackingAttack :: (MonadTweak m) => DatumHijackingParams -> m [TxSkelOut]
datumHijackingAttack :: forall (m :: * -> *).
MonadTweak m =>
DatumHijackingParams -> m [TxSkelOut]
datumHijackingAttack (DatumHijackingParams TxSkelOut -> Maybe owner
outputPred Integer -> Bool
indexPred Bool
mode) = do
  ([TxSkelOut]
redirected, [TxSkelOut]
newOutputs) <- (if Bool
mode then (TxSkelOut -> Maybe owner)
-> (Integer -> Bool) -> m ([TxSkelOut], [TxSkelOut])
forall (m :: * -> *) owner.
(MonadTweak m, IsTxSkelOutAllowedOwner owner) =>
(TxSkelOut -> Maybe owner)
-> (Integer -> Bool) -> m ([TxSkelOut], [TxSkelOut])
redirectOutputTweakAll else (TxSkelOut -> Maybe owner)
-> (Integer -> Bool) -> m ([TxSkelOut], [TxSkelOut])
forall (m :: * -> *) owner.
(MonadTweak m, IsTxSkelOutAllowedOwner owner) =>
(TxSkelOut -> Maybe owner)
-> (Integer -> Bool) -> m ([TxSkelOut], [TxSkelOut])
redirectOutputTweakAny) TxSkelOut -> Maybe owner
outputPred Integer -> Bool
indexPred
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [TxSkelOut] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxSkelOut]
redirected
  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
  DatumHijackingLabel -> m ()
forall (m :: * -> *) x. (MonadTweak m, LabelConstrs x) => x -> m ()
addLabelTweak (DatumHijackingLabel -> m ()) -> DatumHijackingLabel -> m ()
forall a b. (a -> b) -> a -> b
$ [TxSkelOut] -> DatumHijackingLabel
DatumHijackingLabel [TxSkelOut]
redirected
  [TxSkelOut] -> m [TxSkelOut]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TxSkelOut]
redirected