Remote ContractResponse, use RemoteData

input-output-hk · Oct 18, 2021 · 0b170d3 · 0b170d3
1 parent 6ce64fc
commit 0b170d3
Show file tree

Hide file tree

Showing 17 changed files with 100 additions and 169 deletions.
diff --git a/MetaLamp/nft-marketplace/client/src/Business/Marketplace.purs b/MetaLamp/nft-marketplace/client/src/Business/Marketplace.purs
@@ -14,7 +14,6 @@ import Data.Newtype (unwrap)
 import Data.RawJson (RawJson(..))
 import Data.UUID (toString) as UUID
 import Foreign.Generic (class Decode, class Encode, decodeJSON)
-import Plutus.Abstract.ContractResponse (ContractResponse(..))
 import Plutus.Abstract.RemoteData as PRD
 import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse(..))
 import Plutus.PAB.Simulation (MarketplaceContracts)
@@ -41,10 +40,10 @@ getMarketplaceResponseWith endpoint pick cid param = pollEndpoint getNext endpoi
   getNext (ContractInstanceClientState { cicCurrentState: PartiallyDecodedResponse { observableState: RawJson s } }) =
     runExcept
       $ do
-          (contractResponse :: ContractResponse String s) <- withExcept (ResponseError <<< show) (decodeJSON s)
-          case lookup (unwrap endpoint) (unwrap contractResponse).getEndpointResponses of
-            Just (PRD.Failure e) -> throwError <<< ResponseError $ e
-            Just (PRD.Success state) ->
+          (contractResponse :: PRD.RemoteData String s) <- withExcept (ResponseError <<< show) (decodeJSON s)
+          case contractResponse of
+            PRD.Failure e -> throwError <<< ResponseError $ e
+            PRD.Success state ->
               maybe
                 (throwError <<< ResponseError $ "Invalid state: " <> (show state))
                 pure

diff --git a/MetaLamp/nft-marketplace/generate-purs/MarketplaceTypes.hs b/MetaLamp/nft-marketplace/generate-purs/MarketplaceTypes.hs
@@ -32,7 +32,6 @@ import           Language.PureScript.Bridge                       (BridgePart,
                                                                    (^==))
 import           Language.PureScript.Bridge.Builder               (BridgeData)
 import           Language.PureScript.Bridge.TypeParameters        (A, E)
-import           Plutus.Abstract.ContractResponse                 (ContractResponse)
 import qualified Plutus.Abstract.Percentage                       as Percentage
 import           Plutus.Abstract.RemoteData                       (RemoteData)
 import           Plutus.Contract.StateMachine.ThreadToken         (ThreadToken)
@@ -48,7 +47,6 @@ marketplaceTypes =
           , (equal <*> (genericShow <*> mkSumType)) (Proxy @MarketplaceContracts)
           , (equal <*> (genericShow <*> mkSumType)) (Proxy @Percentage.Percentage)
           , (equal <*> (genericShow <*> mkSumType)) (Proxy @Marketplace.Marketplace)
-          , (equal <*> (genericShow <*> mkSumType)) (Proxy @(ContractResponse E A))
           , (equal <*> (genericShow <*> mkSumType)) (Proxy @(RemoteData E A))
           , (equal <*> (genericShow <*> mkSumType)) (Proxy @Marketplace.MarketplaceDatum)
           , (equal <*> (genericShow <*> mkSumType)) (Proxy @Marketplace.UserItemId)

diff --git a/MetaLamp/nft-marketplace/plutus-starter.cabal b/MetaLamp/nft-marketplace/plutus-starter.cabal
@@ -163,7 +163,6 @@ test-suite test
     main-is: Main.hs
     hs-source-dirs: test
     other-modules:
-      Abstract.ContractRespSpec 
       Abstract.Percentage
       Abstract.RemoteDataSpec 
       Marketplace.Fixtures

diff --git a/MetaLamp/nft-marketplace/src/Plutus/Abstract/ContractResponse.hs b/MetaLamp/nft-marketplace/src/Plutus/Abstract/ContractResponse.hs
@@ -48,55 +48,24 @@ import           PlutusTx.Prelude                 hiding (Monoid (..),
 import           Prelude                          (Monoid (..), Semigroup (..),
                                                    show, subtract)
 import qualified Prelude
-import qualified Test.QuickCheck                  as Q
-import           Text.Printf                      (printf)
 
-newtype ContractResponse e a =
-  ContractResponse
-    { getEndpointResponses :: Map.Map Prelude.String (RemoteData e a)
-    }
-  deriving  (Prelude.Eq, Prelude.Show, Generic)
-  deriving anyclass (J.ToJSON, J.FromJSON)
-  deriving newtype (Q.Arbitrary)
-
-instance Semigroup (ContractResponse e a) where
-  (ContractResponse x) <> (ContractResponse y) = ContractResponse $ Map.unionWith (<>) x y
-
-instance Monoid (ContractResponse e a) where
-  mempty = ContractResponse mempty
-
-updateEndpointStatus :: forall a e proxy l. (KnownSymbol l) => proxy l -> RemoteData e a -> ContractResponse e a
-updateEndpointStatus p status = ContractResponse $ Map.singleton label status
-  where
-    label :: Prelude.String
-    label = symbolVal p
-
-getEndpointStatus :: forall a e proxy l. (KnownSymbol l) => proxy l -> ContractResponse e a -> RemoteData e a
-getEndpointStatus p (ContractResponse res) = fromMaybe NotAsked $ Map.lookup label res
-  where
-    label :: Prelude.String
-    label = symbolVal p
-
-withContractResponse :: forall l a p r s.
+withRemoteDataResponse :: forall l a p r s.
     (HasEndpoint l p s, FromJSON p)
     => Proxy l
     -> (a -> r)
-    -> (p -> Contract (ContractResponse Text r) s Text a)
-    -> Promise (ContractResponse Text r) s Void ()
-withContractResponse ep g c = do
+    -> (p -> Contract (RemoteData Text r) s Text a)
+    -> Promise (RemoteData Text r) s Void ()
+withRemoteDataResponse ep g c = do
     handleEndpoint @l $ \case
-        Left err -> tellEndpointStatus ep $ Failure err
+        Left err -> tell $ Failure err
         Right p -> do
-            _ <- tellEndpointStatus ep Loading
+            _ <- tell Loading
             e <- runError $ errorHandler `handleError` c p
-            tellEndpointStatus ep $ case e of
+            tell $ case e of
                 Left err -> Failure err
                 Right a  -> Success $ g a
 
 errorHandler :: Text -> Contract w s Text b
 errorHandler e = do
     logInfo @Text ("Error submiting the transaction: " <> e)
     throwError e
-
-tellEndpointStatus :: forall a s e ce proxy l m. (KnownSymbol l) => proxy l -> RemoteData e a -> Contract (ContractResponse e a) s ce ()
-tellEndpointStatus p status = tell $ updateEndpointStatus p status
diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/ID.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/ID.hs
@@ -22,8 +22,6 @@ import qualified GHC.Generics                                           as Haske
 import           Ledger
 import qualified Ledger.Typed.Scripts                                   as Scripts
 import           Ledger.Value
-import           Plutus.Abstract.ContractResponse                       (ContractResponse,
-                                                                         withContractResponse)
 import           Plutus.Contract
 import           Plutus.Contract.StateMachine
 import           Plutus.Contracts.Currency                              as Currency

diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/Info.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/Info.hs
@@ -29,8 +29,8 @@ import           Ledger
 import qualified Ledger.Typed.Scripts                         as Scripts
 import           Ledger.Typed.Tx
 import           Ledger.Value
-import           Plutus.Abstract.ContractResponse             (ContractResponse,
-                                                               withContractResponse)
+import           Plutus.Abstract.ContractResponse             (withRemoteDataResponse)
+import           Plutus.Abstract.RemoteData                   (RemoteData)
 import           Plutus.Contract
 import           Plutus.Contract.StateMachine
 import           Plutus.Contracts.Currency                    as Currency
@@ -115,9 +115,9 @@ data InfoContractState =
 
 Lens.makeClassyPrisms ''InfoContractState
 
-infoEndpoints :: Core.Marketplace -> Promise (ContractResponse Text InfoContractState) MarketplaceInfoSchema Void ()
+infoEndpoints :: Core.Marketplace -> Promise (RemoteData Text InfoContractState) MarketplaceInfoSchema Void ()
 infoEndpoints marketplace =
-    (withContractResponse (Proxy @"fundsAt") FundsAt fundsAt
-    `select` withContractResponse (Proxy @"marketplaceFunds") MarketplaceFunds (const $ marketplaceFunds marketplace)
-    `select` withContractResponse (Proxy @"marketplaceStore") MarketplaceStore (const $ marketplaceStore marketplace)
-    `select` withContractResponse (Proxy @"getAuctionState") AuctionState (getAuctionState marketplace)) <> infoEndpoints marketplace
+    (withRemoteDataResponse (Proxy @"fundsAt") FundsAt fundsAt
+    `select` withRemoteDataResponse (Proxy @"marketplaceFunds") MarketplaceFunds (const $ marketplaceFunds marketplace)
+    `select` withRemoteDataResponse (Proxy @"marketplaceStore") MarketplaceStore (const $ marketplaceStore marketplace)
+    `select` withRemoteDataResponse (Proxy @"getAuctionState") AuctionState (getAuctionState marketplace)) <> infoEndpoints marketplace
diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/Owner.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/Owner.hs
@@ -21,10 +21,10 @@ import           Ledger
 import           Ledger.Ada                                   (lovelaceValueOf)
 import qualified Ledger.Typed.Scripts                         as Scripts
 import           Ledger.Value
-import           Plutus.Abstract.ContractResponse             (ContractResponse,
-                                                               withContractResponse)
+import           Plutus.Abstract.ContractResponse             (withRemoteDataResponse)
 import           Plutus.Abstract.Percentage                   (Fractional,
                                                                mkPercentage)
+import           Plutus.Abstract.RemoteData                   (RemoteData)
 import           Plutus.Contract
 import           Plutus.Contract.StateMachine
 import           Plutus.Contracts.Currency                    as Currency
@@ -66,5 +66,5 @@ data OwnerContractState = Started Core.Marketplace
 
 Lens.makeClassyPrisms ''OwnerContractState
 
-ownerEndpoints :: Promise (ContractResponse Text OwnerContractState) MarketplaceOwnerSchema Void ()
-ownerEndpoints = withContractResponse (Proxy @"start") Started (start) <> ownerEndpoints
+ownerEndpoints :: Promise (RemoteData Text OwnerContractState) MarketplaceOwnerSchema Void ()
+ownerEndpoints = withRemoteDataResponse (Proxy @"start") Started (start) <> ownerEndpoints
diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/User.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/User.hs
@@ -34,6 +34,7 @@ import qualified Ledger.Typed.Scripts                                     as Scr
 import           Ledger.Typed.Tx
 import qualified Ledger.Value                                             as V
 import           Plutus.Abstract.ContractResponse
+import           Plutus.Abstract.RemoteData                               (RemoteData)
 import           Plutus.Contract
 import           Plutus.Contract.StateMachine
 import           Plutus.Contracts.Currency                                as Currency
@@ -373,16 +374,16 @@ data UserContractState =
 
 Lens.makeClassyPrisms ''UserContractState
 
-userEndpoints :: Core.Marketplace -> Promise (ContractResponse Text UserContractState) MarketplaceUserSchema Void ()
+userEndpoints :: Core.Marketplace -> Promise (RemoteData Text UserContractState) MarketplaceUserSchema Void ()
 userEndpoints marketplace =
-    (withContractResponse (Proxy @"createNft") (const NftCreated) (createNft marketplace)
-    `select` withContractResponse (Proxy @"openSale") (const OpenedSale) (openSale marketplace)
-    `select` withContractResponse (Proxy @"buyItem") (const NftBought) (buyItem marketplace)
-    `select` withContractResponse (Proxy @"closeSale") (const ClosedSale) (closeSale marketplace)
-    `select` withContractResponse (Proxy @"startAnAuction") (const AuctionStarted) (startAnAuction marketplace)
-    `select` withContractResponse (Proxy @"completeAnAuction") (const AuctionComplete) (completeAnAuction marketplace)
-    `select` withContractResponse (Proxy @"bidOnAuction") (const BidSubmitted) (bidOnAuction marketplace)
-    `select` withContractResponse (Proxy @"bundleUp") (const Bundled) (bundleUp marketplace)
-    `select` withContractResponse (Proxy @"unbundle") (const Unbundled) (unbundle marketplace)
-    `select` withContractResponse (Proxy @"ownPubKey") GetPubKey (const getOwnPubKey)
-    `select` withContractResponse (Proxy @"ownPubKeyBalance") GetPubKeyBalance (const ownPubKeyBalance)) <> userEndpoints marketplace
+    (withRemoteDataResponse (Proxy @"createNft") (const NftCreated) (createNft marketplace)
+    `select` withRemoteDataResponse (Proxy @"openSale") (const OpenedSale) (openSale marketplace)
+    `select` withRemoteDataResponse (Proxy @"buyItem") (const NftBought) (buyItem marketplace)
+    `select` withRemoteDataResponse (Proxy @"closeSale") (const ClosedSale) (closeSale marketplace)
+    `select` withRemoteDataResponse (Proxy @"startAnAuction") (const AuctionStarted) (startAnAuction marketplace)
+    `select` withRemoteDataResponse (Proxy @"completeAnAuction") (const AuctionComplete) (completeAnAuction marketplace)
+    `select` withRemoteDataResponse (Proxy @"bidOnAuction") (const BidSubmitted) (bidOnAuction marketplace)
+    `select` withRemoteDataResponse (Proxy @"bundleUp") (const Bundled) (bundleUp marketplace)
+    `select` withRemoteDataResponse (Proxy @"unbundle") (const Unbundled) (unbundle marketplace)
+    `select` withRemoteDataResponse (Proxy @"ownPubKey") GetPubKey (const getOwnPubKey)
+    `select` withRemoteDataResponse (Proxy @"ownPubKeyBalance") GetPubKeyBalance (const ownPubKeyBalance)) <> userEndpoints marketplace
diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/Services/Sale/Endpoints.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/Services/Sale/Endpoints.hs
@@ -23,8 +23,6 @@ import qualified GHC.Generics                                             as Has
 import           Ledger
 import qualified Ledger.Typed.Scripts                                     as Scripts
 import           Ledger.Value
-import           Plutus.Abstract.ContractResponse                         (ContractResponse,
-                                                                           withContractResponse)
 import qualified Plutus.Abstract.Percentage                               as Percentage
 import           Plutus.Contract
 import           Plutus.Contract.StateMachine