Skip to content
Permalink
Browse files

TokenName ToJSON/FromJSON ASCII

* Change the ToJSON/FromJSON/Show/IsString instances
  of `TokenName` to use the Char8 (ascii+latin1) character set.
  • Loading branch information...
j-mueller committed Apr 13, 2019
1 parent 555d84f commit 047499bdc01f4d2f722728bff244879f33d9c18b
@@ -93,7 +93,7 @@ toSimpleArgumentSchemaSpec =
[ ( "unMap"
, SimpleArraySchema
(SimpleTupleSchema
( SimpleHexSchema
( SimpleStringSchema
, SimpleIntSchema)))
])))
])
@@ -169,7 +169,7 @@ vestingSpec =
[ ( "unMap"
, SimpleArraySchema
(SimpleTupleSchema
( SimpleHexSchema
( SimpleStringSchema
, SimpleIntSchema)))
])))
])
@@ -253,7 +253,7 @@ simpleTraceDist = EM.fundsDistribution $ snd $ runTrace simpleTrace
{- |
>>> simpleTraceDist
fromList [(Wallet {getWallet = 1},Value {getValue = Map {unMap = [(,Map {unMap = [(SizedByteString {unSizedByteString = ""},900)]})]}}),(Wallet {getWallet = 2},Value {getValue = Map {unMap = [(,Map {unMap = [(SizedByteString {unSizedByteString = ""},1100)]})]}})]
fromList [(Wallet {getWallet = 1},Value {getValue = Map {unMap = [(,Map {unMap = [(,900)]})]}}),(Wallet {getWallet = 2},Value {getValue = Map {unMap = [(,Map {unMap = [(,1100)]})]}})]
'simpleTraceDist' shows that our transaction was successful: Wallet 1 now
owns 900 Ada (the currency identified by )
@@ -292,7 +292,7 @@ gameSuccess = do
The final distribution after 'gameSuccess' looks as we would expect:
>>> EM.fundsDistribution $ snd $ runTrace simpleTrace
fromList [(Wallet {getWallet = 1},Value {getValue = Map {unMap = [(,Map {unMap = [(SizedByteString {unSizedByteString = ""},900)]})]}}),(Wallet {getWallet = 2},Value {getValue = Map {unMap = [(,Map {unMap = [(SizedByteString {unSizedByteString = ""},1100)]})]}})]
fromList [(Wallet {getWallet = 1},Value {getValue = Map {unMap = [(,Map {unMap = [(,900)]})]}}),(Wallet {getWallet = 2},Value {getValue = Map {unMap = [(,Map {unMap = [(,1100)]})]}})]
-}

@@ -337,7 +337,7 @@ vestingSuccess = do
functions `runTraceDist` and `runTraceLog` from `Ledger.ExUtil`
>>> import Tutorial.ExUtil
>>> runTraceDist vestingSuccess
fromList [(Wallet {getWallet = 1},Value {getValue = Map {unMap = [(,Map {unMap = [(SizedByteString {unSizedByteString = ""},1010)]})]}}),(Wallet {getWallet = 2},Value {getValue = Map {unMap = [(,Map {unMap = [(SizedByteString {unSizedByteString = ""},940)]})]}}),(Wallet {getWallet = 3},Value {getValue = Map {unMap = [(,Map {unMap = [(SizedByteString {unSizedByteString = ""},1000)]})]}})]
fromList [(Wallet {getWallet = 1},Value {getValue = Map {unMap = [(,Map {unMap = [(,1010)]})]}}),(Wallet {getWallet = 2},Value {getValue = Map {unMap = [(,Map {unMap = [(,940)]})]}}),(Wallet {getWallet = 3},Value {getValue = Map {unMap = [(,Map {unMap = [(,1000)]})]}})]
E9. Write traces similar to `vestingSuccess` that
@@ -19,6 +19,7 @@ import Control.Lens ((^.), at, to)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.String (IsString(fromString))
import qualified Data.Text as Text

import qualified Language.PlutusTx as P
@@ -29,7 +30,7 @@ import Ledger.Validation (TxHash)
import qualified Ledger.Validation as V
import qualified Ledger.Value.TH as Value
import Ledger as Ledger hiding (to)
import Ledger.Value (TokenName, Value, mkTokenName)
import Ledger.Value (TokenName, Value)
import Wallet.API as WAPI

import qualified Language.PlutusTx.Coordination.Contracts.PubKey as PK
@@ -51,7 +52,7 @@ mkCurrency (TxOutRefOf h i) amt n =
Currency
{ curRefTransactionOutput = (V.plcTxHash h, i)
, curRefAmount = amt
, curRefTokenName = mkTokenName n
, curRefTokenName = fromString n
}

curValidator :: Currency -> ValidatorScript
@@ -9,7 +9,6 @@ module Ledger.Value(
, currencySymbol
, TokenName
, tokenName
, mkTokenName
, singleton
, valueOf
, scale
@@ -30,7 +29,6 @@ module Ledger.Value(
, isZero
) where

import qualified Data.ByteString.Lazy.Char8 as C8
import qualified Ledger.Value.TH as TH
import Ledger.Value.TH (CurrencySymbol, TokenName, Value)
import Prelude hiding (negate)
@@ -54,11 +52,6 @@ currencySymbol = $$(TH.currencySymbol)
tokenName :: P.ByteString -> TokenName
tokenName = $$(TH.tokenName)

-- | Convert a Haskell 'String' to a PLC 'TokenName' using
-- the Char8 encoding (see 'Data.ByteString.Char8').
mkTokenName :: String -> TokenName
mkTokenName = tokenName . P.SizedByteString . C8.pack

-- | See 'TH.singleton'.
singleton :: CurrencySymbol -> TokenName -> Int -> Value
singleton = $$(TH.singleton)
@@ -19,6 +19,7 @@ module Ledger.Value.TH(
, TokenName(..)
, tokenName
, eqTokenName
, toString
-- ** Value
, Value(..)
, singleton
@@ -53,7 +54,7 @@ import Data.Swagger.Schema (ToSchema(declareNamedSchema))
import qualified Data.Swagger.Lens as S
import Data.Swagger (SwaggerType(SwaggerObject), NamedSchema(NamedSchema), declareSchemaRef)
import Data.Proxy (Proxy(Proxy))
import Data.String (IsString)
import Data.String (IsString(fromString))
import qualified Data.Text as Text
import GHC.Generics (Generic)
import qualified Language.PlutusTx.Builtins as Builtins
@@ -68,6 +69,9 @@ import Data.Function ((&))
hexSchema :: S.Schema
hexSchema = mempty & set S.type_ S.SwaggerString & set S.format (Just "hex")

stringSchema :: S.Schema
stringSchema = mempty & set S.type_ S.SwaggerString

newtype CurrencySymbol = CurrencySymbol { unCurrencySymbol :: Builtins.SizedByteString 32 }
deriving (IsString, Show, ToJSONKey, FromJSONKey, Serialise) via LedgerBytes
deriving stock (Eq, Ord, Generic)
@@ -101,29 +105,31 @@ currencySymbol :: Q (TExp (P.ByteString -> CurrencySymbol))
currencySymbol = [|| CurrencySymbol ||]

newtype TokenName = TokenName { unTokenName :: Builtins.SizedByteString 32 }
deriving (ToJSONKey, FromJSONKey, Serialise) via LedgerBytes
deriving (Show, IsString) via (Builtins.SizedByteString 32)
deriving (Serialise) via LedgerBytes
deriving stock (Eq, Ord, Generic)

instance IsString TokenName where
fromString = TokenName . P.SizedByteString . C8.pack

toString :: TokenName -> String
toString = C8.unpack . Builtins.unSizedByteString . unTokenName

instance Show TokenName where
show = toString

instance ToSchema TokenName where
declareNamedSchema _ = pure $ S.NamedSchema (Just "TokenName") hexSchema
declareNamedSchema _ = pure $ S.NamedSchema (Just "TokenName") stringSchema

instance ToJSON TokenName where
toJSON tokenName =
JSON.object
[ ( "unTokenName"
, JSON.String .
Text.pack .
C8.unpack . Builtins.unSizedByteString . unTokenName $
tokenName)
]
[ ( "unTokenName", JSON.toJSON $ toString tokenName)]

instance FromJSON TokenName where
parseJSON =
JSON.withObject "TokenName" $ \object -> do
raw <- object .: "unTokenName"
let bytes = Text.unpack raw
pure . TokenName . Builtins.SizedByteString . C8.pack $ bytes
pure . fromString . Text.unpack $ raw

makeLift ''TokenName

@@ -95,6 +95,7 @@ tests = testGroup "all tests" [
testGroup "Value" ([
testProperty "Value ToJSON/FromJSON" (jsonRoundTrip Gen.genValue),
testProperty "CurrencySymbol ToJSON/FromJSON" (jsonRoundTrip $ Value.currencySymbol <$> Gen.genSizedByteStringExact),
testProperty "TokenName ToJSON/FromJSON" (jsonRoundTrip $ fromString @Value.TokenName <$> Gen.string (Range.linear 0 32) Gen.latin1),
testProperty "CurrencySymbol IsString/Show" currencySymbolIsStringShow
] ++ (let vlJson :: BSL.ByteString
vlJson = "{\"getValue\":[[{\"unCurrencySymbol\":\"ab01ff\"},[[{\"unTokenName\":\"myToken\"},50]]]]}"

0 comments on commit 047499b

Please sign in to comment.
You can’t perform that action at this time.