From 7d661ce8e0e1d8f9f14902d93f29c258d4b11b1a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Tue, 28 Sep 2021 09:52:39 +0200 Subject: [PATCH] Fix marlowe-dashboard-client --- marlowe-dashboard-client/src/Bridge.purs | 17 ++++++++++----- .../src/Capability/Marlowe.purs | 16 +++++++------- .../src/Capability/MarloweStorage.purs | 4 ++-- .../src/Capability/PlutusApps/MarloweApp.purs | 2 +- .../src/Contacts/Lenses.purs | 6 +++--- .../src/Contacts/State.purs | 8 +++---- .../src/Contacts/Types.purs | 21 ++----------------- .../src/Contract/State.purs | 2 +- marlowe/src/Language/Marlowe/Client.hs | 2 +- web-common-marlowe/src/Marlowe/Semantics.purs | 3 +++ 10 files changed, 38 insertions(+), 43 deletions(-) diff --git a/marlowe-dashboard-client/src/Bridge.purs b/marlowe-dashboard-client/src/Bridge.purs index a38e982b1a8..9f01e151a37 100644 --- a/marlowe-dashboard-client/src/Bridge.purs +++ b/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 diff --git a/marlowe-dashboard-client/src/Capability/Marlowe.purs b/marlowe-dashboard-client/src/Capability/Marlowe.purs index 1b5c674f172..7a956b6b184 100644 --- a/marlowe-dashboard-client/src/Capability/Marlowe.purs +++ b/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) diff --git a/marlowe-dashboard-client/src/Capability/MarloweStorage.purs b/marlowe-dashboard-client/src/Capability/MarloweStorage.purs index 447cf0fa4df..b3d9ff5f06b 100644 --- a/marlowe-dashboard-client/src/Capability/MarloweStorage.purs +++ b/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" diff --git a/marlowe-dashboard-client/src/Capability/PlutusApps/MarloweApp.purs b/marlowe-dashboard-client/src/Capability/PlutusApps/MarloweApp.purs index 82086d08a5e..1cdda1d4507 100644 --- a/marlowe-dashboard-client/src/Capability/PlutusApps/MarloweApp.purs +++ b/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 diff --git a/marlowe-dashboard-client/src/Contacts/Lenses.purs b/marlowe-dashboard-client/src/Contacts/Lenses.purs index 42d701762e3..4e97a073033 100644 --- a/marlowe-dashboard-client/src/Contacts/Lenses.purs +++ b/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 diff --git a/marlowe-dashboard-client/src/Contacts/State.purs b/marlowe-dashboard-client/src/Contacts/State.purs index 490179ff4a7..b396fc971e1 100644 --- a/marlowe-dashboard-client/src/Contacts/State.purs +++ b/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 :: diff --git a/marlowe-dashboard-client/src/Contacts/Types.purs b/marlowe-dashboard-client/src/Contacts/Types.purs index 4897fb42028..18af5fee3b7 100644 --- a/marlowe-dashboard-client/src/Contacts/Types.purs +++ b/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 diff --git a/marlowe-dashboard-client/src/Contract/State.purs b/marlowe-dashboard-client/src/Contract/State.purs index 455cf3efded..44b429cabef 100644 --- a/marlowe-dashboard-client/src/Contract/State.purs +++ b/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. diff --git a/marlowe/src/Language/Marlowe/Client.hs b/marlowe/src/Language/Marlowe/Client.hs index 79f24fdddbf..ae994864cc6 100644 --- a/marlowe/src/Language/Marlowe/Client.hs +++ b/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) diff --git a/web-common-marlowe/src/Marlowe/Semantics.purs b/web-common-marlowe/src/Marlowe/Semantics.purs index 87eaa5fbdc7..fe5df330c2a 100644 --- a/web-common-marlowe/src/Marlowe/Semantics.purs +++ b/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