Plutus Playground Smart Contract

Playground.hs

-- This is a starter contract, based on the Game contract,
-- containing the bare minimum required scaffolding.
--
-- What you should change to something more suitable for
-- your use case:
--   * The DataScript type
--   * The Redeemer type
--
-- And add function implementations (and rename them to
-- something suitable) for the endpoints:
--   * publish
--   * redeem

import qualified Language.PlutusTx          as PlutusTx
import           Language.PlutusTx.Prelude
import           Ledger                     (Address, DataScript (DataScript), PendingTx, PubKey,
                                             RedeemerScript (RedeemerScript), ValidatorScript (ValidatorScript),
                                             compileScript, scriptAddress, lifted)
import           Ledger.Value               (Value)
import           Playground.Contract
import           Wallet                     (MonadWallet, WalletAPI, WalletDiagnostics, collectFromScript,
                                             defaultSlotRange, payToScript_, startWatching)
import Data.Map as M
-- | These are the data script and redeemer types. We are using an integer
--   value for both, but you should define your own types.
data DataValue = DataValue Integer
PlutusTx.makeLift ''DataValue

data RedeemerValue = RedeemerValue Integer
PlutusTx.makeLift ''RedeemerValue





    
-- | The address of the Multi signature wallet  (the hash of its validator script)
multi_sig_wallet_address :: Address
multi_sig_wallet_address = Ledger.scriptAddress mk_multi_sig_wallet_validator


mk_multi_sig_wallet_validator = undefined 

multi_sig_wallet_validator :: WalletAction -> ValidatorScript
multi_sig_wallet_validator action =
    case action of 
        Start -> undefined
        SuggestTransfer -> ValidatorScript ($$(Ledger.compileScript [|| validate_transfer ||]))
        Approve -> ValidatorScript ($$(Ledger.compileScript [|| validate_approval ||]))
        
    
createTransfer :: Transfers -> Value -> Address -> Transfers




--validate_transfer :: HashedString -> ClearString -> PendingTx -> Bool
validate_transfer dataScript redeemerScript _ = undefined--correctGuess dataScript redeemerScript
    
    
--validate_approval :: HashedString -> ClearString -> PendingTx -> Bool
validate_approval dataScript redeemerScript _ = undefined ---correctGuess dataScript redeemerScript
    
       

data Approvers = Approvers [Address]
data Quorum = Quorum Integer
data SentState = Sent | NotSent deriving (Eq, Show)
data Transfer = Transfer 
    { transferId              :: Integer
    , amount          :: Value
    , address         :: Address 
    , approvals_count :: Integer
    , sent            :: SentState
    }
    
data Transfers = CurrentTransfers [Transfer]
PlutusTx.makeLift ''Transfer
data Approvals = CurrentApprovals (Map PubKey [(Integer, Bool)])
data WalletAction = Start | SuggestTransfer | Approve








createTransfer :: Transfers -> Value -> Address -> Transfers
createTransfer (CurrentTransfers transfers) val address = 
    let tr =  Transfer 
            { transferId = length transfers
            , amount = val
            , address = address 
            , approvals_count = 0
            , sent = NotSent
            }
    in CurrentTransfers $ tr : transfers
    
checknotSent :: Transfer -> Bool
checknotSent t = (sent t == NotSent)


checknotNotApproved :: PubKey -> Integer -> Approvals -> Bool
checknotNotApproved pubKey _transferId (CurrentApprovals _approvals) = 
    let maybeApprovals = M.lookup pubKey  _approvals
    in case maybeApprovals of
        Just a -> True
        Nothing -> False
        
        

-- | should probably be local
set_new_approvals_state_for :: Integer -> [(Integer, Bool)] -> [(Integer, Bool)]
set_new_approvals_state_for tfrId [] = []
set_new_approvals_state_for tfrId ((t,s):(ts:ss)) 
    | tfrId == t = (t, True) : set_new_approvals_state_for tfrId (ts:ss)
    | otherwise = (t, s) : set_new_approvals_state_for tfrId (ts:ss)
    
    
    
-- | should probably be local
set_new_transfers_state :: Integer -> [Transfer] -> [Transfer]
set_new_transfers_state _ []  = []
set_new_transfers_state tfrId (t:ts)
    | tfrId == transferId t = 
        let current_approvals_count = approvals_count t 
        in t { approvals_count = current_approvals_count + 1 } : ts
    | otherwise = set_new_transfers_state tfrId ts


set_new_transfers_sent_flag :: Integer -> [Transfer] -> [Transfer]
set_new_transfers_sent_flag _ []  = []
set_new_transfers_sent_flag tfrId (t:ts)
    | tfrId == transferId t = t { sent = Sent } : ts
    | otherwise = set_new_transfers_sent_flag tfrId ts


-- | need to finish the happy path and inmplement the equivalent modifier function as well
                            
approveTransfer :: PubKey -> Integer -> Integer -> Transfers -> Approvals -> Either String (Transfers, Approvals)
approveTransfer address quorum transferIdToApprove (CurrentTransfers transfers) (CurrentApprovals currentApprovals) = 
    do 
    
        let transfer = Language.PlutusTx.Prelude.filter (\t -> (transferId t) == transferIdToApprove) transfers 
        case transfer of 
            []  -> Left "tranfer id not found"
            [ft]-> do 
                        let i = (checknotSent ft && checknotNotApproved address transferIdToApprove (CurrentApprovals currentApprovals)) 
                        case i of
                            True ->  do 
                                        let set_new_approvals_state_for' = set_new_approvals_state_for transferIdToApprove
                                            newApprovals = adjust set_new_approvals_state_for' address  currentApprovals
                                            newTransfers = set_new_transfers_state transferIdToApprove transfers
                                        
                                        
                                        case approvals_count ft >= quorum of 
                                            True -> Right $ let _newTransfer = set_new_transfers_sent_flag transferIdToApprove transfers
                                                        in 
                                                            --callPaytoScript here
                                                            (CurrentTransfers _newTransfer, CurrentApprovals newApprovals)
                                            False -> Right (CurrentTransfers newTransfers, CurrentApprovals newApprovals)

                            False -> Left "You have already approved this transfer!"
            
    
    
    
    -- 
    -- approvals[msg.sender][id] = true;
    -- transfers[id].approvals++;

    --  if(transfers[id].approvals >= quorum) {
    --   transfers[id].sent = true;
    --   address payable to = transfers[id].to;
    --   uint amount = transfers[id].amount;
    --   to.transfer(amount);
    -- }
    
    
    
    

-- | This method is the spending validator (which gets lifted to
--   its on-chain representation).
validateSpend :: DataValue -> RedeemerValue -> PendingTx -> Bool
validateSpend _dataValue _redeemerValue _ = error () -- Please provide an implementation.

-- | This function lifts the validator previously defined to
--   the on-chain representation.
contractValidator :: ValidatorScript
contractValidator =
    ValidatorScript ($$(Ledger.compileScript [|| validateSpend ||]))

-- | Helper function used to build the DataScript.
mkDataScript :: Integer -> DataScript
mkDataScript =
    DataScript . lifted . DataValue

-- | Helper function used to build the RedeemerScript.
mkRedeemerScript :: Integer -> RedeemerScript
mkRedeemerScript =
    RedeemerScript . lifted . RedeemerValue

-- | The address of the contract (the hash of its validator script).
contractAddress :: Address
contractAddress = Ledger.scriptAddress contractValidator

-- | The "publish" contract endpoint.
publish :: MonadWallet m => Integer -> Value -> m ()
publish dataValue lockedFunds  =
    payToScript_ defaultSlotRange contractAddress lockedFunds (mkDataScript dataValue)

-- | The "redeem" contract endpoint.
redeem :: (WalletAPI m, WalletDiagnostics m) => Integer -> m ()
redeem redeemerValue = do
    let redeemer = mkRedeemerScript redeemerValue
    collectFromScript defaultSlotRange contractValidator redeemer

-- | The "start" contract endpoint, telling the wallet to start watching
--   the address of the script.
start :: MonadWallet m => m ()
start =
    startWatching contractAddress

$(mkFunctions ['publish, 'redeem, 'start])

Simulation.json

[0,[{"wallets":[{"simulatorWalletWallet":{"getWallet":1},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}},{"simulatorWalletWallet":{"getWallet":2},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}}],"signatures":[{"functionName":"publish","argumentSchema":[{"tag":"FormSchemaInt"},{"tag":"FormSchemaValue"}]},{"functionName":"redeem","argumentSchema":[{"tag":"FormSchemaInt"}]},{"functionName":"start","argumentSchema":[]},{"functionName":"payToWallet_","argumentSchema":[{"tag":"FormSchemaValue"},{"contents":[["getWallet",{"tag":"FormSchemaInt"}]],"tag":"FormSchemaObject"}]}],"currencies":[{"knownTokens":[{"unTokenName":""}],"hash":"","friendlyName":"Ada"}],"actions":[]}]]