-- | 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,
  )
where

import Cooked.Skeleton
import Cooked.Wallet
import Data.Default
import Data.List (foldl')
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 user.
--
--  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
--
--  > i0 = distributionFromList $
--  >        [ (wallet 1 , [ ada 42 , ada 2 <> quickValue "TOK" 1 ]
--  >        , (wallet 2 , [ ada 10 ])
--  >        , (wallet 3 , [ ada 10 <> permanentValue "XYZ" 10])
--  >        ]
--
-- Note that payment issued through an initial distribution will be attached
-- enough ADA to sustain themselves.
data InitialDistribution where
  InitialDistribution ::
    {InitialDistribution -> [TxSkelOut]
unInitialDistribution :: [TxSkelOut]} ->
    InitialDistribution

-- | 4 UTxOs with 100 Ada each, for each of the first 4 'knownWallets'
instance Default InitialDistribution where
  def :: InitialDistribution
def = [(Wallet, [Value])] -> InitialDistribution
forall owner.
IsTxSkelOutAllowedOwner owner =>
[(owner, [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 (Int -> [Wallet] -> [Wallet]
forall a. Int -> [a] -> [a]
take Int
4 [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
4 (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

-- | Creating a initial distribution with simple values assigned to owners
distributionFromList :: (IsTxSkelOutAllowedOwner owner) => [(owner, [Api.Value])] -> InitialDistribution
distributionFromList :: forall owner.
IsTxSkelOutAllowedOwner owner =>
[(owner, [Value])] -> InitialDistribution
distributionFromList = [TxSkelOut] -> InitialDistribution
InitialDistribution ([TxSkelOut] -> InitialDistribution)
-> ([(owner, [Value])] -> [TxSkelOut])
-> [(owner, [Value])]
-> InitialDistribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxSkelOut] -> (owner, [Value]) -> [TxSkelOut])
-> [TxSkelOut] -> [(owner, [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 (owner
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 (owner -> Payable '[ 'IsValue] -> TxSkelOut
forall owner (els :: [PayableKind]).
IsTxSkelOutAllowedOwner owner =>
owner -> Payable els -> TxSkelOut
receives owner
user (Payable '[ 'IsValue] -> TxSkelOut)
-> (Value -> Payable '[ 'IsValue]) -> Value -> TxSkelOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Payable '[ 'IsValue]
forall a1. ToValue a1 => a1 -> Payable '[ 'IsValue]
Value) [Value]
values) []