Plutus Playground Smart Contract

Playground.hs

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module Plutus.Token where

import qualified Data.Text                  as Text
import qualified Language.PlutusTx          as PlutusTx
import           Language.PlutusTx.Prelude  as P
import qualified Ledger
import           Ledger                     (Address, DataScript (..), PendingTx, RedeemerScript (..), Script, ValidatorScript (..))
import           Playground.Contract
import           Wallet

newtype TokenSymbol = TokenSymbol (P.SizedByteString 8) deriving Eq

PlutusTx.makeLift ''TokenSymbol

newtype TokenMap = TokenMap [(TokenSymbol, PubKey)]

PlutusTx.makeLift ''TokenMap

data TokenAction = CreateToken TokenSymbol

PlutusTx.makeLift ''TokenAction

createToken' :: PubKey -> TokenSymbol -> TokenMap -> Maybe TokenMap
createToken' owner symbol (TokenMap xs) = TokenMap <$> f xs
  where
    f :: [(TokenSymbol, PubKey)] -> Maybe [(TokenSymbol, PubKey)]
    f []               = Just [(symbol, owner)]
    f (so@(s, _) : ys)
        | s == symbol  = Nothing
        | otherwise    = (so :) <$> f ys

validateToken :: PubKey -> TokenMap -> TokenAction -> PendingTx -> Bool
validateToken owner m (CreateToken symbol) tx = $$(Ledger.txSignedBy) tx owner

mkTokenValidator :: PubKey -> ValidatorScript
mkTokenValidator owner = ValidatorScript $ Ledger.applyScript script $ Ledger.lifted owner
  where
    script :: Script
    script = Ledger.fromCompiledCode $$(PlutusTx.compile 
        [|| 
            \(o :: PubKey) (m :: TokenMap) (a :: TokenAction) (tx :: PendingTx) ->
                case a of
                    CreateToken symbol -> $$(Ledger.txSignedBy) tx o
        ||])
        
tokenAddress :: PubKey -> Address
tokenAddress = Ledger.scriptAddress . mkTokenValidator

startToken :: MonadWallet m => m ()
startToken = do
    owner <- Wallet.ownPubKey
    let address = tokenAddress owner
    Wallet.logMsg $ Text.pack $ "owner: " ++ show owner
    Wallet.logMsg $ Text.pack $ "address: " ++ show address
    payToScript_ defaultSlotRange address mempty $ DataScript $ Ledger.lifted $ TokenMap []

createToken :: MonadWallet m => m ()
createToken = do
    undefined

$(mkFunctions ['startToken])

Simulation.json

[0,[{"wallets":[{"simulatorWalletWallet":{"getWallet":1},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":"5fff"},[[{"unTokenName":""},10]]]]}},{"simulatorWalletWallet":{"getWallet":2},"simulatorWalletBalance":{"getValue":[[{"unCurrencySymbol":"5fff"},[[{"unTokenName":""},10]]]]}}],"signatures":[{"functionName":"startToken","argumentSchema":[]},{"functionName":"payToWallet_","argumentSchema":[{"contents":[["ivTo",{"contents":[["getSlot",{"tag":"SimpleIntSchema"}]],"tag":"SimpleObjectSchema"}],["ivFrom",{"contents":[["getSlot",{"tag":"SimpleIntSchema"}]],"tag":"SimpleObjectSchema"}]],"tag":"SimpleObjectSchema"},{"contents":[["getValue",{"contents":[["unMap",{"contents":{"contents":[{"tag":"SimpleHexSchema"},{"contents":[["unMap",{"contents":{"contents":[{"tag":"SimpleStringSchema"},{"tag":"SimpleIntSchema"}],"tag":"SimpleTupleSchema"},"tag":"SimpleArraySchema"}]],"tag":"SimpleObjectSchema"}],"tag":"SimpleTupleSchema"},"tag":"SimpleArraySchema"}]],"tag":"SimpleObjectSchema"}]],"tag":"ValueSchema"},{"contents":[["getWallet",{"tag":"SimpleIntSchema"}]],"tag":"SimpleObjectSchema"}]}],"currencies":[{"knownTokens":[{"unTokenName":""}],"hash":"5fff","friendlyName":"Ada"}],"actions":[]}]]