Merge branch 'MetaLamp/nft-marketplace/development' into MetaLamp/nft…

…-marketplace/marketplace-operator-fees
input-output-hk · Sep 23, 2021 · d1403b3 · d1403b3
2 parents d1f8c15 + 79ee9cb
commit d1403b3
Show file tree

Hide file tree

Showing 9 changed files with 27 additions and 32 deletions.
diff --git a/MetaLamp/nft-marketplace/client/src/Component/MainPage.purs b/MetaLamp/nft-marketplace/client/src/Component/MainPage.purs
@@ -112,8 +112,6 @@ component =
     Initialize -> do
       initialRoute <- hush <<< (Routing.parse routeCodec) <$> H.liftEffect Routing.getHash
       navigate $ fromMaybe UserPage initialRoute
-      res <- IPFS.catFile "QmTxda1tn2ourkdKYhTwMfLScLCLxJUXMX3q4ScLyVFy8n"
-      logInfo $ show res
       handleAction GetContracts
       handleAction GetInstances
     GoTo route e -> do

diff --git a/MetaLamp/nft-marketplace/client/src/Component/MarketPage.purs b/MetaLamp/nft-marketplace/client/src/Component/MarketPage.purs
@@ -16,6 +16,7 @@ import Data.Either (Either(..))
 import Data.Lens (Lens')
 import Data.Lens.Record (prop)
 import Data.Maybe (Maybe(..))
+import Data.Newtype (unwrap)
 import Data.Symbol (SProxy(..))
 import Data.UserInstance (UserInstance)
 import Effect.Aff.Class (class MonadAff)
@@ -90,9 +91,9 @@ component =
   render st =
     HH.div_
       [ HH.h3_ [ HH.text "Market NFT singletons: " ]
-      , renderNftSingletonLots st.marketplaceState (renderLot <<< Left)
+      , renderNftSingletonLots st.marketplaceState (renderLot st <<< Left)
       , HH.h3_ [ HH.text "Market NFT bundles: " ]
-      , renderNftBundleLots st.marketplaceState (renderLot <<< Right)
+      , renderNftBundleLots st.marketplaceState (renderLot st <<< Right)
       ]
 
   handleAction :: Action -> H.HalogenM State Action Slots output m Unit
@@ -149,8 +150,8 @@ component =
 renderLot ::
   forall m.
   MonadAff m =>
-  Datum.ItemLot -> H.ComponentHTML Action Slots m
-renderLot r = case Datum.getLot r of
+  State -> Datum.ItemLot -> H.ComponentHTML Action Slots m
+renderLot st r = case Datum.getLot r of
   Right auction ->
     HH.div_
       [ renderAuction auction
@@ -162,10 +163,12 @@ renderLot r = case Datum.getLot r of
   Left sale ->
     HH.div_
       [ renderSale sale
-      , HH.button
-          [ HE.onClick \_ -> Just (CloseSale r) ]
-          [ HH.text "Close Sale" ]
-      , HH.button
-          [ HE.onClick \_ -> Just (BuyItem r) ]
-          [ HH.text "Buy Item" ]
+      , if (unwrap sale).saleOwner == st.userInstance.userPubKey then
+          HH.button
+            [ HE.onClick \_ -> Just (CloseSale r) ]
+            [ HH.text "Close Sale" ]
+        else
+          HH.button
+            [ HE.onClick \_ -> Just (BuyItem r) ]
+            [ HH.text "Buy Item" ]
       ]
diff --git a/MetaLamp/nft-marketplace/src/Ext/Plutus/Contracts/Auction.hs b/MetaLamp/nft-marketplace/src/Ext/Plutus/Contracts/Auction.hs
@@ -14,7 +14,6 @@
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeOperators         #-}
 
--- TODO add initial price option
 module Ext.Plutus.Contracts.Auction where
 
 import           Control.Lens                     (makeClassyPrisms)

diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/ID.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/ID.hs
@@ -43,6 +43,7 @@ data UserItemId = UserNftId Text | UserBundleId [Text]
     deriving stock    (Haskell.Eq, Haskell.Show, Haskell.Generic)
     deriving anyclass (J.ToJSON, J.FromJSON)
 
+-- TODO remove ToSchema instances when constraint is removed from PAB
 instance Schema.ToSchema UserItemId where
   toSchema = Schema.FormSchemaUnsupported "TODO how to make these instances for sum types?"
 

diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OnChain/Core/NFT.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OnChain/Core/NFT.hs
@@ -42,7 +42,9 @@ import qualified Prelude                        as Haskell
 -- generated purescript type has generic instances
 type POSIXTimeT = Integer
 
--- TODO (?) add tags
+-- Category = [BuiltinByteString]
+-- 1. acts as a list of category with nested subcategories
+-- 2. acts as a list of tags
 type IpfsCid = BuiltinByteString
 type IpfsCidHash = BuiltinByteString
 type Auction = (ThreadToken, PubKeyHash, Value, POSIXTimeT)

diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OnChain/Core/StateMachine.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OnChain/Core/StateMachine.hs
@@ -37,8 +37,6 @@ import qualified Prelude                                          as Haskell
 import Plutus.Types.Percentage (Percentage)
 import Plutus.Types.Marketplace 
 
--- TODO (?) Prohibit for users which don't have bundled NFTs inside wallet to bundle and unbundle
--- TODO make sum types for eithers (?)
 data MarketplaceRedeemer
   = CreateNftRedeemer IpfsCidHash NftInfo
   | PutLotRedeemer (Either InternalNftId InternalBundleId) LotLink
@@ -130,7 +128,6 @@ removeLotFromBundle NftBundle {..} = NftBundle nbRecord $ NoLot $ snd <$> tokens
 transition :: Marketplace -> State MarketplaceDatum -> MarketplaceRedeemer -> Maybe (TxConstraints Void Void, State MarketplaceDatum)
 transition marketplace state redeemer = case redeemer of
     CreateNftRedeemer ipfsCidHash nftEntry
-    -- TODO check that ipfsCidHash is a hash (?)
         -> Just ( mustBeSignedByIssuer nftEntry
                 , State (insertNft ipfsCidHash (NFT nftEntry Nothing) nftStore) currStateValue
                 )
@@ -168,13 +165,10 @@ transition marketplace state redeemer = case redeemer of
                 )
     _                                        -> trace "Invalid transition" Nothing
   where
-    stateToken :: Value
-    stateToken = mempty -- TODO! V.assetClassValue (marketplaceProtocolToken marketplace) 1
-
     nftStore :: MarketplaceDatum
     nftStore = stateData state
 
-    currStateValue = stateValue state - stateToken
+    currStateValue = stateValue state
 
     mustBeSignedByIssuer entry = case niIssuer entry of
       Just pkh -> Constraints.mustBeSignedBy pkh

diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/Services/Sale/Core.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/Services/Sale/Core.hs
@@ -46,10 +46,9 @@ data Sale =
     { saleProtocolToken :: !ThreadToken,
       salePrice         :: !LovelacePrice,
       saleValue         :: !Value,
+      saleOwner         :: !Saler,
       marketplaceOperator :: !PubKeyHash,
       marketplaceFee    :: !Percentage
-      -- TODO add owner, it is needed for client, we need to hide "close sale" button from users other than owner
-      -- saleOwner :: PubKeyHash
     }
   deriving stock (Haskell.Eq, Haskell.Show, Haskell.Generic)
   deriving anyclass (J.ToJSON, J.FromJSON)

diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/Services/Sale/Endpoints.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/Services/Sale/Endpoints.hs
@@ -61,11 +61,12 @@ openSale OpenSaleParams {..}  Marketplace.Marketplace {..} = do
                 { saleProtocolToken = saleToken,
                   salePrice         = ospSalePrice,
                   saleValue         = ospSaleValue,
+                  saleOwner         = pkh,
                   marketplaceOperator = marketplaceOperator,
                   marketplaceFee    = marketplaceGasFee
                 }
     let client = Core.saleClient sale
-    void $ mapError (T.pack . Haskell.show @SMContractError) $ runInitialise client (Core.LotInfo pkh) ospSaleValue
+    void $ mapError (T.pack . Haskell.show @SMContractError) $ runInitialise client Core.SaleOngoing ospSaleValue
 
     logInfo @Haskell.String $ printf "Opened Sale %s at address %s" (Haskell.show sale) (Haskell.show $ Core.saleAddress sale)
     pure sale

diff --git a/MetaLamp/nft-marketplace/src/Plutus/Contracts/Services/Sale/StateMachine.hs b/MetaLamp/nft-marketplace/src/Plutus/Contracts/Services/Sale/StateMachine.hs
@@ -45,7 +45,7 @@ PlutusTx.unstableMakeIsData ''SaleRedeemer
 PlutusTx.makeLift ''SaleRedeemer
 
 data SaleDatum =
-    LotInfo Saler
+    SaleOngoing
   | SaleClosed
   deriving  (Haskell.Show)
 
@@ -56,22 +56,20 @@ PlutusTx.makeLift ''SaleDatum
 {-# INLINABLE transition #-}
 transition :: Sale -> State SaleDatum -> SaleRedeemer -> Maybe (TxConstraints Void Void, State SaleDatum)
 transition Sale{..} state redeemer = case (stateData state, redeemer) of
-    (LotInfo saler, Redeem)
-        -> Just ( Constraints.mustBeSignedBy saler <>
-                  Constraints.mustPayToPubKey saler val
+    (SaleOngoing, Redeem)
+        -> Just ( Constraints.mustBeSignedBy saleOwner <>
+                  Constraints.mustPayToPubKey saleOwner val
                 , State SaleClosed mempty
                 )
-    (LotInfo saler, Buy buyer) | saleValue == (val - stateToken)
+    (SaleOngoing, Buy buyer) | saleValue == val
         -> Just ( Constraints.mustBeSignedBy buyer <>
-                  Constraints.mustPayToPubKey saler (stateToken <> (Ada.lovelaceValueOf saleProfit)) <>
+                  Constraints.mustPayToPubKey saleOwner (Ada.lovelaceValueOf saleProfit) <>
                   Constraints.mustPayToPubKey buyer saleValue <>
                   Constraints.mustPayToPubKey marketplaceOperator (Ada.lovelaceValueOf operatorFee)
                 , State SaleClosed mempty
                 )
     _                                        -> Nothing
   where
-    stateToken :: Value
-    stateToken = mempty -- TODO! assetClassValue saleProtocolToken 1
     saleProfit :: Integer
     saleProfit = salePrice - operatorFee
     operatorFee :: Integer