module Cooked.Attack.RedeemerTampering
(
RedeemerTamperingParams (..),
spendingRedeemerTamperingParams,
mintingRedeemerTamperingParams,
proposingRedeemerTamperingParams,
certifyingRedeemerTamperingParams,
withdrawingRedeemerTamperingParams,
allRedeemerTamperingParams,
RedeemerTamperingLabel (..),
redeemerTamperingAttack,
)
where
import Control.Applicative
import Cooked.Pretty.Class
import Cooked.Skeleton
import Cooked.Tweak
import Optics.Core
import Polysemy
import Polysemy.NonDet
newtype RedeemerTamperingLabel a = RedeemerTamperingLabel [a]
deriving (Int -> RedeemerTamperingLabel a -> ShowS
[RedeemerTamperingLabel a] -> ShowS
RedeemerTamperingLabel a -> String
(Int -> RedeemerTamperingLabel a -> ShowS)
-> (RedeemerTamperingLabel a -> String)
-> ([RedeemerTamperingLabel a] -> ShowS)
-> Show (RedeemerTamperingLabel a)
forall a. Show a => Int -> RedeemerTamperingLabel a -> ShowS
forall a. Show a => [RedeemerTamperingLabel a] -> ShowS
forall a. Show a => RedeemerTamperingLabel a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RedeemerTamperingLabel a -> ShowS
showsPrec :: Int -> RedeemerTamperingLabel a -> ShowS
$cshow :: forall a. Show a => RedeemerTamperingLabel a -> String
show :: RedeemerTamperingLabel a -> String
$cshowList :: forall a. Show a => [RedeemerTamperingLabel a] -> ShowS
showList :: [RedeemerTamperingLabel a] -> ShowS
Show, RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
(RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool)
-> (RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool)
-> Eq (RedeemerTamperingLabel a)
forall a.
Eq a =>
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
== :: RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
$c/= :: forall a.
Eq a =>
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
/= :: RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
Eq, Eq (RedeemerTamperingLabel a)
Eq (RedeemerTamperingLabel a) =>
(RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Ordering)
-> (RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool)
-> (RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool)
-> (RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool)
-> (RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool)
-> (RedeemerTamperingLabel a
-> RedeemerTamperingLabel a -> RedeemerTamperingLabel a)
-> (RedeemerTamperingLabel a
-> RedeemerTamperingLabel a -> RedeemerTamperingLabel a)
-> Ord (RedeemerTamperingLabel a)
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Ordering
RedeemerTamperingLabel a
-> RedeemerTamperingLabel a -> RedeemerTamperingLabel a
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
forall a. Ord a => Eq (RedeemerTamperingLabel a)
forall a.
Ord a =>
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
forall a.
Ord a =>
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Ordering
forall a.
Ord a =>
RedeemerTamperingLabel a
-> RedeemerTamperingLabel a -> RedeemerTamperingLabel a
$ccompare :: forall a.
Ord a =>
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Ordering
compare :: RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Ordering
$c< :: forall a.
Ord a =>
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
< :: RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
$c<= :: forall a.
Ord a =>
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
<= :: RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
$c> :: forall a.
Ord a =>
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
> :: RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
$c>= :: forall a.
Ord a =>
RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
>= :: RedeemerTamperingLabel a -> RedeemerTamperingLabel a -> Bool
$cmax :: forall a.
Ord a =>
RedeemerTamperingLabel a
-> RedeemerTamperingLabel a -> RedeemerTamperingLabel a
max :: RedeemerTamperingLabel a
-> RedeemerTamperingLabel a -> RedeemerTamperingLabel a
$cmin :: forall a.
Ord a =>
RedeemerTamperingLabel a
-> RedeemerTamperingLabel a -> RedeemerTamperingLabel a
min :: RedeemerTamperingLabel a
-> RedeemerTamperingLabel a -> RedeemerTamperingLabel a
Ord)
instance (PrettyCooked a) => PrettyCooked (RedeemerTamperingLabel a) where
prettyCookedOpt :: PrettyCookedOpts -> RedeemerTamperingLabel a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (RedeemerTamperingLabel [a]
reds) =
PrettyCookedOpts -> DocCooked -> DocCooked -> [a] -> DocCooked
forall a.
PrettyCookedList a =>
PrettyCookedOpts -> DocCooked -> DocCooked -> a -> DocCooked
prettyItemize PrettyCookedOpts
opts DocCooked
"Tamper Redeemers" DocCooked
"-" [a]
reds
data RedeemerTamperingParams a b f k is
= RedeemerTamperingParams
{
forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
RedeemerTamperingParams a b f k is -> Branching
rtpBranching :: Branching,
forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
RedeemerTamperingParams a b f k is
-> Optic' k is TxSkel TxSkelRedeemer
rtpOptic :: Optic' k is TxSkel TxSkelRedeemer,
forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
RedeemerTamperingParams a b f k is -> a -> f b
rtpModification :: a -> f b,
forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
RedeemerTamperingParams a b f k is -> Int -> Bool
rtpIndexPred :: Int -> Bool
}
spendingRedeemerTamperingParams ::
forall a b f.
Branching ->
(a -> f b) ->
RedeemerTamperingParams a b f A_Traversal NoIx
spendingRedeemerTamperingParams :: forall {k} a (b :: k) (f :: k -> *).
Branching
-> (a -> f b) -> RedeemerTamperingParams a b f A_Traversal NoIx
spendingRedeemerTamperingParams Branching
branching a -> f b
mChange =
Branching
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f A_Traversal NoIx
forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
Branching
-> Optic' k is TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f k is
RedeemerTamperingParams Branching
branching Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
txSkelSpendingRedeemersT a -> f b
mChange (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True)
mintingRedeemerTamperingParams ::
forall a b f.
Branching ->
(a -> f b) ->
RedeemerTamperingParams a b f A_Traversal NoIx
mintingRedeemerTamperingParams :: forall {k} a (b :: k) (f :: k -> *).
Branching
-> (a -> f b) -> RedeemerTamperingParams a b f A_Traversal NoIx
mintingRedeemerTamperingParams Branching
branching a -> f b
mChange =
Branching
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f A_Traversal NoIx
forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
Branching
-> Optic' k is TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f k is
RedeemerTamperingParams Branching
branching (Traversal' TxSkel (User 'IsScript 'Redemption)
txSkelMintingRedeemedScriptsT Traversal' TxSkel (User 'IsScript 'Redemption)
-> Optic
A_Lens
NoIx
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
TxSkelRedeemer
TxSkelRedeemer
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
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_Lens
NoIx
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
TxSkelRedeemer
TxSkelRedeemer
userRedeemerL) a -> f b
mChange (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True)
proposingRedeemerTamperingParams ::
forall a b f.
Branching ->
(a -> f b) ->
RedeemerTamperingParams a b f A_Traversal NoIx
proposingRedeemerTamperingParams :: forall {k} a (b :: k) (f :: k -> *).
Branching
-> (a -> f b) -> RedeemerTamperingParams a b f A_Traversal NoIx
proposingRedeemerTamperingParams Branching
branching a -> f b
mChange =
Branching
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f A_Traversal NoIx
forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
Branching
-> Optic' k is TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f k is
RedeemerTamperingParams Branching
branching (Traversal' TxSkel (User 'IsScript 'Redemption)
txSkelProposingRedeemedScriptsT Traversal' TxSkel (User 'IsScript 'Redemption)
-> Optic
A_Lens
NoIx
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
TxSkelRedeemer
TxSkelRedeemer
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
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_Lens
NoIx
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
TxSkelRedeemer
TxSkelRedeemer
userRedeemerL) a -> f b
mChange (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True)
withdrawingRedeemerTamperingParams ::
forall a b f.
Branching ->
(a -> f b) ->
RedeemerTamperingParams a b f A_Traversal NoIx
withdrawingRedeemerTamperingParams :: forall {k} a (b :: k) (f :: k -> *).
Branching
-> (a -> f b) -> RedeemerTamperingParams a b f A_Traversal NoIx
withdrawingRedeemerTamperingParams Branching
branching a -> f b
mChange =
Branching
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f A_Traversal NoIx
forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
Branching
-> Optic' k is TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f k is
RedeemerTamperingParams Branching
branching (Traversal' TxSkel (User 'IsEither 'Redemption)
txSkelWithdrawingRedeemedUsersT Traversal' TxSkel (User 'IsEither 'Redemption)
-> Optic
A_Prism
NoIx
(User 'IsEither 'Redemption)
(User 'IsEither 'Redemption)
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
-> Traversal' TxSkel (User 'IsScript 'Redemption)
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_Prism
NoIx
(User 'IsEither 'Redemption)
(User 'IsEither 'Redemption)
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
forall (mode :: UserMode).
Prism' (User 'IsEither mode) (User 'IsScript mode)
userEitherScriptP Traversal' TxSkel (User 'IsScript 'Redemption)
-> Optic
A_Lens
NoIx
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
TxSkelRedeemer
TxSkelRedeemer
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
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_Lens
NoIx
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
TxSkelRedeemer
TxSkelRedeemer
userRedeemerL) a -> f b
mChange (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True)
certifyingRedeemerTamperingParams ::
forall a b f.
Branching ->
(a -> f b) ->
RedeemerTamperingParams a b f A_Traversal NoIx
certifyingRedeemerTamperingParams :: forall {k} a (b :: k) (f :: k -> *).
Branching
-> (a -> f b) -> RedeemerTamperingParams a b f A_Traversal NoIx
certifyingRedeemerTamperingParams Branching
branching a -> f b
mChange =
Branching
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f A_Traversal NoIx
forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
Branching
-> Optic' k is TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f k is
RedeemerTamperingParams Branching
branching (Traversal' TxSkel (User 'IsEither 'Redemption)
forall (user :: UserKind).
Typeable user =>
Traversal' TxSkel (User user 'Redemption)
txSkelCertifyingRedeemedUsersT Traversal' TxSkel (User 'IsEither 'Redemption)
-> Optic
A_Prism
NoIx
(User 'IsEither 'Redemption)
(User 'IsEither 'Redemption)
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
-> Traversal' TxSkel (User 'IsScript 'Redemption)
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_Prism
NoIx
(User 'IsEither 'Redemption)
(User 'IsEither 'Redemption)
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
forall (mode :: UserMode).
Prism' (User 'IsEither mode) (User 'IsScript mode)
userEitherScriptP Traversal' TxSkel (User 'IsScript 'Redemption)
-> Optic
A_Lens
NoIx
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
TxSkelRedeemer
TxSkelRedeemer
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
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_Lens
NoIx
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
TxSkelRedeemer
TxSkelRedeemer
userRedeemerL) a -> f b
mChange (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True)
allRedeemerTamperingParams ::
forall a b f.
Branching ->
(a -> f b) ->
RedeemerTamperingParams a b f A_Traversal NoIx
allRedeemerTamperingParams :: forall {k} a (b :: k) (f :: k -> *).
Branching
-> (a -> f b) -> RedeemerTamperingParams a b f A_Traversal NoIx
allRedeemerTamperingParams Branching
branching a -> f b
mChange =
Branching
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f A_Traversal NoIx
forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
Branching
-> Optic' k is TxSkel TxSkelRedeemer
-> (a -> f b)
-> (Int -> Bool)
-> RedeemerTamperingParams a b f k is
RedeemerTamperingParams Branching
branching Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
txSkelRedeemersT a -> f b
mChange (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True)
redeemerTamperingAttack ::
forall a b f k is effs.
( RedeemerConstrs a,
Ord a,
RedeemerConstrs b,
Foldable f,
Alternative f,
Is k A_Traversal,
Members '[NonDet, Tweak] effs
) =>
RedeemerTamperingParams a b f k is ->
Sem effs [a]
redeemerTamperingAttack :: forall a b (f :: * -> *) k (is :: IxList) (effs :: EffectRow).
(RedeemerConstrs a, Ord a, RedeemerConstrs b, Foldable f,
Alternative f, Is k A_Traversal, Members '[NonDet, Tweak] effs) =>
RedeemerTamperingParams a b f k is -> Sem effs [a]
redeemerTamperingAttack RedeemerTamperingParams {Optic' k is TxSkel TxSkelRedeemer
Branching
a -> f b
Int -> Bool
rtpBranching :: forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
RedeemerTamperingParams a b f k is -> Branching
rtpOptic :: forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
RedeemerTamperingParams a b f k is
-> Optic' k is TxSkel TxSkelRedeemer
rtpModification :: forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
RedeemerTamperingParams a b f k is -> a -> f b
rtpIndexPred :: forall {k} a (b :: k) (f :: k -> *) k (is :: IxList).
RedeemerTamperingParams a b f k is -> Int -> Bool
rtpBranching :: Branching
rtpOptic :: Optic' k is TxSkel TxSkelRedeemer
rtpModification :: a -> f b
rtpIndexPred :: Int -> Bool
..} = do
[a]
modified <-
ModifyTweakParams k An_AffineTraversal is NoIx f TxSkelRedeemer a b
-> Sem effs [a]
forall (effs :: EffectRow) k k' (f :: * -> *) (is :: IxList)
(is' :: IxList) a b c.
(Members '[Tweak, NonDet] effs, Is k A_Traversal,
Is k' An_AffineTraversal, Foldable f, Alternative f) =>
ModifyTweakParams k k' is is' f a b c -> Sem effs [b]
modifyTweakFromParams (ModifyTweakParams
k An_AffineTraversal is NoIx f TxSkelRedeemer a b
-> Sem effs [a])
-> ModifyTweakParams
k An_AffineTraversal is NoIx f TxSkelRedeemer a b
-> Sem effs [a]
forall a b. (a -> b) -> a -> b
$
Branching
-> Optic' k is TxSkel TxSkelRedeemer
-> Optic An_AffineTraversal NoIx TxSkelRedeemer TxSkelRedeemer a b
-> (a -> f b)
-> (Int -> Bool)
-> ModifyTweakParams
k An_AffineTraversal is NoIx f TxSkelRedeemer a b
forall k (is :: IxList) a k' (is' :: IxList) b c (f :: * -> *).
Branching
-> Optic' k is TxSkel a
-> Optic k' is' a a b c
-> (b -> f c)
-> (Int -> Bool)
-> ModifyTweakParams k k' is is' f a b c
ModifyTweakParams Branching
rtpBranching Optic' k is TxSkel TxSkelRedeemer
rtpOptic Optic An_AffineTraversal NoIx TxSkelRedeemer TxSkelRedeemer a b
forall a b.
(RedeemerConstrs a, RedeemerConstrs b) =>
AffineTraversal TxSkelRedeemer TxSkelRedeemer a b
txSkelRedeemerTypedAT a -> f b
rtpModification Int -> Bool
rtpIndexPred
Optic' A_Lens NoIx TxSkel (Set TxSkelLabel)
-> TxSkelLabel -> Sem effs ()
forall (effs :: EffectRow) k a (is :: IxList).
(Members '[Tweak, NonDet] effs, Is k A_Traversal, Ord a) =>
Optic' k is TxSkel (Set a) -> a -> Sem effs ()
insertInTweak Optic' A_Lens NoIx TxSkel (Set TxSkelLabel)
txSkelLabelsL (TxSkelLabel -> Sem effs ()) -> TxSkelLabel -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ RedeemerTamperingLabel a -> TxSkelLabel
forall x. LabelConstrs x => x -> TxSkelLabel
TxSkelLabel (RedeemerTamperingLabel a -> TxSkelLabel)
-> RedeemerTamperingLabel a -> TxSkelLabel
forall a b. (a -> b) -> a -> b
$ [a] -> RedeemerTamperingLabel a
forall a. [a] -> RedeemerTamperingLabel a
RedeemerTamperingLabel [a]
modified
[a] -> Sem effs [a]
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
modified