{-# LANGUAGE ViewPatterns #-}
module Plutus.Contract.Test.MissingLovelace
( calculateDelta
) where
import Ledger.Ada qualified as Ada
import Ledger.Value (Value, noAdaValue)
import PlutusTx.Prelude qualified as P
calculateDelta
:: Value
-> Ada.Ada
-> Ada.Ada
-> [Ada.Ada]
-> Value
calculateDelta :: Value -> Ada -> Ada -> [Ada] -> Value
calculateDelta Value
expectedDelta Ada
initialValue Ada
finalValue [Ada]
allWalletsTxOutCosts =
let
expectedAda :: Ada
expectedAda = Value -> Ada
Ada.fromValue Value
expectedDelta
deltas :: [Ada]
deltas = (Ada -> Ada) -> [Ada] -> [Ada]
forall a b. (a -> b) -> [a] -> [b]
map Ada -> Ada
forall n. (Ord n, AdditiveGroup n) => n -> n
P.abs ([Ada] -> [Ada]) -> [Ada] -> [Ada]
forall a b. (a -> b) -> a -> b
$ [[Ada]] -> [Ada]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ Ada -> Ada
forall n. (Ord n, AdditiveGroup n) => n -> n
P.abs Ada
val Ada -> Ada -> Ada
forall a. AdditiveGroup a => a -> a -> a
P.- Ada -> Ada
forall n. (Ord n, AdditiveGroup n) => n -> n
P.abs Ada
wCost
, Ada -> Ada
forall n. (Ord n, AdditiveGroup n) => n -> n
P.abs Ada
val Ada -> Ada -> Ada
forall a. AdditiveSemigroup a => a -> a -> a
P.+ Ada -> Ada
forall n. (Ord n, AdditiveGroup n) => n -> n
P.abs Ada
wCost ] | Ada
val <- [Ada
expectedAda, Ada
0] [Ada] -> [Ada] -> [Ada]
forall a. [a] -> [a] -> [a]
++ [Ada]
allWalletsTxOutCosts
, Ada
wCost <- [Ada]
allWalletsTxOutCosts ]
realDelta :: Ada
realDelta = Ada
finalValue Ada -> Ada -> Ada
forall a. AdditiveGroup a => a -> a -> a
P.- Ada
initialValue
missingDelta :: Value
missingDelta =
if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [(Ada -> Ada
forall n. (Ord n, AdditiveGroup n) => n -> n
P.abs Ada
realDelta) Ada -> Ada -> Ada
forall a. Integral a => a -> a -> a
`mod` Ada
d Ada -> Ada -> Bool
forall a. Eq a => a -> a -> Bool
== Ada
0 | Ada
d <- [Ada]
deltas, Ada
d Ada -> Ada -> Bool
forall a. Eq a => a -> a -> Bool
/= Ada
0] then
let missingAda :: Value
missingAda = Ada -> Value
Ada.toValue Ada
realDelta
missingNonAda :: Value
missingNonAda = Value -> Value
noAdaValue Value
expectedDelta
in Value
missingAda Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
missingNonAda
else Value
expectedDelta
in
if Ada
expectedAda Ada -> Ada -> Bool
forall a. Eq a => a -> a -> Bool
== Ada
realDelta then Value
expectedDelta
else Value
missingDelta