Plutus Playground Smart Contract

Playground.hs

import           Control.Monad             (void)
import qualified Ledger.Contexts                   as Validation
import qualified Data.ByteString.Char8     as C
import qualified Language.Plutus.Contract.Typed.Tx as Typed
import           Language.Plutus.Contract
import           Language.PlutusTx.Prelude
import           Language.PlutusTx.Prelude hiding (pure, (<$>))
import           Ledger                    (PubKeyHash, Ada, Address, Validator, ValidatorCtx, Value, scriptAddress)
import           Playground.Contract
import           Playground.Contract
import           Wallet.Emulator.Types             (walletPubKey)               
import qualified Data.ByteString.Char8     as C
import qualified Data.Text                 as T
import qualified Language.PlutusTx         as PlutusTx
import qualified Ledger                               as Ledger   
import qualified Ledger.Constraints        as Constraints
import qualified Ledger.Scripts                       as Scripts
import qualified Ledger.Typed.Scripts      as Scripts
import qualified Prelude

-- Taxman
-- ======

-- You live in a jurisdiction where you must keep your money in taxable scripts
-- The taxman must give you a warning by taking 1 ADA, then 2 slots later he can take the lot
-- You must notice the warning and get your money into another script. 
-- He'll then find out where you put it and issue the warning 2 slots later.
-- Can you move the money about fast enough?

-- newtype Name = Name ByteString -- deriving (Prelude.Eq, Prelude.Show, Generic, ToJSON, FromJSON, ToSchema, PlutusTx.IsData)
--     deriving stock (Prelude.Eq, Prelude.Show, Generic)
--     deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument, PlutusTx.IsData)
-- PlutusTx.makeLift ''Name

data TaxableParams = TaxableParams
  { taxman      :: PubKeyHash -- could be global
  , name        :: ByteString -- so you can have different ones
--  , owner       :: PubKeyHash -- you
  } deriving (Generic, ToJSON, FromJSON, ToSchema)

PlutusTx.makeLift ''TaxableParams

-- The script always allows the taxman to take exactly 1 ADA, but interprets that as a warning if it's the first time
-- The datum will remember whether we've been warned or not
-- I suppose we need a button to forge a new script full of money
-- You need a button to move the money to a script with another name
-- The taxman needs a button to warn a script, wait, either take the lot or find a script it paid, and repeat
-- I'm not sure if it's possible to "find a script it paid" so maybe I bung that in the datum for now
-- Nor am I sure if scripts with no money can hang about. If not I'll forbid taking the last ADA

type TaxableSchema =
  BlockchainActions
    .\/ Endpoint "mint" MintParams
    -- .\/ Endpoint "hide" HideParams -- run to new script called the Name
    .\/ Endpoint "grab" GrabParams
            
data MintParams = MintParams 
    { mintName :: String,
      mintValue ::  Value
    } deriving stock (Prelude.Eq, Prelude.Show, Generic)
      deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument)
        
data GrabParams = GrabParams 
    { grabName :: String
    } deriving stock (Prelude.Eq, Prelude.Show, Generic)
      deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument)
        
data HideParams = HideParams String 
    deriving stock (Prelude.Eq, Prelude.Show, Generic)
    deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument)
    
data TaxableDatum = TaxableDatum { warned :: Bool , ranto :: Maybe ValidatorHash } -- deriving newtype PlutusTx.IsData 
PlutusTx.unstableMakeIsData ''TaxableDatum
PlutusTx.makeLift ''TaxableDatum

data TaxableRedeemer = Hide | Grab
PlutusTx.unstableMakeIsData ''TaxableRedeemer
PlutusTx.makeLift ''TaxableRedeemer

data Taxable
instance Scripts.ScriptType Taxable where
    type instance RedeemerType Taxable = TaxableRedeemer
    type instance DatumType Taxable = TaxableDatum
        

taxableInstance :: TaxableParams -> Scripts.ScriptInstance Taxable
taxableInstance params = Scripts.validator @Taxable
    ($$(PlutusTx.compile [|| mkValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode params)
    $$(PlutusTx.compile [|| wrap ||])
    where
        wrap = Scripts.wrapValidator @TaxableDatum @TaxableRedeemer

mkValidator :: TaxableParams -> TaxableDatum -> TaxableRedeemer -> ValidatorCtx -> Bool
mkValidator par dat red ctx = case red of
--    Mint -> validMint par dat (valCtxTxInfo ctx)
--     Hide -> validHide par dat (valCtxTxInfo ctx)
  Grab -> validGrab par dat (Ledger.valCtxTxInfo ctx)
  _ -> True
    
-- validMint :: TaxableParams -> TaxableDatum -> TxInfo -> Bool

-- validHide :: TaxableParams -> TaxableDatum -> TxInfo -> Bool

validGrab :: TaxableParams -> TaxableDatum -> Ledger.TxInfo -> Bool
validGrab par dat tx = Validation.txSignedBy tx (Ledger.pubKeyHash $ walletPubKey $ Wallet 1)

taxableScript :: TaxableParams -> Validator
taxableScript = Scripts.validatorScript . taxableInstance

taxableAddress :: TaxableParams -> Ledger.ValidatorHash
taxableAddress = Scripts.validatorHash . taxableScript

taxable :: AsContractError e => PubKeyHash -> Contract () TaxableSchema e ()
taxable h = mint h `select` grab h -- `select` hide h

mint :: AsContractError e => PubKeyHash -> Contract () TaxableSchema e ()
mint h = do
  MintParams name amt <- endpoint @"mint" @MintParams
  logInfo ( "Trying to mint" :: String)
  let par = TaxableParams h $ C.pack name
  let tx = Constraints.mustPayToTheScript (TaxableDatum False Nothing) amt
  void (submitTxConstraints (taxableInstance par) tx)

grab :: AsContractError e => PubKeyHash -> Contract () TaxableSchema e ()
grab h = do
  GrabParams name <- endpoint @"grab" @GrabParams
  logInfo ( "Trying to grab" :: String)
  let par = TaxableParams h $ C.pack name
  let inst = taxableInstance par
  unspent <- utxoAt (Scripts.scriptAddress inst)
  let tx = Typed.collectFromScript unspent Grab
        <> Constraints.mustBeSignedBy (taxman par)
  void $ submitTxConstraintsSpending inst unspent tx


-- hide :: AsContractError e => TaxableParams -> Contract () TaxableSchema e ()
-- hide = do
--   HideParams name <- endpoint @"mint" @HideParams
--   

endpoints :: AsContractError e => Contract () TaxableSchema e ()
endpoints = do
   me <- Ledger.pubKeyHash <$> ownPubKey 
   logInfo ( "endoints: me=" ++ show me )
   taxable (Ledger.pubKeyHash $ walletPubKey $ Wallet 1)

mkSchemaDefinitions ''TaxableSchema

$(mkKnownCurrencies [])
-- $(mkFunctions ['mint])

Simulation.json

[0,[{"simulationWallets":[{"simulatorWalletWallet":{"getWallet":1},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}},{"simulatorWalletWallet":{"getWallet":2},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}}],"simulationName":"Simulation 1","simulationId":1,"simulationActions":[]}]]