Merge pull request #923 from input-output-hk/j-mueller/fix-ada-token

playground: Delete TokenId type

plutus-playground-client/src/AjaxUtils.purs

@@ -23,7 +23,7 @@ import Halogen.HTML (ClassName(..), HTML, br_, div, div_, pre_, text)
 import Halogen.HTML.Properties (class_)
 import Language.Haskell.Interpreter (CompilationError(..))
 import Network.HTTP.StatusCode (StatusCode(..))
-import Playground.API (TokenId)
+import Ledger.Value.TH (TokenName)
 import Playground.Server (SPParams_(..))
 import Prelude (bind, pure, show, unit, ($), (<$>), (<>), (>>>))
 import Servant.PureScript.Affjax (AjaxError, ErrorDescription(ConnectionError, DecodingError, ParsingError, UnexpectedHTTPStatus), runAjaxError)
@@ -52,43 +52,43 @@ encodeJson =
 
 userDecoding :: Options -> GenericSignature -> Json -> Maybe (Either String GenericSpine)
 userDecoding opts sig json =
-  decodeTokenIdLists opts sig json
+  decodeTokenNameLists opts sig json
   <|>
   Aeson.userDecoding opts sig json
 
-decodeTokenIdLists :: Options -> GenericSignature -> Json -> Maybe (Either String GenericSpine)
-decodeTokenIdLists opts sig@(SigProd "Data.List.Types.List" [{sigValues: [a, _]}, _]) json =
+decodeTokenNameLists :: Options -> GenericSignature -> Json -> Maybe (Either String GenericSpine)
+decodeTokenNameLists opts sig@(SigProd "Data.List.Types.List" [{sigValues: [a, _]}, _]) json =
   runExceptT do
     case a unit of
-      (SigProd "Playground.API.TokenId" _) -> do
-        tokenIds :: Array TokenId <- ExceptT $ Just $ decodeJson json
-        pure $ toSpine $ List.fromFoldable tokenIds
+      (SigProd "Ledger.Value.TH.TokenName" _) -> do
+        tokenNames :: Array TokenName <- ExceptT $ Just $ decodeJson json
+        pure $ toSpine $ List.fromFoldable tokenNames
       _ -> empty
-decodeTokenIdLists opts (SigProd "Data.List.Types.NonEmptyList" [{sigValues: [l]}]) json =
+decodeTokenNameLists opts (SigProd "Data.List.Types.NonEmptyList" [{sigValues: [l]}]) json =
   runExceptT do
     case l unit of
       (SigProd "Data.List.Types.List" [{sigValues: [a, _]}, _])  -> do
         case a unit of
-          (SigProd "Playground.API.TokenId" _) -> do
-            tokenIds :: Array TokenId <- ExceptT $ Just $ decodeJson json
-            nonEmpty <- ExceptT $ Just $ note "List is empty, expecting non-empty" $ NonEmpty.fromFoldable tokenIds
+          (SigProd "Ledger.Value.TH.TokenName" _) -> do
+            tokenNames :: Array TokenName <- ExceptT $ Just $ decodeJson json
+            nonEmpty <- ExceptT $ Just $ note "List is empty, expecting non-empty" $ NonEmpty.fromFoldable tokenNames
             pure $ toSpine nonEmpty
           _ -> empty
       _ -> empty
-decodeTokenIdLists _ _ _ = Nothing
+decodeTokenNameLists _ _ _ = Nothing
 
 userEncoding :: Options -> GenericSignature -> GenericSpine -> Maybe Json
 userEncoding opts sig spine =
-  encodeTokenIdLists opts sig spine
+  encodeTokenNameLists opts sig spine
   <|>
   Aeson.userEncoding opts sig spine
 
-encodeTokenIdLists :: Options -> GenericSignature -> GenericSpine -> Maybe Json
-encodeTokenIdLists opts sig@(SigProd "Data.List.Types.NonEmptyList" [{sigValues: [l]}]) spine =
+encodeTokenNameLists :: Options -> GenericSignature -> GenericSpine -> Maybe Json
+encodeTokenNameLists opts sig@(SigProd "Data.List.Types.NonEmptyList" [{sigValues: [l]}]) spine =
   case fromSpine spine of
     Nothing -> Nothing
-    Just (xs :: NonEmptyList TokenId) -> Just $ encodeJson $ Array.fromFoldable xs
-encodeTokenIdLists _ _ _ = Nothing
+    Just (xs :: NonEmptyList TokenName) -> Just $ encodeJson $ Array.fromFoldable xs
+encodeTokenNameLists _ _ _ = Nothing
 
 -- | Generally we want the default parameter encoding behaviour. But
 -- sometimes we need to do something special.

plutus-playground-client/src/MainFrame.purs

@@ -66,7 +66,7 @@ import LocalStorage (LOCALSTORAGE)
 import MonadApp (class MonadApp, editorGetContents, editorGotoLine, editorSetAnnotations, editorSetContents, getGistByGistId, getOauthStatus, patchGistByGistId, postContract, postEvaluation, postGist, preventDefault, readFileFromDragEvent, runHalogenApp, saveBuffer, updateChartsIfPossible)
 import Network.HTTP.Affjax (AJAX)
 import Network.RemoteData (RemoteData(NotAsked, Loading, Failure, Success), _Success, isSuccess)
-import Playground.API (KnownCurrency(..), SimulatorWallet(SimulatorWallet), TokenId(..), _CompilationResult, _FunctionSchema)
+import Playground.API (KnownCurrency(..), SimulatorWallet(SimulatorWallet), _CompilationResult, _FunctionSchema)
 import Playground.Server (SPParams_)
 import Playground.Usecases (gitHead)
 import Prelude (type (~>), Unit, Void, bind, const, discard, flip, join, map, pure, show, unit, unless, when, ($), (&&), (+), (-), (<$>), (<*>), (<<<), (<>), (=<<), (==))
@@ -90,10 +90,10 @@ mkInitialValue currencies initialBalance = Value { getValue: value }
         (LedgerMap [])
       $ Array.concat
       $ map (\(KnownCurrency {hash, knownTokens}) ->
-                 map (\(TokenId tokenId) ->
+                 map (\(TokenName tokenId) ->
                          LedgerMap [ (CurrencySymbol { unCurrencySymbol: hash })
                                      /\
-                                     LedgerMap [ TokenName { unTokenName: tokenId } /\ initialBalance ]])
+                                     LedgerMap [ TokenName tokenId /\ initialBalance ]])
                  $ Array.fromFoldable knownTokens)
         currencies
 

plutus-playground-client/test/AjaxUtilsTests.purs

@@ -21,7 +21,7 @@ import Language.Haskell.Interpreter (CompilationError, InterpreterError, Interpr
 import Ledger.Extra (LedgerMap(..))
 import Ledger.Value.TH (CurrencySymbol(..), TokenName(..), Value(..))
 import Node.FS (FS)
-import Playground.API (CompilationResult, EvaluationResult, KnownCurrency(..), TokenId(..))
+import Playground.API (CompilationResult, EvaluationResult, KnownCurrency(..))
 import Test.QuickCheck (arbitrary, withHelp)
 import Test.QuickCheck.Gen (Gen, chooseInt, vectorOf)
 import Test.Unit (TestSuite, suite, test)
@@ -39,16 +39,16 @@ jsonHandlingTests = do
     suite "Json handling" do
       test "Decode a List." do
         assertDecodesTo
-          (Proxy :: Proxy (List TokenId))
-          "test/token_ids.json"
+          (Proxy :: Proxy (List TokenName))
+          "test/token_names.json"
       test ("Decode an empty NonEmptyList.") do
         equalGShow
           (Left "List is empty, expecting non-empty")
-          (decodeJson (Argonaut.fromArray []) :: Either String (NonEmptyList TokenId))
+          (decodeJson (Argonaut.fromArray []) :: Either String (NonEmptyList TokenName))
       test ("Decode a populated NonEmptyList.") do
         assertDecodesTo
-          (Proxy :: Proxy (NonEmptyList TokenId))
-          "test/token_ids.json"
+          (Proxy :: Proxy (NonEmptyList TokenName))
+          "test/token_names.json"
       test "Decode a KnownCurrency." do
         assertDecodesTo
           (Proxy :: Proxy KnownCurrency)
@@ -79,9 +79,13 @@ jsonHandlingTests = do
         assertEncodesTo
           aValue
           "test/value1.json"
+      test "Encode Ada." do
+        let aValue = Value { getValue: LedgerMap [ Tuple (CurrencySymbol { unCurrencySymbol: ""}) (LedgerMap [ Tuple (TokenName { unTokenName: "" }) 50 ])]}
+        assertEncodesTo
+          aValue
+          "test/value_ada.json"
       suite "Roundtrips" do
         testRoundTrip "CurrencySymbol" arbitraryCurrencySymbol
-        testRoundTrip "TokenId" arbitraryTokenId
         testRoundTrip "TokenName" arbitraryTokenName
         testRoundTrip "Value" arbitraryValue
         testRoundTrip "KnownCurrency" arbitraryKnownCurrency
@@ -106,9 +110,6 @@ arbitraryCurrencySymbol = do
   str <- arbitrary
   pure $ CurrencySymbol { unCurrencySymbol: str }
 
-arbitraryTokenId :: Gen TokenId
-arbitraryTokenId = TokenId <$> arbitrary
-
 arbitraryTokenName :: Gen TokenName
 arbitraryTokenName = do
   str <- arbitrary
@@ -129,7 +130,7 @@ arbitraryKnownCurrency :: Gen KnownCurrency
 arbitraryKnownCurrency = do
   hash <- arbitrary
   friendlyName <- arbitrary
-  knownTokens <- arbitraryNonEmptyList arbitraryTokenId
+  knownTokens <- arbitraryNonEmptyList arbitraryTokenName
   pure $ KnownCurrency { hash, friendlyName, knownTokens }
 
 arbitraryNonEmptyList :: forall a. Gen a -> Gen (NonEmptyList a)

plutus-playground-client/test/MainFrameTests.purs

@@ -46,7 +46,7 @@ import Node.Encoding (Encoding(..))
 import Node.FS (FS)
 import Node.FS.Sync as FS
 import Partial.Unsafe (unsafePartial)
-import Playground.API (CompilationResult, EvaluationResult, KnownCurrency(..), TokenId(..))
+import Playground.API (CompilationResult, EvaluationResult, KnownCurrency(..))
 import Playground.Server (SPParams_(..))
 import Servant.PureScript.Settings (SPSettings_, defaultSettings)
 import StaticData (bufferLocalStorageKey)
@@ -271,8 +271,8 @@ mkInitialValueTests =
                                                                 ]
                                       ] })
         (mkInitialValue
-           [ KnownCurrency { hash: "", friendlyName: "Ada", knownTokens: pure (TokenId "") }
-           , KnownCurrency { hash: "Currency", friendlyName: "Currencies", knownTokens: NonEmptyList (TokenId "USDToken" :| (Cons (TokenId "EURToken") Nil)) }
+           [ KnownCurrency { hash: "", friendlyName: "Ada", knownTokens: pure (TokenName { unTokenName : "" }) }
+           , KnownCurrency { hash: "Currency", friendlyName: "Currencies", knownTokens: NonEmptyList ((TokenName { unTokenName: "USDToken" }) :| (Cons (TokenName { unTokenName:  "EURToken" }) Nil)) }
            ]
            10)
 

plutus-playground-client/test/token_names.json

@@ -0,0 +1 @@
+[{ "unTokenName": "MyToken" }]

plutus-playground-client/test/value_ada.json

@@ -0,0 +1,17 @@
+{
+  "getValue": [
+    [
+      {
+        "unCurrencySymbol": ""
+      },
+      [
+        [
+          {
+            "unTokenName": ""
+          },
+          50
+        ]
+      ]
+    ]
+  ]
+}

plutus-playground-lib/src/Playground/API.hs

@@ -39,6 +39,7 @@ import           Ledger                       (Blockchain, PubKey, Tx, TxId)
 import qualified Ledger.Ada                   as Ada
 import qualified Ledger.Map.TH                as Map
 import           Ledger.Validation            (ValidatorHash, fromSymbol)
+import           Ledger.Value                 (TokenName)
 import qualified Ledger.Value                 as V
 import           Servant.API                  ((:<|>), (:>), Get, JSON, Post, ReqBody)
 import           Text.Read                    (readMaybe)
@@ -50,23 +51,18 @@ type API
      :<|> "evaluate" :> ReqBody '[ JSON] Evaluation :> Post '[ JSON] EvaluationResult
      :<|> "health" :> Get '[ JSON] ()
 
--- FIXME: These types will be defined elsewhere but I've added them here for now
-newtype TokenId = TokenId Text
-    deriving stock (Eq, Ord, Show, Generic)
-    deriving newtype (ToJSON, FromJSON)
-
 data KnownCurrency = KnownCurrency
     { hash         :: ValidatorHash
     , friendlyName :: String
-    , knownTokens  :: NonEmpty TokenId
+    , knownTokens  :: NonEmpty TokenName
     }
     deriving (Eq, Show, Generic, ToJSON, FromJSON)
 
 adaCurrency :: KnownCurrency
 adaCurrency = KnownCurrency
     { hash = fromSymbol Ada.adaSymbol
     , friendlyName = "Ada"
-    , knownTokens = TokenId "ada" :| []
+    , knownTokens = Ada.adaToken :| []
     }
 
 --------------------------------------------------------------------------------

plutus-playground-lib/src/Playground/Contract.hs

@@ -26,7 +26,7 @@ module Playground.Contract
     , module Playground.Interpreter.Util
     , KnownCurrency(KnownCurrency)
     , ValidatorHash(ValidatorHash)
-    , TokenId(TokenId)
+    , TokenName(TokenName)
     , NonEmpty((:|))
     , adaCurrency
     ) where
@@ -41,9 +41,8 @@ import           Data.List.NonEmpty          (NonEmpty ((:|)))
 import           Data.Swagger                (Schema, ToSchema)
 import           GHC.Generics                (Generic)
 import           Ledger.Validation           (ValidatorHash (ValidatorHash))
-import           Ledger.Value                (Value)
-import           Playground.API              (FunctionSchema, KnownCurrency (KnownCurrency), TokenId (TokenId),
-                                              adaCurrency)
+import           Ledger.Value                (TokenName (TokenName), Value)
+import           Playground.API              (FunctionSchema, KnownCurrency (KnownCurrency), adaCurrency)
 import           Playground.Interpreter.Util
 import           Playground.TH               (mkFunction, mkFunctions, mkKnownCurrencies, mkSingleFunction)
 import           Wallet.API                  (SlotRange, WalletAPI, payToPublicKey_)

plutus-playground-server/app/PSGenerator.hs

@@ -48,7 +48,7 @@ import           Ledger.Slot                               (Slot)
 import           Ledger.Value.TH                           (CurrencySymbol, TokenName, Value)
 import           Playground.API                            (CompilationResult, Evaluation, EvaluationResult, Expression,
                                                             Fn, FunctionSchema, KnownCurrency, SimpleArgumentSchema,
-                                                            SimulatorWallet, TokenId)
+                                                            SimulatorWallet)
 import qualified Playground.API                            as API
 import           Playground.Usecases                       (crowdfunding, game, messages, vesting)
 import           Servant                                   ((:<|>))
@@ -251,7 +251,6 @@ myTypes =
     , mkSumType (Proxy @NewGistFile)
     , mkSumType (Proxy @Owner)
     , (equal <*> mkSumType) (Proxy @Value)
-    , (equal <*> (order <*> mkSumType)) (Proxy @TokenId)
     , (equal <*> mkSumType) (Proxy @KnownCurrency)
     , mkSumType (Proxy @InterpreterError)
     , mkSumType (Proxy @(InterpreterResult A))

plutus-playground-server/test/Playground/UsecasesSpec.hs

@@ -20,13 +20,14 @@ import           Language.Haskell.Interpreter (InterpreterError, InterpreterResu
 import           Ledger                       (Blockchain)
 import qualified Ledger.Ada                   as Ada
 import           Ledger.Validation            (ValidatorHash (ValidatorHash))
+import           Ledger.Value                 (TokenName (TokenName))
 import           Playground.API               (CompilationResult (CompilationResult), Evaluation (Evaluation),
                                                Expression (Action, Wait), Fn (Fn), FunctionSchema (FunctionSchema),
                                                KnownCurrency (KnownCurrency), PlaygroundError,
                                                SimpleArgumentSchema (SimpleArraySchema, SimpleHexSchema, SimpleIntSchema, SimpleObjectSchema, SimpleStringSchema, SimpleTupleSchema, ValueSchema),
-                                               SimulatorWallet (SimulatorWallet), TokenId (TokenId), adaCurrency,
-                                               argumentSchema, functionName, isSupportedByFrontend,
-                                               simulatorWalletBalance, simulatorWalletWallet)
+                                               SimulatorWallet (SimulatorWallet), adaCurrency, argumentSchema,
+                                               functionName, isSupportedByFrontend, simulatorWalletBalance,
+                                               simulatorWalletWallet)
 import qualified Playground.Interpreter       as PI
 import           Playground.Usecases          (crowdfunding, game, messages, vesting)
 import           Test.Hspec                   (Spec, describe, it, shouldBe, shouldSatisfy)
@@ -444,14 +445,15 @@ knownCurrencySpec =
         Text.unlines
             [ "import Playground.Contract"
             , "import Data.List.NonEmpty (NonEmpty ((:|)))"
+            , "import Ledger.Value (TokenName(TokenName))"
             , "import Ledger.Validation (ValidatorHash (..))"
-            , "import Playground.API (KnownCurrency (..), TokenId (..))"
+            , "import Playground.API (KnownCurrency (..))"
             , "myCurrency :: KnownCurrency"
-            , "myCurrency = KnownCurrency (ValidatorHash \"\") \"MyCurrency\" (TokenId \"MyToken\" :| [])"
+            , "myCurrency = KnownCurrency (ValidatorHash \"\") \"MyCurrency\" (TokenName \"MyToken\" :| [])"
             , "$(mkKnownCurrencies ['myCurrency])"
             ]
     hasKnownCurrency (Right (InterpreterResult _ (CompilationResult _ [cur1, cur2]))) =
-        cur1 == adaCurrency && cur2 == KnownCurrency (ValidatorHash "") "MyCurrency" (TokenId "MyToken" :| [])
+        cur1 == adaCurrency && cur2 == KnownCurrency (ValidatorHash "") "MyCurrency" (TokenName "MyToken" :| [])
     hasKnownCurrency _ = False
 
 sourceCode :: BSC.ByteString -> SourceCode

plutus-tutorial/markdown/Multi-currency_ledger.md

@@ -10,7 +10,7 @@ Each currency on the ledger is identified by two 32-byte bytestrings. To make it
 data KnownCurrency = KnownCurrency
     { hash         :: ValidatorHash
     , friendlyName :: String
-    , knownTokens  :: NonEmpty TokenId
+    , knownTokens  :: NonEmpty TokenName
     }
 ```
 

wallet-api/src/Ledger/Value.hs

@@ -7,7 +7,7 @@ module Ledger.Value(
       Value(..)
     , CurrencySymbol(..)
     , currencySymbol
-    , TokenName
+    , TokenName(..)
     , tokenName
     , singleton
     , valueOf

wallet-api/test/Spec.hs

@@ -100,6 +100,10 @@ tests = testGroup "all tests" [
         ] ++ (let   vlJson :: BSL.ByteString
                     vlJson = "{\"getValue\":[[{\"unCurrencySymbol\":\"ab01ff\"},[[{\"unTokenName\":\"myToken\"},50]]]]}"
                     vlValue = Value.singleton "ab01ff" "myToken" 50
+                in byteStringJson vlJson vlValue)
+          ++ (let   vlJson :: BSL.ByteString
+                    vlJson = "{\"getValue\":[[{\"unCurrencySymbol\":\"\"},[[{\"unTokenName\":\"\"},50]]]]}"
+                    vlValue = Ada.adaValueOf 50
                 in byteStringJson vlJson vlValue))
     ]