Add opaque ByteString type to support literal ByteStrings.

plutus-ledger-api/src/Plutus/V1/Ledger/Ada.hs

@@ -32,6 +32,7 @@ import           Data.Fixed
 
 import           Codec.Serialise.Class            (Serialise)
 import           Data.Aeson                       (FromJSON, ToJSON)
+import qualified Data.ByteString                  as BS
 import           Data.Tagged
 import           Data.Text.Prettyprint.Doc.Extras
 import           GHC.Generics                     (Generic)
@@ -45,12 +46,12 @@ import qualified PlutusTx.Prelude                 as P
 {-# INLINABLE adaSymbol #-}
 -- | The 'CurrencySymbol' of the 'Ada' currency.
 adaSymbol :: CurrencySymbol
-adaSymbol = TH.currencySymbol emptyByteString
+adaSymbol = TH.currencySymbol BS.empty
 
 {-# INLINABLE adaToken #-}
 -- | The 'TokenName' of the 'Ada' currency.
 adaToken :: TokenName
-adaToken = TH.tokenName emptyByteString
+adaToken = TH.tokenName BS.empty
 
 -- | ADA, the special currency on the Cardano blockchain. The unit of Ada is Lovelace, and
 --   1M Lovelace is one Ada.

plutus-ledger-api/src/Plutus/V1/Ledger/Bytes.hs

@@ -31,7 +31,6 @@ import           Data.Text.Prettyprint.Doc.Extras (Pretty, PrettyShow (..))
 import           Data.Word                        (Word8)
 import           GHC.Generics                     (Generic)
 import qualified PlutusTx                         as PlutusTx
-import qualified PlutusTx.Builtins                as Builtins
 import           PlutusTx.Lift
 import qualified PlutusTx.Prelude                 as P
 
@@ -62,13 +61,13 @@ fromHex = fmap LedgerBytes . asBSLiteral
     asBSLiteral :: BS.ByteString -> Either String BS.ByteString
     asBSLiteral = withBytes asBytes
         where
-          withBytes :: ([Word8] -> Either String [Word8]) -> P.ByteString -> Either String P.ByteString
+          withBytes :: ([Word8] -> Either String [Word8]) -> BS.ByteString -> Either String BS.ByteString
           withBytes f = fmap BS.pack . f . BS.unpack
 
 -- | 'Bultins.SizedByteString 32' with various useful JSON and
 --   servant instances for the Playground, and a convenient bridge
 --   type for PureScript.
-newtype LedgerBytes = LedgerBytes { getLedgerBytes :: Builtins.ByteString } -- TODO: use strict bytestring
+newtype LedgerBytes = LedgerBytes { getLedgerBytes :: BS.ByteString } -- TODO: use strict bytestring
     deriving stock (Eq, Ord, Generic)
     deriving newtype (Serialise, P.Eq, P.Ord, PlutusTx.IsData)
     deriving anyclass (JSON.ToJSONKey, JSON.FromJSONKey, NFData)

plutus-ledger-api/src/Plutus/V1/Ledger/Credential.hs

@@ -21,6 +21,7 @@ module Plutus.V1.Ledger.Credential(
 import           Codec.Serialise.Class     (Serialise)
 import           Control.DeepSeq           (NFData)
 import           Data.Aeson                (FromJSON, ToJSON)
+import qualified Data.ByteString           as BS
 import           Data.Hashable             (Hashable)
 import           Data.Text.Prettyprint.Doc (Pretty (..), (<+>))
 import           GHC.Generics              (Generic)
@@ -34,7 +35,7 @@ import qualified PlutusTx.Eq               as PlutusTx
 
 -- | Staking credential used to assign rewards
 data StakingCredential
-    = StakingHash Builtins.ByteString
+    = StakingHash BS.ByteString
     | StakingPtr Integer Integer Integer -- NB: The fields should really be Word64 / Natural / Natural, but 'Integer' is our only integral type so we need to use it instead.
     deriving stock (Eq, Ord, Show, Generic)
     deriving anyclass (ToJSON, FromJSON, Serialise, Hashable, NFData)

plutus-ledger-api/src/Plutus/V1/Ledger/Crypto.hs

@@ -43,6 +43,7 @@ import qualified Data.Aeson                as JSON
 import qualified Data.Aeson.Extras         as JSON
 import qualified Data.ByteArray            as BA
 import qualified Data.ByteString           as BS
+import qualified Data.ByteString.Hash      as Hash
 import           Data.Either.Extras        (unsafeFromEither)
 import           Data.Hashable             (Hashable)
 import           Data.String
@@ -87,7 +88,7 @@ pubKeyHash :: PubKey -> PubKeyHash
 pubKeyHash (PubKey (LedgerBytes bs)) =
     -- this needs to be usable in on-chain code as well, so we have to
     -- INLINABLE & use the hash function from Builtins
-    PubKeyHash (Builtins.sha2_256 bs)
+    PubKeyHash (Hash.sha2 bs)
 
 -- | A cryptographic private key.
 newtype PrivateKey = PrivateKey { getPrivateKey :: LedgerBytes }
@@ -99,7 +100,7 @@ newtype PrivateKey = PrivateKey { getPrivateKey :: LedgerBytes }
 makeLift ''PrivateKey
 
 -- | A message with a cryptographic signature.
-newtype Signature = Signature { getSignature :: Builtins.ByteString }
+newtype Signature = Signature { getSignature :: BS.ByteString }
     deriving stock (Eq, Ord, Generic)
     deriving newtype (P.Eq, P.Ord, Serialise, PlutusTx.IsData, NFData)
     deriving (Show, Pretty) via LedgerBytes

plutus-ledger-api/src/Plutus/V1/Ledger/Scripts.hs

@@ -63,6 +63,8 @@ import           Data.Aeson                       (FromJSON, FromJSONKey, ToJSON
 import qualified Data.Aeson                       as JSON
 import qualified Data.Aeson.Extras                as JSON
 import qualified Data.ByteArray                   as BA
+import qualified Data.ByteString                  as BS
+import qualified Data.ByteString.Hash             as Hash
 import qualified Data.ByteString.Lazy             as BSL
 import           Data.Hashable                    (Hashable)
 import           Data.String
@@ -276,41 +278,41 @@ instance BA.ByteArrayAccess MonetaryPolicy where
 
 -- | Script runtime representation of a @Digest SHA256@.
 newtype ValidatorHash =
-    ValidatorHash Builtins.ByteString
+    ValidatorHash BS.ByteString
     deriving (IsString, Haskell.Show, Serialise, Pretty) via LedgerBytes
     deriving stock (Generic)
     deriving newtype (Haskell.Eq, Haskell.Ord, Eq, Ord, Hashable, IsData)
     deriving anyclass (FromJSON, ToJSON, ToJSONKey, FromJSONKey, NFData)
 
 -- | Script runtime representation of a @Digest SHA256@.
 newtype DatumHash =
-    DatumHash Builtins.ByteString
+    DatumHash BS.ByteString
     deriving (IsString, Haskell.Show, Serialise, Pretty) via LedgerBytes
     deriving stock (Generic)
     deriving newtype (Haskell.Eq, Haskell.Ord, Eq, Ord, Hashable, IsData, NFData)
     deriving anyclass (FromJSON, ToJSON, ToJSONKey, FromJSONKey)
 
 -- | Script runtime representation of a @Digest SHA256@.
 newtype RedeemerHash =
-    RedeemerHash Builtins.ByteString
+    RedeemerHash BS.ByteString
     deriving (IsString, Haskell.Show, Serialise, Pretty) via LedgerBytes
     deriving stock (Generic)
     deriving newtype (Haskell.Eq, Haskell.Ord, Eq, Ord, Hashable, IsData)
     deriving anyclass (FromJSON, ToJSON, ToJSONKey, FromJSONKey)
 
 -- | Script runtime representation of a @Digest SHA256@.
 newtype MonetaryPolicyHash =
-    MonetaryPolicyHash Builtins.ByteString
+    MonetaryPolicyHash BS.ByteString
     deriving (IsString, Haskell.Show, Serialise, Pretty) via LedgerBytes
     deriving stock (Generic)
     deriving newtype (Haskell.Eq, Haskell.Ord, Eq, Ord, Hashable, IsData)
     deriving anyclass (FromJSON, ToJSON, ToJSONKey, FromJSONKey)
 
 datumHash :: Datum -> DatumHash
-datumHash = DatumHash . Builtins.sha2_256 . BA.convert
+datumHash = DatumHash . Hash.sha2 . BA.convert
 
 redeemerHash :: Redeemer -> RedeemerHash
-redeemerHash = RedeemerHash . Builtins.sha2_256 . BA.convert
+redeemerHash = RedeemerHash . Hash.sha2 . BA.convert
 
 validatorHash :: Validator -> ValidatorHash
 validatorHash vl = ValidatorHash $ BA.convert h' where

plutus-ledger-api/src/Plutus/V1/Ledger/Value.hs

@@ -58,6 +58,7 @@ import           Control.Monad                    (guard)
 import           Data.Aeson                       (FromJSON, FromJSONKey, ToJSON, ToJSONKey, (.:))
 import qualified Data.Aeson                       as JSON
 import qualified Data.Aeson.Extras                as JSON
+import qualified Data.ByteString                  as BS
 import           Data.Hashable                    (Hashable)
 import qualified Data.List                        (sortBy)
 import           Data.String                      (IsString (fromString))
@@ -79,7 +80,7 @@ import qualified PlutusTx.Ord                     as Ord
 import           PlutusTx.Prelude
 import           PlutusTx.These
 
-newtype CurrencySymbol = CurrencySymbol { unCurrencySymbol :: Builtins.ByteString }
+newtype CurrencySymbol = CurrencySymbol { unCurrencySymbol :: BS.ByteString }
     deriving (IsString, Haskell.Show, Serialise, Pretty) via LedgerBytes
     deriving stock (Generic)
     deriving newtype (Haskell.Eq, Haskell.Ord, Eq, Ord, PlutusTx.IsData)
@@ -115,11 +116,11 @@ currencyMPSHash :: CurrencySymbol -> MonetaryPolicyHash
 currencyMPSHash (CurrencySymbol h) = MonetaryPolicyHash h
 
 {-# INLINABLE currencySymbol #-}
-currencySymbol :: ByteString -> CurrencySymbol
+currencySymbol :: BS.ByteString -> CurrencySymbol
 currencySymbol = CurrencySymbol
 
 -- | ByteString of a name of a token, shown as UTF-8 string when possible
-newtype TokenName = TokenName { unTokenName :: Builtins.ByteString }
+newtype TokenName = TokenName { unTokenName :: BS.ByteString }
     deriving (Serialise) via LedgerBytes
     deriving stock (Generic)
     deriving newtype (Haskell.Eq, Haskell.Ord, Eq, Ord, PlutusTx.IsData)
@@ -132,10 +133,10 @@ instance IsString TokenName where
 fromText :: Text -> TokenName
 fromText = TokenName . E.encodeUtf8
 
-fromTokenName :: (Builtins.ByteString -> r) -> (Text -> r) -> TokenName -> r
+fromTokenName :: (BS.ByteString -> r) -> (Text -> r) -> TokenName -> r
 fromTokenName handleBytestring handleText (TokenName bs) = either (\_ -> handleBytestring bs) handleText $ E.decodeUtf8' bs
 
-asBase16 :: Builtins.ByteString -> Text
+asBase16 :: BS.ByteString -> Text
 asBase16 bs = Text.concat ["0x", JSON.encodeByteString bs]
 
 quoted :: Text -> Text
@@ -176,7 +177,7 @@ instance FromJSON TokenName where
 makeLift ''TokenName
 
 {-# INLINABLE tokenName #-}
-tokenName :: ByteString -> TokenName
+tokenName :: BS.ByteString -> TokenName
 tokenName = TokenName
 
 -- | An asset class, identified by currency symbol and token name.

plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs

@@ -403,12 +403,20 @@ compileExpr e = withContextM 2 (sdToTxt $ "Compiling expr:" GHC.<+> GHC.ppr e) $
     CompileContext {ccScopes=stack,ccBuiltinNameInfo=nameInfo} <- ask
 
     -- TODO: Maybe share this to avoid repeated lookups. Probably cheap, though.
-    (stringTyName, sbsName) <- case (Map.lookup ''Builtins.String nameInfo, Map.lookup 'String.stringToBuiltinString nameInfo) of
-        (Just t1, Just t2) -> pure $ (GHC.getName t1, GHC.getName t2)
-        _                  -> throwPlain $ CompilationError "No info for String builtin"
+    (stringTyName, sbsName, bsTyName) <- case
+        ( Map.lookup ''Builtins.String nameInfo
+        , Map.lookup 'String.stringToBuiltinString nameInfo
+        , Map.lookup ''Builtins.ByteString nameInfo
+        ) of
+            (Just t1, Just t2, Just t3) -> pure $ (GHC.getName t1, GHC.getName t2, GHC.getName t3)
+            _                           -> throwPlain $ CompilationError "No info for String builtin"
 
     let top = NE.head stack
     case e of
+        -- 'fromString' invocation at the builtin ByteString type
+        (strip -> GHC.Var (GHC.idDetails -> GHC.ClassOpId cls)) `GHC.App` GHC.Type (GHC.tyConAppTyCon_maybe -> Just tc) `GHC.App` _ `GHC.App` (strip -> stringExprContent -> Just bs)
+            | GHC.getName cls == GHC.isStringClassName, GHC.getName tc == bsTyName -> do
+                pure $ PIR.Constant () $ PLC.someValue bs
         -- See Note [String literals]
         -- 'fromString' invocation at the builtin String type
         (strip -> GHC.Var (GHC.idDetails -> GHC.ClassOpId cls)) `GHC.App` GHC.Type (GHC.tyConAppTyCon_maybe -> Just tc) `GHC.App` _ `GHC.App` (strip -> stringExprContent -> Just bs)

plutus-tx-plugin/test/Lift/Spec.hs

@@ -24,9 +24,6 @@ Lift.makeLift ''MyPolyData
 data NestedRecord = NestedRecord { unNested :: Maybe (Integer, Integer) }
 Lift.makeLift ''NestedRecord
 
-data WrappedBS = WrappedBS { unWrap :: Builtins.ByteString }
-Lift.makeLift ''WrappedBS
-
 newtype NewtypeInt = NewtypeInt { unNt :: Integer }
 Lift.makeLift ''NewtypeInt
 
@@ -57,7 +54,6 @@ tests = testNested "Lift" [
     , goldenUPlc "list" (Lift.liftProgramDef ([1]::[Integer]))
     , goldenUEval "listInterop" [ getPlc listMatch, Lift.liftProgramDef ([1]::[Integer]) ]
     , goldenUPlc "nested" (Lift.liftProgramDef (NestedRecord (Just (1, 2))))
-    , goldenUPlc "bytestring" (Lift.liftProgramDef (WrappedBS "hello"))
     , goldenUPlc "newtypeInt" (Lift.liftProgramDef (NewtypeInt 1))
     , goldenUPlc "newtypeInt2" (Lift.liftProgramDef (Newtype2 $ NewtypeInt 1))
     , goldenUPlc "newtypeInt3" (Lift.liftProgramDef (Newtype3 $ Newtype2 $ NewtypeInt 1))

plutus-tx-plugin/test/Plugin/Errors/Spec.hs

@@ -38,7 +38,7 @@ errors = testNested "Errors" [
     , goldenUPlcCatch "recursiveNewtype" recursiveNewtype
     , goldenUPlcCatch "mutualRecursionUnfoldingsLocal" mutualRecursionUnfoldingsLocal
     , goldenUPlcCatch "literalCaseInt" literalCaseInt
-    , goldenUPlcCatch "literalCaseBs" literalCaseBs
+    , goldenUPlcCatch "literalConcatenateBs" literalConcatenateBs
     , goldenUPlcCatch "literalCaseOther" literalCaseOther
   ]
 
@@ -71,8 +71,8 @@ mutualRecursionUnfoldingsLocal = plc (Proxy @"mutualRecursionUnfoldingsLocal") (
 literalCaseInt :: CompiledCode (Integer -> Integer)
 literalCaseInt = plc (Proxy @"literalCaseInt") (\case { 1 -> 2; x -> x})
 
-literalCaseBs :: CompiledCode (Builtins.ByteString -> Builtins.ByteString)
-literalCaseBs = plc (Proxy @"literalCaseBs") (\x -> case x of { "abc" -> ""; x -> x})
+literalConcatenateBs :: CompiledCode (Builtins.ByteString -> Builtins.ByteString)
+literalConcatenateBs = plc (Proxy @"literalConcatenateBs") (\x -> Builtins.concatenate "hello" x)
 
 data AType = AType
 

plutus-tx-plugin/test/Plugin/Errors/literalConcatenateBs.plc.golden

@@ -0,0 +1,3 @@
+(program 1.0.0
+  (lam x_i0 [ [ (builtin concatenate) (con bytestring #68656c6c6f) ] x_i1 ])
+)

plutus-tx-plugin/test/Plugin/Primitives/Spec.hs

@@ -45,13 +45,12 @@ primitives = testNested "Primitives" [
   , goldenPir "ifThenElse" ifThenElse
   , goldenUEval "ifThenElseApply" [ toUPlc ifThenElse, toUPlc int, toUPlc int2 ]
   , goldenPir "emptyByteString" emptyByteString
-  , goldenUEval "emptyByteStringApply" [ getPlc emptyByteString, liftProgram Builtins.emptyByteString ]
+  , goldenUEval "emptyByteStringApply" [ getPlc emptyByteString, liftProgram ("" :: String) ]
+  , goldenPir "sha2_256" sha2
   , goldenPir "bytestring" bytestring
-  , goldenUEval "bytestringApply" [ getPlc bytestring, liftProgram ("hello"::Builtins.ByteString) ]
-  , goldenUEval "sha2_256" [ getPlc sha2, liftProgram ("hello" :: Builtins.ByteString)]
-  , goldenUEval "equalsByteString" [ getPlc bsEquals, liftProgram ("hello" :: Builtins.ByteString), liftProgram ("hello" :: Builtins.ByteString)]
-  , goldenUEval "ltByteString" [ getPlc bsLt, liftProgram ("hello" :: Builtins.ByteString), liftProgram ("world" :: Builtins.ByteString)]
-  , goldenUEval "decodeUtf8" [ getPlc bsDecode, liftProgram ("hello" :: Builtins.ByteString)]
+  , goldenPir "equalsByteString" bsEquals
+  , goldenPir "ltByteString" bsLt
+  , goldenPir "decodeUtf8" bsDecode
   , goldenPir "verify" verify
   , goldenPir "trace" trace
   , goldenPir "stringLiteral" stringLiteral
@@ -106,23 +105,23 @@ errorPlc = plc (Proxy @"errorPlc") (Builtins.error @Integer)
 ifThenElse :: CompiledCode (Integer -> Integer -> Integer)
 ifThenElse = plc (Proxy @"ifThenElse") (\(x::Integer) (y::Integer) -> if Builtins.equalsInteger x y then x else y)
 
-emptyByteString :: CompiledCode (Builtins.ByteString -> Builtins.ByteString)
-emptyByteString = plc (Proxy @"emptyByteString") (\(x :: Builtins.ByteString) -> x)
+emptyByteString :: CompiledCode (String -> Builtins.ByteString)
+emptyByteString = plc (Proxy @"emptyByteString") (\(x :: String) -> Builtins.encodeUtf8 (P.stringToBuiltinString x))
 
 bytestring :: CompiledCode (Builtins.ByteString -> Builtins.ByteString)
 bytestring = plc (Proxy @"bytestring") (\(x::Builtins.ByteString) -> x)
 
-sha2 :: CompiledCode (Builtins.ByteString -> Builtins.ByteString)
-sha2 = plc (Proxy @"sha2") (\(x :: Builtins.ByteString) -> Builtins.sha2_256 x)
+sha2 :: CompiledCode Builtins.ByteString
+sha2 = plc (Proxy @"sha2") (Builtins.sha2_256 "hello")
 
-bsEquals :: CompiledCode (Builtins.ByteString -> Builtins.ByteString -> Bool)
-bsEquals = plc (Proxy @"bs32Equals") (\(x :: Builtins.ByteString) (y :: Builtins.ByteString) -> Builtins.equalsByteString x y)
+bsEquals :: CompiledCode Bool
+bsEquals = plc (Proxy @"bs32Equals") (Builtins.equalsByteString ("hello" :: Builtins.ByteString) ("hello" :: Builtins.ByteString))
 
-bsLt :: CompiledCode (Builtins.ByteString -> Builtins.ByteString -> Bool)
-bsLt = plc (Proxy @"bsLt") (\(x :: Builtins.ByteString) (y :: Builtins.ByteString) -> Builtins.lessThanByteString x y)
+bsLt :: CompiledCode Bool
+bsLt = plc (Proxy @"bsLt") (Builtins.lessThanByteString ("hello" :: Builtins.ByteString) ("world" :: Builtins.ByteString))
 
-bsDecode :: CompiledCode (Builtins.ByteString -> Builtins.String)
-bsDecode = plc (Proxy @"bsDecode") (\(x :: Builtins.ByteString) -> Builtins.decodeUtf8 x)
+bsDecode :: CompiledCode Builtins.String
+bsDecode = plc (Proxy @"bsDecode") (Builtins.decodeUtf8 ("hello" :: Builtins.ByteString))
 
 verify :: CompiledCode (Builtins.ByteString -> Builtins.ByteString -> Builtins.ByteString -> Bool)
 verify = plc (Proxy @"verify") (\(x::Builtins.ByteString) (y::Builtins.ByteString) (z::Builtins.ByteString) -> Builtins.verifySignature x y z)

plutus-tx-plugin/test/Plugin/Primitives/decodeUtf8.plc.golden

@@ -1 +1 @@
-(con string "hello")
+(program [ (builtin decodeUtf8) (con bytestring #68656c6c6f) ])

plutus-tx-plugin/test/Plugin/Primitives/emptyByteString.plc.golden

@@ -1 +1,68 @@
-(program (lam ds (con bytestring) ds))
+(program
+  (let
+    (rec)
+    (datatypebind
+      (datatype
+        (tyvardecl List (fun (type) (type)))
+        (tyvardecl a (type))
+        Nil_match
+        (vardecl Nil [List a]) (vardecl Cons (fun a (fun [List a] [List a])))
+      )
+    )
+    (let
+      (nonrec)
+      (datatypebind
+        (datatype (tyvardecl Unit (type))  Unit_match (vardecl Unit Unit))
+      )
+      (let
+        (rec)
+        (termbind
+          (strict)
+          (vardecl go (fun [List (con char)] (con string)))
+          (lam
+            ds
+            [List (con char)]
+            [
+              [
+                [
+                  { [ { Nil_match (con char) } ds ] (fun Unit (con string)) }
+                  (lam thunk Unit (con string ""))
+                ]
+                (lam
+                  x
+                  (con char)
+                  (lam
+                    xs
+                    [List (con char)]
+                    (lam
+                      thunk
+                      Unit
+                      [
+                        [ (builtin append) [ (builtin charToString) x ] ]
+                        [ go xs ]
+                      ]
+                    )
+                  )
+                )
+              ]
+              Unit
+            ]
+          )
+        )
+        (let
+          (nonrec)
+          (termbind
+            (nonstrict)
+            (vardecl stringToBuiltinString (fun [List (con char)] (con string)))
+            go
+          )
+          (lam
+            ds
+            [List (con char)]
+            [ (builtin encodeUtf8) [ stringToBuiltinString ds ] ]
+          )
+        )
+      )
+    )
+  )
+)