Skip to content

Instantly share code, notes, and snippets.

@adrianmay
Created March 17, 2021 09:05
Show Gist options
  • Save adrianmay/a3692ef09e19f5d745ddca8633e19b9b to your computer and use it in GitHub Desktop.
Save adrianmay/a3692ef09e19f5d745ddca8633e19b9b to your computer and use it in GitHub Desktop.
Plutus Playground Smart Contract
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])
[0,[{"simulationWallets":[{"simulatorWalletWallet":{"getWallet":1},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}},{"simulatorWalletWallet":{"getWallet":2},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":""},[[{"unTokenName":""},10]]]]}}],"simulationName":"Simulation 1","simulationId":1,"simulationActions":[]}]]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment