Merge pull request #50 from mlabs-haskell/gergely/raw-bytestring-tokennames

Decoding raw ByteString TokenNames

Author: szg251

src/BotPlutusInterface/UtxoParser.hs

@@ -3,11 +3,13 @@ module BotPlutusInterface.UtxoParser (
   feeParser,
   utxoParser,
   utxoMapParser,
+  tokenNameParser,
 ) where
 
-import Control.Applicative (many)
+import Control.Applicative (many, optional)
 import Control.Monad (mzero, void)
 import Data.Aeson.Extras (tryDecode)
+import Data.Attoparsec.ByteString.Char8 (isSpace)
 import Data.Attoparsec.Text (
   Parser,
   char,
@@ -21,12 +23,11 @@ import Data.Attoparsec.Text (
   signed,
   skipSpace,
   skipWhile,
+  string,
   takeWhile,
   (<?>),
  )
-import Data.Hex (unhex)
 import Data.Text (Text)
-import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Ledger (Address (addressCredential))
 import Ledger.Ada qualified as Ada
 import Ledger.Scripts (DatumHash (..))
@@ -35,12 +36,13 @@ import Ledger.Tx (
   TxOutRef (..),
  )
 import Ledger.TxId (TxId (..))
-import Ledger.Value (AssetClass, TokenName, Value)
+import Ledger.Value (AssetClass, Value)
 import Ledger.Value qualified as Value
 import Plutus.V1.Ledger.Api (
   BuiltinByteString,
   Credential (PubKeyCredential, ScriptCredential),
   CurrencySymbol (..),
+  TokenName (..),
  )
 import PlutusTx.Builtins (toBuiltin)
 import Prelude hiding (takeWhile)
@@ -106,7 +108,8 @@ tokenNameParser = do
   where
     tokenName = do
       void $ char '.'
-      Value.tokenName . encodeUtf8 <$> decodeHex (takeWhile (/= ' '))
+      void $ optional $ string "0x"
+      TokenName <$> decodeHash (takeWhile (not . isSpace))
 
 datumHashNoneParser :: Parser ()
 datumHashNoneParser = "TxOutDatumNone" >> pure ()
@@ -123,10 +126,6 @@ decodeHash :: Parser Text -> Parser BuiltinByteString
 decodeHash rawParser =
   rawParser >>= \parsed -> either (const mzero) (pure . toBuiltin) (tryDecode parsed)
 
-decodeHex :: Parser Text -> Parser Text
-decodeHex rawParser =
-  rawParser >>= \parsed -> either (const mzero) (pure . decodeUtf8) ((unhex . encodeUtf8) parsed)
-
 feeParser :: Parser Integer
 feeParser =
   choice [prefixed, suffixed]

test/Spec/BotPlutusInterface/UtxoParser.hs

@@ -6,6 +6,7 @@ module Spec.BotPlutusInterface.UtxoParser (tests) where
 
 import BotPlutusInterface.UtxoParser qualified as UtxoParser
 import Data.Attoparsec.Text (parseOnly)
+import Data.ByteString qualified as ByteString
 import Data.Text (Text)
 import Ledger qualified
 import Ledger.Ada qualified as Ada
@@ -14,8 +15,10 @@ import Ledger.Tx (
   ChainIndexTxOut (PublicKeyChainIndexTxOut, ScriptChainIndexTxOut),
   TxOutRef (TxOutRef),
  )
+import Ledger.Value (TokenName (TokenName))
 import Ledger.Value qualified as Value
 import NeatInterpolation (text)
+import PlutusTx.Builtins (toBuiltin)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (Assertion, testCase, (@?=))
 import Prelude
@@ -91,20 +94,28 @@ multiAdaOnly = do
 singleWithNativeTokens :: Assertion
 singleWithNativeTokens = do
   let addr = pubKeyHashAddress "0000"
+      token =
+        Value.assetClass "057910a2c93551443cb2c0544d1d65da3fb033deaa79452bd431ee08" "testToken"
+      tokenWithRawByteString =
+        Value.assetClass
+          "7c6de14062b27c3dc3ba9f232ade32efe22fb8e2ae76b24f33212fdb"
+          (TokenName (toBuiltin (ByteString.pack [1, 35, 69, 103, 137, 171, 205, 239])))
+      tokenWithEmptyName =
+        Value.assetClass "98a759ed2e20f6d83aa4d37d028d4bbb547a696fc345d54126188614" ""
   testUtxoParser
     addr
     [text|                           TxHash                                 TxIx        Amount
           --------------------------------------------------------------------------------------
-          384de3f29396fdf687551e3f9e05bd400adcd277720c71f1d2b61f17f5183e51     0        1234 lovelace + 2345 057910a2c93551443cb2c0544d1d65da3fb033deaa79452bd431ee08.74657374546f6b656e + 3456 7c6de14062b27c3dc3ba9f232ade32efe22fb8e2ae76b24f33212fdb.74657374546f6b656e32 + 4567 98a759ed2e20f6d83aa4d37d028d4bbb547a696fc345d54126188614 + TxOutDatumNone
+          384de3f29396fdf687551e3f9e05bd400adcd277720c71f1d2b61f17f5183e51     0        1234 lovelace + 2345 057910a2c93551443cb2c0544d1d65da3fb033deaa79452bd431ee08.74657374546f6b656e + 3456 7c6de14062b27c3dc3ba9f232ade32efe22fb8e2ae76b24f33212fdb.0x0123456789abcdef + 4567 98a759ed2e20f6d83aa4d37d028d4bbb547a696fc345d54126188614 + TxOutDatumNone
     |]
     [
       ( TxOutRef "384de3f29396fdf687551e3f9e05bd400adcd277720c71f1d2b61f17f5183e51" 0
       , PublicKeyChainIndexTxOut
           addr
           ( Ada.lovelaceValueOf 1234
-              <> Value.singleton "057910a2c93551443cb2c0544d1d65da3fb033deaa79452bd431ee08" "testToken" 2345
-              <> Value.singleton "7c6de14062b27c3dc3ba9f232ade32efe22fb8e2ae76b24f33212fdb" "testToken2" 3456
-              <> Value.singleton "98a759ed2e20f6d83aa4d37d028d4bbb547a696fc345d54126188614" "" 4567
+              <> Value.assetClassValue token 2345
+              <> Value.assetClassValue tokenWithRawByteString 3456
+              <> Value.assetClassValue tokenWithEmptyName 4567
           )
       )
     ]