Plutus Playground Smart Contract

Playground.hs

import           Control.Monad             (void)
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 HideParams = HideParams String 
    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 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 = True -- 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 :: TaxableParams -> Validator
taxableScript = Scripts.validatorScript . taxableInstance

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

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 par = do
  logInfo ( "Trying to mint" :: String)
  MintParams name amt <- endpoint @"mint" @MintParams
  let tx = Constraints.mustPayToTheScript (TaxableDatum False Nothing) amt
  void (submitTxConstraints (taxableInstance par) 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 () TaxableSchema e ()
endpoints = Ledger.pubKeyHash <$> ownPubKey >>= \me -> taxable $ TaxableParams 
  (Ledger.pubKeyHash $ walletPubKey $ Wallet 1)
  "hideyhole"
  me

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":[{"caller":{"getWallet":1},"argumentValues":{"endpointDescription":{"getEndpointDescription":"mint"},"argument":{"contents":[["mintName",{"contents":"foo","tag":"FormStringF"}],["mintValue",{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},7]]]],"tag":"FormValueF"}]],"tag":"FormObjectF"}},"tag":"CallEndpoint"},{"blocks":1,"tag":"AddBlocks"}]}]]