Fix marlowe-dashboard-client

marlowe-dashboard-client/src/Bridge.purs

@@ -12,10 +12,12 @@ import Data.BigInteger (BigInteger)
 import Data.Json.JsonUUID (JsonUUID(..))
 import Data.Lens (Iso', iso)
 import Data.Map (Map, fromFoldable, toUnfoldable) as Front
+import Data.Maybe (Maybe)
+import Data.Tuple (Tuple)
 import Data.Tuple.Nested ((/\))
 import Data.Json.JsonNTuple (JsonNTuple(..))
 import Marlowe.PAB (PlutusAppId(..)) as Front
-import Marlowe.Semantics (Assets(..), Slot(..)) as Front
+import Marlowe.Semantics (Assets(..), Slot(..), PubKeyHash) as Front
 import Network.RemoteData (RemoteData)
 import Plutus.V1.Ledger.Crypto (PubKey(..), PubKeyHash(..)) as Back
 import Plutus.V1.Ledger.Slot (Slot(..)) as Back
@@ -24,7 +26,7 @@ import PlutusTx.AssocMap (Map, fromTuples, toTuples) as Back
 import Servant.PureScript.Ajax (AjaxError)
 import Wallet.Emulator.Wallet (Wallet(..)) as Back
 import Wallet.Types (ContractInstanceId(..)) as Back
-import Contacts.Types (PubKeyHash(..), Wallet(..), WalletInfo(..)) as Front
+import Contacts.Types (Wallet(..), WalletInfo(..)) as Front
 
 {-
 Note [JSON communication]: To ensure the client and the PAB server understand each other, they have
@@ -79,6 +81,10 @@ instance eitherBridge :: (Bridge a c, Bridge b d) => Bridge (Either a b) (Either
   toFront = bimap toFront toFront
   toBack = bimap toBack toBack
 
+instance maybeBridge :: (Bridge a b) => Bridge (Maybe a) (Maybe b) where
+  toFront = map toFront
+  toBack = map toBack
+
 instance mapBridge :: (Ord a, Ord c, Bridge a c, Bridge b d) => Bridge (Back.Map a b) (Front.Map c d) where
   toFront map = Front.fromFoldable $ toFront <$> Back.toTuples map
   toBack map = Back.fromTuples $ toBack <$> Front.toUnfoldable map
@@ -119,9 +125,10 @@ instance walletBridge :: Bridge Back.Wallet Front.Wallet where
   toFront (Back.Wallet { getWalletId }) = Front.Wallet getWalletId
   toBack (Front.Wallet getWalletId) = Back.Wallet { getWalletId }
 
-instance pubKeyHashBridge :: Bridge Back.PubKeyHash Front.PubKeyHash where
-  toFront (Back.PubKeyHash { getPubKeyHash }) = Front.PubKeyHash getPubKeyHash
-  toBack (Front.PubKeyHash getPubKeyHash) = Back.PubKeyHash { getPubKeyHash }
+-- TODO: Marlowe.Semantics.PubKeyHash is currently just an alias for String
+instance pubKeyHashBridge :: Bridge Back.PubKeyHash String where
+  toFront (Back.PubKeyHash { getPubKeyHash }) = getPubKeyHash
+  toBack getPubKeyHash = Back.PubKeyHash { getPubKeyHash }
 
 instance contractInstanceIdBridge :: Bridge Back.ContractInstanceId Front.PlutusAppId where
   toFront (Back.ContractInstanceId { unContractInstanceId: JsonUUID uuid }) = Front.PlutusAppId uuid

marlowe-dashboard-client/src/Capability/Marlowe.purs

@@ -55,11 +55,13 @@ import Foreign.Generic (decodeJSON)
 import Halogen (HalogenM, liftAff)
 import Marlowe.Client (ContractHistory(..))
 import Marlowe.PAB (PlutusAppId(..))
-import Marlowe.Semantics (Assets(..), Contract, MarloweData(..), MarloweParams(..), TokenName, TransactionInput, _rolePayoutValidatorHash, asset, emptyState)
+import Marlowe.Semantics (Assets(..), Contract, MarloweData(..), MarloweParams(..), TokenName, TransactionInput, _rolePayoutValidatorHash, asset, emptyState, PubKeyHash(..))
 import MarloweContract (MarloweContract(..))
 import Plutus.PAB.Webserver.Types (ContractInstanceClientState)
 import Servant.PureScript.Ajax (AjaxError(..), ErrorDescription(..))
 import Types (AjaxResponse, CombinedWSStreamToServer(..), DecodedAjaxResponse)
+import Contacts.Lenses (_companionAppId, _marloweAppId, _pubKey, _pubKeyHash, _wallet, _walletInfo)
+import Contacts.Types (Wallet(..), WalletDetails, WalletInfo(..))
 import WebSocket.Support as WS
 
 -- The `ManageMarlowe` class provides a window on the `ManageContract` and `ManageWallet`
@@ -126,8 +128,8 @@ instance manageMarloweAppM :: ManageMarlowe AppM where
           walletInfo =
             WalletInfo
               { wallet: Wallet uuidString
-              , pubKey: uuidString
-              , pubKeyHash: PubKeyHash uuidString
+              , pubKey: Just uuidString
+              , pubKeyHash: uuidString
               }
 
           assets = Assets $ singleton "" $ singleton "" (fromInt 1000000 * fromInt 10000)
@@ -248,14 +250,14 @@ instance manageMarloweAppM :: ManageMarlowe AppM where
               , marloweState: emptyState zero
               }
         void $ insertContract marloweParams (marloweData /\ mempty)
-        void $ insertWalletRoleContracts (view (_walletInfo <<< _pubKey) walletDetails) marloweParams marloweData
+        void $ insertWalletRoleContracts (view (_walletInfo <<< _pubKeyHash) walletDetails) marloweParams marloweData
         let
           unfoldableRoles :: Array (Tuple TokenName PubKeyHash)
           unfoldableRoles = toUnfoldable roles
         void
           $ for unfoldableRoles \(tokenName /\ pubKeyHash) -> do
               void $ addAssets pubKeyHash $ asset (toString uuid) tokenName (fromInt 1)
-              void $ insertWalletRoleContracts (unwrap pubKeyHash) marloweParams marloweData
+              void $ insertWalletRoleContracts pubKeyHash marloweParams marloweData
         pure $ Right unit
   -- "apply-inputs" to a Marlowe contract on the blockchain
   applyTransactionInput walletDetails marloweParams transactionInput = do
@@ -351,7 +353,7 @@ instance manageMarloweAppM :: ManageMarlowe AppM where
           observableStateJson <- withExceptT Left $ ExceptT $ Contract.getContractInstanceObservableState companionAppId
           mapExceptT (pure <<< lmap Right <<< unwrap) $ decodeJSON $ unwrap observableStateJson
       LocalStorage -> do
-        roleContracts <- getWalletRoleContracts $ view (_walletInfo <<< _pubKey) walletDetails
+        roleContracts <- getWalletRoleContracts $ view (_walletInfo <<< _pubKeyHash) walletDetails
         pure $ Right roleContracts
   -- get all MarloweFollower apps for a given wallet
   getFollowerApps walletDetails = do
@@ -379,7 +381,7 @@ instance manageMarloweAppM :: ManageMarlowe AppM where
               Left decodingErrors -> Left decodingErrors
               Right observableState -> Right (plutusAppId /\ observableState)
       LocalStorage -> do
-        roleContracts <- getWalletRoleContracts $ view (_walletInfo <<< _pubKey) walletDetails
+        roleContracts <- getWalletRoleContracts $ view (_walletInfo <<< _pubKeyHash) walletDetails
         allContracts <- getContracts
         let
           roleContractsToHistory :: MarloweParams -> MarloweData -> Maybe (Tuple PlutusAppId ContractHistory)

marlowe-dashboard-client/src/Capability/MarloweStorage.purs

@@ -27,9 +27,9 @@ import Foreign.Generic (decodeJSON, encodeJSON)
 import Halogen (HalogenM)
 import LocalStorage (Key(..), getItem, removeItem, setItem)
 import Marlowe.PAB (PlutusAppId)
-import Marlowe.Semantics (Assets, MarloweData, MarloweParams, TransactionInput)
+import Marlowe.Semantics (Assets, MarloweData, MarloweParams, TransactionInput, PubKeyHash)
 import Contacts.Lenses (_assets, _pubKeyHash, _walletInfo, _walletNickname)
-import Contacts.Types (PubKeyHash, WalletDetails, WalletLibrary)
+import Contacts.Types (WalletDetails, WalletLibrary)
 
 walletLibraryLocalStorageKey :: Key
 walletLibraryLocalStorageKey = Key "walletLibrary"

marlowe-dashboard-client/src/Capability/PlutusApps/MarloweApp.purs

@@ -40,7 +40,7 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (liftEffect)
 import Foreign.Generic (class Encode)
 import Marlowe.PAB (PlutusAppId)
-import Marlowe.Semantics (Contract, MarloweParams, SlotInterval(..), TokenName, TransactionInput(..))
+import Marlowe.Semantics (Contract, MarloweParams, SlotInterval(..), TokenName, TransactionInput(..), PubKeyHash)
 import Plutus.Contract.Effects (ActiveEndpoint, _ActiveEndpoint)
 import Plutus.V1.Ledger.Crypto (PubKeyHash) as Back
 import Plutus.V1.Ledger.Slot (Slot) as Back

marlowe-dashboard-client/src/Contacts/Lenses.purs

@@ -23,9 +23,9 @@ import Data.Map (Map)
 import Data.Symbol (SProxy(..))
 import InputField.Types (State) as InputField
 import Marlowe.PAB (PlutusAppId)
-import Marlowe.Semantics (Assets, MarloweData, MarloweParams, PubKey)
+import Marlowe.Semantics (Assets, MarloweData, MarloweParams, PubKey, PubKeyHash)
 import Types (WebData)
-import Contacts.Types (CardSection, PubKeyHash, State, Wallet, WalletIdError, WalletInfo, WalletLibrary, WalletNickname, WalletNicknameError, WalletDetails)
+import Contacts.Types (CardSection, State, Wallet, WalletIdError, WalletInfo, WalletLibrary, WalletNickname, WalletNicknameError, WalletDetails)
 
 _walletLibrary :: Lens' State WalletLibrary
 _walletLibrary = prop (SProxy :: SProxy "walletLibrary")
@@ -65,7 +65,7 @@ _previousCompanionAppState = prop (SProxy :: SProxy "previousCompanionAppState")
 _wallet :: Lens' WalletInfo Wallet
 _wallet = _Newtype <<< prop (SProxy :: SProxy "wallet")
 
-_pubKey :: Lens' WalletInfo PubKey
+_pubKey :: Lens' WalletInfo (Maybe PubKey)
 _pubKey = _Newtype <<< prop (SProxy :: SProxy "pubKey")
 
 _pubKeyHash :: Lens' WalletInfo PubKeyHash

marlowe-dashboard-client/src/Contacts/State.purs

@@ -39,12 +39,12 @@ import InputField.Types (Action(..), State) as InputField
 import MainFrame.Types (Action(..)) as MainFrame
 import MainFrame.Types (ChildSlots, Msg)
 import Marlowe.PAB (PlutusAppId(..))
-import Marlowe.Semantics (Assets, Token(..))
+import Marlowe.Semantics (Assets, Token(..), PubKeyHash(..))
 import Network.RemoteData (RemoteData(..), fromEither)
 import Toast.Types (errorToast, successToast)
 import Types (WebData)
 import Contacts.Lenses (_cardSection, _remoteWalletInfo, _walletIdInput, _walletLibrary, _walletNickname, _walletNicknameInput)
-import Contacts.Types (Action(..), CardSection(..), PubKeyHash(..), State, Wallet(..), WalletDetails, WalletIdError(..), WalletInfo(..), WalletLibrary, WalletNickname, WalletNicknameError(..))
+import Contacts.Types (Action(..), CardSection(..), State, Wallet(..), WalletDetails, WalletIdError(..), WalletInfo(..), WalletLibrary, WalletNickname, WalletNicknameError(..))
 
 mkInitialState :: WalletLibrary -> State
 mkInitialState walletLibrary =
@@ -69,8 +69,8 @@ defaultWalletInfo :: WalletInfo
 defaultWalletInfo =
   WalletInfo
     { wallet: Wallet ""
-    , pubKey: ""
-    , pubKeyHash: PubKeyHash ""
+    , pubKey: Just ""
+    , pubKeyHash: ""
     }
 
 handleAction ::

marlowe-dashboard-client/src/Contacts/Types.purs

@@ -5,7 +5,6 @@ module Contacts.Types
   , WalletDetails
   , WalletInfo(..)
   , Wallet(..)
-  , PubKeyHash(..)
   , CardSection(..)
   , WalletNicknameError(..)
   , WalletIdError(..)
@@ -24,7 +23,7 @@ import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
 import InputField.Types (Action, State) as InputField
 import InputField.Types (class InputFieldError)
 import Marlowe.PAB (PlutusAppId)
-import Marlowe.Semantics (Assets, MarloweData, MarloweParams, PubKey)
+import Marlowe.Semantics (Assets, MarloweData, MarloweParams, PubKey, PubKeyHash)
 import Types (WebData)
 
 type State
@@ -58,7 +57,7 @@ type WalletDetails
 newtype WalletInfo
   = WalletInfo
   { wallet :: Wallet
-  , pubKey :: PubKey
+  , pubKey :: Maybe PubKey
   , pubKeyHash :: PubKeyHash
   }
 
@@ -89,22 +88,6 @@ instance encodeWallet :: Encode Wallet where
 instance decodeWallet :: Decode Wallet where
   decode value = genericDecode defaultOptions value
 
--- TODO: move this into Marlowe.Semantics
-newtype PubKeyHash
-  = PubKeyHash String
-
-derive instance newtypePubKeyHash :: Newtype PubKeyHash _
-
-derive instance eqPubKeyHash :: Eq PubKeyHash
-
-derive instance genericPubKeyHash :: Generic PubKeyHash _
-
-instance encodePubKeyHash :: Encode PubKeyHash where
-  encode value = genericEncode defaultOptions value
-
-instance decodePubKeyHash :: Decode PubKeyHash where
-  decode value = genericDecode defaultOptions value
-
 data CardSection
   = Home
   | ViewWallet WalletDetails

marlowe-dashboard-client/src/Contract/State.purs

@@ -219,7 +219,7 @@ getUserParties walletDetails marloweParams =
 
     roleTokens = foldMap (Set.map Role <<< Map.keys <<< Map.filter ((/=) zero)) mCurrencyTokens
   in
-    Set.insert (PK $ unwrap pubKeyHash) roleTokens
+    Set.insert (PK pubKeyHash) roleTokens
 
 withStarted ::
   forall action slots msg m.

marlowe/src/Language/Marlowe/Client.hs

@@ -43,7 +43,7 @@ import           Language.Marlowe.Semantics   hiding (Contract)
 import qualified Language.Marlowe.Semantics   as Marlowe
 import           Language.Marlowe.Util        (extractContractRoles)
 import           Ledger                       (CurrencySymbol, Datum (..), PubKeyHash, Slot (..),
-                                               TokenName, TxOut (..), ValidatorHash, inScripts,
+                                               TokenName, TxOut (..), inScripts,
                                                txOutValue)
 import qualified Ledger
 import           Ledger.Ada                   (adaSymbol, adaValueOf)

web-common-marlowe/src/Marlowe/Semantics.purs

@@ -36,6 +36,9 @@ decodeProp key obj = decode =<< readProp key obj
 type PubKey
   = String
 
+type PubKeyHash
+  = String
+
 data Party
   = PK PubKey
   | Role TokenName