-- | This module provides a convenient way to spread assets between wallets and
-- scripts at the initialization of the mock chain. These initial assets can be
-- accompanied by datums, staking credentials and reference scripts.
module Cooked.InitialDistribution
  ( InitialDistribution (..),
    distributionFromList,
    toInitDistWithMinAda,
    unsafeToInitDistWithMinAda,
  )
where

import Control.Monad
import Cooked.MockChain.GenerateTx
import Cooked.MockChain.MinAda
import Cooked.Skeleton
import Cooked.Wallet
import Data.Default
import Data.List
import Plutus.Script.Utils.Value qualified as Script
import PlutusLedgerApi.V3 qualified as Api

-- * Initial distribution of funds

-- | Describes the initial distribution of UTxOs per wallet. This is important
-- since transaction validation must specify a /collateral/. Hence, wallets must
-- have more than one UTxO to begin with in order to execute a transaction and
-- have some collateral option. The @txCollateral@ is transferred to the node
-- operator in case the transaction fails to validate.
--
--  The following specifies a starting state where @wallet 1@ owns two UTxOs,
--  one with 42 Ada and one with 2 Ada and one "TOK" token; @wallet 2@ owns a
--  single UTxO with 10 Ada and @wallet 3@ has 10 Ada and a permanent value. See
--  "Cooked.Currencies" for more information on quick and permanent values.
--
--  > i0 = distributionFromList $
--  >        [ (wallet 1 , [ ada 42 , ada 2 <> quickValue "TOK" 1 ]
--  >        , (wallet 2 , [ ada 10 ])
--  >        , (wallet 3 , [ ada 10 <> permanentValue "XYZ" 10])
--  >        ]
--
-- Note that initial distribution can lead to payments that would not be
-- accepted if part of an actual transaction, such as payment without enough ada
-- to sustain themselves.
data InitialDistribution where
  InitialDistribution ::
    {InitialDistribution -> [TxSkelOut]
unInitialDistribution :: [TxSkelOut]} ->
    InitialDistribution

-- | 5 UTxOs with 100 Ada each, for each of the 'knownWallets'
instance Default InitialDistribution where
  def :: InitialDistribution
def = [(Wallet, [Value])] -> InitialDistribution
distributionFromList ([(Wallet, [Value])] -> InitialDistribution)
-> (Value -> [(Wallet, [Value])]) -> Value -> InitialDistribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Wallet] -> [[Value]] -> [(Wallet, [Value])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Wallet]
knownWallets ([[Value]] -> [(Wallet, [Value])])
-> (Value -> [[Value]]) -> Value -> [(Wallet, [Value])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> [[Value]]
forall a. a -> [a]
repeat ([Value] -> [[Value]]) -> (Value -> [Value]) -> Value -> [[Value]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
5 (Value -> InitialDistribution) -> Value -> InitialDistribution
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Script.ada Integer
100

instance Semigroup InitialDistribution where
  InitialDistribution
i <> :: InitialDistribution -> InitialDistribution -> InitialDistribution
<> InitialDistribution
j = [TxSkelOut] -> InitialDistribution
InitialDistribution (InitialDistribution -> [TxSkelOut]
unInitialDistribution InitialDistribution
i [TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. Semigroup a => a -> a -> a
<> InitialDistribution -> [TxSkelOut]
unInitialDistribution InitialDistribution
j)

instance Monoid InitialDistribution where
  mempty :: InitialDistribution
mempty = [TxSkelOut] -> InitialDistribution
InitialDistribution [TxSkelOut]
forall a. Monoid a => a
mempty

-- | Transforms a given initial distribution by ensuring each payment has enough
-- ada so that the resulting outputs can sustain themselves. This can fail if
-- any of the payments cannot be translated to their Cardano counterpart.
toInitDistWithMinAda :: InitialDistribution -> Either GenerateTxError InitialDistribution
toInitDistWithMinAda :: InitialDistribution -> Either GenerateTxError InitialDistribution
toInitDistWithMinAda (InitialDistribution [TxSkelOut]
initDist) =
  [TxSkelOut] -> InitialDistribution
InitialDistribution ([TxSkelOut] -> InitialDistribution)
-> Either GenerateTxError [TxSkelOut]
-> Either GenerateTxError InitialDistribution
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSkelOut]
-> (TxSkelOut -> Either GenerateTxError TxSkelOut)
-> Either GenerateTxError [TxSkelOut]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TxSkelOut]
initDist (Params -> TxSkelOut -> Either GenerateTxError TxSkelOut
toTxSkelOutWithMinAda Params
forall a. Default a => a
def)

-- | Unsafe variant of `toInitDistWithMinAda`
unsafeToInitDistWithMinAda :: InitialDistribution -> InitialDistribution
unsafeToInitDistWithMinAda :: InitialDistribution -> InitialDistribution
unsafeToInitDistWithMinAda InitialDistribution
initDist = case InitialDistribution -> Either GenerateTxError InitialDistribution
toInitDistWithMinAda InitialDistribution
initDist of
  Left GenerateTxError
err -> [Char] -> InitialDistribution
forall a. HasCallStack => [Char] -> a
error ([Char] -> InitialDistribution) -> [Char] -> InitialDistribution
forall a b. (a -> b) -> a -> b
$ GenerateTxError -> [Char]
forall a. Show a => a -> [Char]
show GenerateTxError
err
  Right InitialDistribution
initDist' -> InitialDistribution
initDist'

-- | Creating a initial distribution with simple values assigned to wallets
distributionFromList :: [(Wallet, [Api.Value])] -> InitialDistribution
distributionFromList :: [(Wallet, [Value])] -> InitialDistribution
distributionFromList = [TxSkelOut] -> InitialDistribution
InitialDistribution ([TxSkelOut] -> InitialDistribution)
-> ([(Wallet, [Value])] -> [TxSkelOut])
-> [(Wallet, [Value])]
-> InitialDistribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxSkelOut] -> (Wallet, [Value]) -> [TxSkelOut])
-> [TxSkelOut] -> [(Wallet, [Value])] -> [TxSkelOut]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[TxSkelOut]
x (Wallet
user, [Value]
values) -> [TxSkelOut]
x [TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. Semigroup a => a -> a -> a
<> (Value -> TxSkelOut) -> [Value] -> [TxSkelOut]
forall a b. (a -> b) -> [a] -> [b]
map (Wallet -> Value -> TxSkelOut
forall a. ToPubKeyHash a => a -> Value -> TxSkelOut
paysPK Wallet
user) [Value]
values) []