Plutus Playground Smart Contract

Playground.hs

import qualified Data.Text                 as T
import           Language.Plutus.Contract  hiding (when)
import           Language.PlutusTx.Prelude
import           Playground.Contract


-- 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 (Generic, ToJSON, FromJSON, ToSchema)

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

-- 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 Name Ada
    deriving stock (Prelude.Eq, Prelude.Show, Generic)
    deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument
    
data HideParams = HideParams Name 
    deriving stock (Prelude.Eq, Prelude.Show, Generic)
    deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument
    
newtype GrabParams = GrabParams ()
    deriving stock (Prelude.Eq, Prelude.Show, Generic)
    deriving anyclass (FromJSON, ToJSON, ToSchema, ToArgument

data TaxableRedeemer = Hide | Grab

data TaxableDatum = TaxableDatum { warned :: Bool, ranto :: ValidatorHash }

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

scriptInstance :: TaxableParams -> Scripts.ScriptInstance Taxable
scriptInstance 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 (valCtxTxInfo ctx)
    
validMint :: TaxableParams -> TaxableDatum -> TxInfo -> Bool

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

-- validGrab :: TaxableParams -> TaxableDatum -> TxInfo -> Bool

taxableScript :: Campaign -> Validator
taxableScript = Scripts.validatorScript . scriptInstance

-- | The address of a [[Campaign]]
taxableAddress :: Campaign -> Ledger.ValidatorHash
taxableAddress = Scripts.validatorHash . taxableScript

-- | The crowdfunding contract for the 'Campaign'.
taxable :: AsContractError e => TaxableParams -> Contract () TaxableSchema e ()
taxable par = mint par -- `select` hide par `select` grab par

mint :: AsContractError e => TaxableParams -> Contract () TaxableSchema e ()
mint = do
  MintParams name amt <- endpoint @"mint" @MintParams
  let tx = Constraints.mustPayToTheScript name amt
  void (submitTxConstraints taxableInstance tx)
  
-- hide :: AsContractError e => TaxableParams -> Contract () TaxableSchema e ()
-- hide = do
--   HideParams name <- endpoint @"mint" @HideParams
--   
-- grab :: AsContractError e => TaxableParams -> Contract () TaxableSchema e ()
-- grab = do
--   GrabParams () <- endpoint @"mint" @GrabParams

endpoints :: AsContractError e => Contract () GameSchema e ()
endpoints = taxable

mkSchemaDefinitions ''TaxableSchema

$(mkKnownCurrencies [])

Simulation.json

[0,[]]