Add opaque ByteString type to support literal ByteStrings.

cabal.project

@@ -149,8 +149,8 @@ source-repository-package
 
 source-repository-package
   type: git
-  location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: 6b0fca7a73c317f3af7c14dd4dc38178cc78a6c8
+  location: https://github.com/ak3n/cardano-ledger-specs
+  tag: 9df6db0f055b0c96f88db00601d5c14095d194db
   subdir:
     byron/chain/executable-spec
     byron/crypto

doc/plutus/tutorials/HelloWorldApp.hs

@@ -9,7 +9,7 @@ module HelloWorldApp where
 import qualified Data.Text           as T
 import           Playground.Contract
 import           Plutus.Contract
-import           PlutusTx.Prelude
+import           PlutusTx.Prelude    hiding (String)
 
 
 -- BLOCK1

fake-pab/src/Server.hs

@@ -1,10 +1,12 @@
 {-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveAnyClass        #-}
 {-# LANGUAGE DerivingStrategies    #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE StandaloneDeriving    #-}
 {-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -56,25 +58,27 @@ import           Language.Marlowe                  (ChoiceId (ChoiceId), Contrac
                                                     computeTransaction, emptyState, extractContractRoles)
 import           Ledger                            (PubKeyHash (..))
 import           Network.Wai.Middleware.Cors       (cors, corsRequestHeaders, simpleCorsResourcePolicy)
-import           Plutus.V1.Ledger.Value            (CurrencySymbol (..), TokenName (..), Value (..))
+import           Plutus.V1.Ledger.Value            (CurrencySymbol (..), TokenName (..), Value (..), currencySymbol,
+                                                    tokenName)
 import qualified PlutusTx.AssocMap                 as AssocMap
+import qualified PlutusTx.ByteString               as PlutusTx
 import           Servant                           (Application, Handler (Handler), Server, ServerError, hoistServer,
                                                     serve, serveDirectoryFileServer, throwError, (:<|>) ((:<|>)), (:>))
 import           Text.Blaze.Html.Renderer.Pretty   (renderHtml)
 import qualified Text.Blaze.Html5                  as H
 import qualified Text.Blaze.Html5.Attributes       as A
 
 fromCurrencySymbol :: CurrencySymbol -> String
-fromCurrencySymbol =  Text.unpack . TE.decodeUtf8 . B16.encode . unCurrencySymbol
+fromCurrencySymbol =  Text.unpack . TE.decodeUtf8 . B16.encode . PlutusTx.toHaskellByteString . unCurrencySymbol
 
 toCurrencySymbol :: String -> CurrencySymbol
-toCurrencySymbol = CurrencySymbol . fromRight mempty . B16.decode . TE.encodeUtf8 . Text.pack
+toCurrencySymbol = currencySymbol . fromRight mempty . B16.decode . TE.encodeUtf8 . Text.pack
 
 fromPubKeyHash :: PubKeyHash -> PublicKey
-fromPubKeyHash =  Text.unpack . TE.decodeUtf8 . B16.encode . getPubKeyHash
+fromPubKeyHash =  Text.unpack . TE.decodeUtf8 . B16.encode . PlutusTx.toHaskellByteString . getPubKeyHash
 
 toPubKeyHash :: PublicKey -> PubKeyHash
-toPubKeyHash = PubKeyHash . fromRight mempty . B16.decode . TE.encodeUtf8 . Text.pack
+toPubKeyHash = PubKeyHash . PlutusTx.fromHaskellByteString . fromRight mempty . B16.decode . TE.encodeUtf8 . Text.pack
 
 handlersJSON :: Pool Connection -> FilePath -> Server JSON_API
 handlersJSON conns staticPath = createWallet conns :<|>
@@ -136,7 +140,7 @@ listWalletFunds conns publicKey =
                         WHERE w.pub_key = ?
                         GROUP BY ca.currency_symbol, ca.token_name
                   |] [publicKey]
-      return $ Map.fromListWith (++) [(toCurrencySymbol cs, [(TokenName tn, fromRatio am)]) | (cs, tn, am) <- result])
+      return $ Map.fromListWith (++) [(toCurrencySymbol cs, [(tokenName tn, fromRatio am)]) | (cs, tn, am) <- result])
 
 
 
@@ -157,14 +161,14 @@ transferFunds conns srcPrivKey currSym (TokenName tok) amount destPubKey =
                      ((SELECT id FROM main_transaction), 2, (SELECT id FROM destination_container), ?, ?, ?)|]
                    (srcPubKey,
                     destPubKey,
-                    -amount, curr, tok, amount, curr, tok)
+                    -amount, curr, PlutusTx.toHaskellByteString tok, amount, curr, PlutusTx.toHaskellByteString tok)
       return ())
   where
     srcPubKey = BSU.toString $ B16.encode $ SHA256.hash $ BSU.fromString srcPrivKey
 
 transferFundsPlain :: Pool Connection -> String -> String -> String -> Integer -> String -> Handler String
 transferFundsPlain conns srcPrivKey curr tok amount destPubKey =
-  show <$> transferFunds conns srcPrivKey (toCurrencySymbol curr) (TokenName (BSU.fromString tok)) amount destPubKey
+  show <$> transferFunds conns srcPrivKey (toCurrencySymbol curr) (tokenName (BSU.fromString tok)) amount destPubKey
 
 transferFundsJSON :: Pool Connection -> API.TransferRequest -> Handler ()
 transferFundsJSON conns TransferRequest { src_priv_key = src_priv_key
@@ -177,7 +181,7 @@ transferFundsJSON conns TransferRequest { src_priv_key = src_priv_key
 -- Adds a contract to the list of contracts
 createContractPlain :: Pool Connection -> String -> String -> String -> Handler String
 createContractPlain conns creator_priv_key role_distribution contract =
-  show <$> createContract conns (read creator_priv_key) ([(TokenName name, pubkey) | (name, pubkey) <- read role_distribution]) (fromRight Close $ eitherDecode $ BSLU.fromString contract)
+  show <$> createContract conns (read creator_priv_key) ([(tokenName name, pubkey) | (name, pubkey) <- read role_distribution]) (fromRight Close $ eitherDecode $ BSLU.fromString contract)
 
 createContractJSON :: Pool Connection -> CreateContractRequest -> Handler (Either String CurrencySymbol)
 createContractJSON conns CreateContractRequest { creator_priv_key = creator_priv_key
@@ -202,10 +206,10 @@ createContract conns privkey distrib contract =
                                            |] :: IO [Only String]
       executeMany conn [sql| INSERT INTO token (currency_symbol, token_name)
                              VALUES (?, ?)
-                       |] ([(currencySymbol, BSU.toString tns) | tns <- ownerTokenNamesStr] :: [(String, String)])
+                       |] ([(currencySymbol, BSU.toString (PlutusTx.toHaskellByteString tns)) | tns <- ownerTokenNamesStr] :: [(String, String)])
       sequence_ [execute conn [sql| INSERT INTO currency_amount (amount, currency_symbol, token_name, money_container_id)
                                     VALUES (?, ?, ?, get_or_create_money_container_id_from_pubkey(?))
-                              |] (1 :: Integer, currencySymbol, BSU.toString tns, pk) | (TokenName tns, pk) <- Map.toList owners ]
+                              |] (1 :: Integer, currencySymbol, BSU.toString (PlutusTx.toHaskellByteString tns), pk) | (TokenName tns, pk) <- Map.toList owners ]
       [Only currSlot] <- query_ conn
                       [sql| SELECT MAX(slot_number) + 1
                             FROM slot
@@ -288,7 +292,7 @@ getContractHistory conns encCurrSymb =
         _ -> throwIO (toException ErrorParsingContractState))
 
 fromTokenName :: TokenName -> String
-fromTokenName = BSU.toString . unTokenName
+fromTokenName = BSU.toString . PlutusTx.toHaskellByteString . unTokenName
 
 extractPubkeysAndRoles :: [Input] -> (Set PublicKey, Set String)
 extractPubkeysAndRoles = foldl' extractPubkeyOrRole mempty

marlowe-actus/src/Language/Marlowe/ACTUS/Generator.hs

@@ -16,6 +16,7 @@ import           Data.Time                                                (Day)
 import           Data.Validation                                          (Validation (..))
 import           Language.Marlowe                                         (Action (Choice, Deposit), Bound (Bound),
                                                                            Case (Case), ChoiceId (ChoiceId),
+                                                                           ChoiceName (..),
                                                                            Contract (Close, Let, Pay, When),
                                                                            Observation, Party (Role), Payee (Party),
                                                                            Slot (..),
@@ -96,12 +97,12 @@ inquiryFs ev ct timePosfix date oracle context continue =
         letTemplate inputChoiceId inputOwner cont =
             Let
                 (ValueId inputChoiceId)
-                (ChoiceValue (ChoiceId inputChoiceId inputOwner))
+                (ChoiceValue (ChoiceId (ChoiceName inputChoiceId) inputOwner))
                 cont
 
         inputTemplate inputChoiceId inputOwner inputBound cont =
             When
-                [ Case (Choice (ChoiceId inputChoiceId inputOwner) inputBound) $
+                [ Case (Choice (ChoiceId (ChoiceName inputChoiceId) inputOwner) inputBound) $
                     letTemplate inputChoiceId inputOwner cont
                 ]
                 date

marlowe-playground-server/app/PSGenerator.hs

@@ -239,8 +239,8 @@ writePangramJson outputDir = do
             S.Assert S.TrueObs
                 (S.When
                     [ S.Case (S.Deposit alicePk alicePk ada valueExpr)
-                        ( S.Let (S.ValueId "x") valueExpr
-                            (S.Pay alicePk (S.Party bobRole) ada (S.Cond S.TrueObs (S.UseValue (S.ValueId "x")) (S.UseValue (S.ValueId "y"))) S.Close)
+                        ( S.Let "x" valueExpr
+                            (S.Pay alicePk (S.Party bobRole) ada (S.Cond S.TrueObs (S.UseValue "x") (S.UseValue "y")) S.Close)
                         )
                     , S.Case (S.Choice choiceId [ S.Bound 0 1 ])
                         ( S.If (S.ChoseSomething choiceId `S.OrObs` (S.ChoiceValue choiceId `S.ValueEQ` S.Scale (1 S.% 10) const100))
@@ -257,7 +257,7 @@ writePangramJson outputDir = do
             State
             { accounts = Map.singleton (alicePk, token) 12
             , choices = Map.singleton choiceId 42
-            , boundValues = Map.fromList [ (ValueId "x", 1), (ValueId "y", 2) ]
+            , boundValues = Map.fromList [ ("x", 1), ("y", 2) ]
             , minSlot = S.Slot 123
             }
         encodedState = BS8.pack . Char8.unpack $ encode state

marlowe/src/Language/Marlowe/Pretty.hs

@@ -15,6 +15,7 @@ import           GHC.Generics            (C, Constructor, D, Generic, K1 (K1), M
 import           Ledger                  (PubKeyHash (..), Slot (..))
 import           Ledger.Ada              (Ada, getLovelace)
 import           Ledger.Value
+import qualified PlutusTx.ByteString     as P
 import qualified PlutusTx.Ratio          as P
 import           Text.PrettyPrint.Leijen (Doc, comma, encloseSep, hang, lbracket, line, lparen, parens, rbracket,
                                           rparen, space, text)
@@ -118,6 +119,9 @@ instance Pretty PubKeyHash where
 instance Pretty BS.ByteString where
     prettyFragment = text . show
 
+instance Pretty P.ByteString where
+    prettyFragment = text . show . P.toHaskellByteString
+
 instance Pretty Ada where
     prettyFragment x = prettyFragment (getLovelace x)
 

marlowe/src/Language/Marlowe/Semantics.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -50,8 +51,9 @@ import qualified Data.Aeson.Extras        as JSON
 import           Data.Aeson.Types         hiding (Error, Value)
 import qualified Data.Foldable            as F
 import           Data.Scientific          (Scientific, floatingOrInteger)
+import           Data.String              (IsString (..))
 import           Data.Text                (pack)
-import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)
+import           Data.Text.Encoding       as Text (decodeUtf8, encodeUtf8)
 import           Deriving.Aeson
 import           Language.Marlowe.Pretty  (Pretty (..))
 import           Ledger                   (PubKeyHash (..), Slot (..), ValidatorHash)
@@ -106,16 +108,20 @@ instance Haskell.Show Party where
 type AccountId = Party
 type Timeout = Slot
 type Money = Val.Value
-type ChoiceName = ByteString
 type ChosenNum = Integer
 type SlotInterval = (Slot, Slot)
 type Accounts = Map (AccountId, Token) Integer
 
+newtype ChoiceName = ChoiceName { unChoiceName :: ByteString }
+  deriving (IsString, Haskell.Show, Pretty) via TokenName
+  deriving stock (Generic)
+  deriving newtype (Haskell.Eq, Haskell.Ord, Eq)
+
 -- * Data Types
 {-| Choices – of integers – are identified by ChoiceId
     which combines a name for the choice with the Party who had made the choice.
 -}
-data ChoiceId = ChoiceId ByteString Party
+data ChoiceId = ChoiceId ChoiceName Party
   deriving stock (Haskell.Show,Generic,Haskell.Eq,Haskell.Ord)
   deriving anyclass (Pretty)
 
@@ -135,10 +141,10 @@ instance Haskell.Show Token where
     and can be used by 'UseValue' construct.
 -}
 newtype ValueId = ValueId ByteString
-  deriving stock (Haskell.Show,Haskell.Eq,Haskell.Ord,Generic)
+  deriving (IsString, Haskell.Show) via TokenName
+  deriving stock (Haskell.Eq,Haskell.Ord,Generic)
   deriving anyclass (Newtype)
 
-
 {-| Values include some quantities that change with time,
     including “the slot interval”, “the current balance of an account (in Lovelace)”,
     and any choices that have already been made.
@@ -815,44 +821,44 @@ instance ToJSON State where
 
 instance FromJSON Party where
   parseJSON = withObject "Party" (\v ->
-        (PK . PubKeyHash <$> (JSON.decodeByteString =<< (v .: "pk_hash")))
-    <|> (Role . Val.TokenName . encodeUtf8 <$> (v .: "role_token"))
+        (PK . PubKeyHash . fromHaskellByteString <$> (JSON.decodeByteString =<< (v .: "pk_hash")))
+    <|> (Role . Val.tokenName . Text.encodeUtf8 <$> (v .: "role_token"))
                                  )
 instance ToJSON Party where
     toJSON (PK pkh) = object
-        [ "pk_hash" .= (JSON.String $ JSON.encodeByteString $ getPubKeyHash pkh) ]
+        [ "pk_hash" .= (JSON.String $ JSON.encodeByteString $ toHaskellByteString $ getPubKeyHash pkh) ]
     toJSON (Role (Val.TokenName name)) = object
-        [ "role_token" .= (JSON.String $ decodeUtf8 name) ]
+        [ "role_token" .= (JSON.String $ Text.decodeUtf8 $ toHaskellByteString name) ]
 
 
 instance FromJSON ChoiceId where
   parseJSON = withObject "ChoiceId" (\v ->
-       ChoiceId <$> (encodeUtf8 <$> (v .: "choice_name"))
+       ChoiceId <$> (ChoiceName . fromHaskellByteString . Text.encodeUtf8 <$> (v .: "choice_name"))
                 <*> (v .: "choice_owner")
                                     )
 
 instance ToJSON ChoiceId where
-  toJSON (ChoiceId name party) = object [ "choice_name" .= (JSON.String $ decodeUtf8 name)
+  toJSON (ChoiceId name party) = object [ "choice_name" .= (JSON.String $ Text.decodeUtf8 $ toHaskellByteString $ unChoiceName name)
                                         , "choice_owner" .= party
                                         ]
 
 
 instance FromJSON Token where
   parseJSON = withObject "Token" (\v ->
-       Token <$> (CurrencySymbol <$> (JSON.decodeByteString =<< (v .: "currency_symbol")))
-             <*> (Val.TokenName . encodeUtf8 <$> (v .: "token_name"))
+       Token <$> (Val.currencySymbol <$> (JSON.decodeByteString =<< (v .: "currency_symbol")))
+             <*> (Val.tokenName . Text.encodeUtf8 <$> (v .: "token_name"))
                                  )
 
 instance ToJSON Token where
   toJSON (Token currSym tokName) = object
-      [ "currency_symbol" .= (JSON.String $ JSON.encodeByteString $ unCurrencySymbol currSym)
-      , "token_name" .= (JSON.String $ decodeUtf8 $ unTokenName tokName)
+      [ "currency_symbol" .= (JSON.String $ JSON.encodeByteString $ toHaskellByteString $ unCurrencySymbol currSym)
+      , "token_name" .= (JSON.String $ Text.decodeUtf8 $ toHaskellByteString $ unTokenName tokName)
       ]
 
 instance FromJSON ValueId where
-    parseJSON = withText "ValueId" $ return . ValueId . encodeUtf8
+    parseJSON = withText "ValueId" $ return . ValueId . fromHaskellByteString . Text.encodeUtf8
 instance ToJSON ValueId where
-    toJSON (ValueId x) = JSON.String (decodeUtf8 x)
+    toJSON (ValueId x) = JSON.String (Text.decodeUtf8 $ toHaskellByteString x)
 
 
 instance FromJSON (Value Observation) where
@@ -1295,6 +1301,8 @@ instance Eq State where
 
 
 -- Lifting data types to Plutus Core
+makeLift ''ChoiceName
+makeIsDataIndexed ''ChoiceName [('ChoiceName,0)]
 makeLift ''Party
 makeIsDataIndexed ''Party [('PK,0),('Role,1)]
 makeLift ''ChoiceId

marlowe/src/Language/Marlowe/Util.hs

@@ -6,20 +6,12 @@ import           Data.Map.Strict            (Map)
 import qualified Data.Map.Strict            as Map
 import           Data.Set                   (Set)
 import qualified Data.Set                   as Set
-import           Data.String
 
 import           Language.Marlowe.Semantics
 import           Ledger.Ada                 (adaSymbol, adaToken)
 import qualified Ledger.Value               as Val
 import qualified PlutusTx.Prelude           as P
 
-instance IsString Party where
-    fromString s = Role (fromString s)
-
-instance IsString ValueId where
-    fromString = ValueId . fromString
-
-
 ada :: Token
 ada = Token adaSymbol adaToken
 

marlowe/test/Spec/Marlowe/Common.hs

@@ -9,7 +9,7 @@ import           Data.Map.Strict  (Map)
 import           Language.Marlowe
 import           Ledger           (pubKeyHash)
 import qualified Ledger
-import           Ledger.Value     (CurrencySymbol (..), TokenName (..))
+import qualified Ledger.Value     as Val
 import qualified PlutusTx.Ratio   as P
 import           Test.QuickCheck
 import           Wallet           (PubKey (..))
@@ -334,12 +334,12 @@ pangramContract = let
     bobRole = Role "Bob"
     constant = Constant 100
     choiceId = ChoiceId "choice" alicePk
-    token = Token (CurrencySymbol "aa") (TokenName "name")
+    token = Token (Val.currencySymbol "aa") (Val.tokenName "name")
     valueExpr = AddValue constant (SubValue constant (NegValue constant))
     in Assert TrueObs $ When
         [ Case (Deposit aliceAcc alicePk ada valueExpr)
-            (Let (ValueId "x") valueExpr
-                (Pay aliceAcc (Party bobRole) ada (UseValue (ValueId "x")) Close))
+            (Let "x" valueExpr
+                (Pay aliceAcc (Party bobRole) ada (UseValue "x") Close))
         , Case (Choice choiceId [Bound 0 1, Bound 10 20])
             (If (ChoseSomething choiceId `OrObs` (ChoiceValue choiceId `ValueEQ` Scale (1 % 10) constant))
                 (Pay aliceAcc (Account aliceAcc) token (AvailableMoney aliceAcc token) Close)

marlowe/test/Spec/Marlowe/Marlowe.hs

@@ -201,7 +201,7 @@ trustFundTest = checkPredicateOptions (defaultCheckOptions & maxSlot .~ 200) "Tr
 
             Trace.callEndpoint @"apply-inputs" aliceHdl (pms, Nothing,
                 [ IChoice chId 256
-                , IDeposit "alice" "alice" ada 256
+                , IDeposit (Role "alice") (Role "alice") ada 256
                 ])
             Trace.waitNSlots 17
 
@@ -222,9 +222,9 @@ trustFundTest = checkPredicateOptions (defaultCheckOptions & maxSlot .~ 200) "Tr
         contract = When [
             Case (Choice chId [Bound 10 1500])
                 (When [Case
-                    (Deposit "alice" "alice" ada (ChoiceValue chId))
+                    (Deposit (Role "alice") (Role "alice") ada (ChoiceValue chId))
                         (When [Case (Notify (SlotIntervalStart `ValueGE` Constant 15))
-                            (Pay "alice" (Party "bob") ada
+                            (Pay (Role "alice") (Party $ Role "bob") ada
                                 (ChoiceValue chId) Close)]
                         (Slot 40) Close)
                     ] (Slot 30) Close)
@@ -357,7 +357,7 @@ valueSerialization = property $
 
 mulAnalysisTest :: IO ()
 mulAnalysisTest = do
-    let muliply = foldl (\a _ -> MulValue (UseValue $ ValueId "a") a) (Constant 1) [1..100]
+    let muliply = foldl (\a _ -> MulValue (UseValue "a") a) (Constant 1) [1..100]
         alicePk = PK $ pubKeyHash $ walletPubKey alice
         contract = If (muliply `ValueGE` Constant 10000) Close (Pay alicePk (Party alicePk) ada (Constant (-100)) Close)
     result <- warningsTrace contract