Metalamp/nft marketplace/sale feature

MetaLamp/nft-marketplace/plutus-starter.cabal

@@ -23,7 +23,7 @@ maintainer:         Your email
 
 library
     exposed-modules:
-      Plutus.Contracts.NftMarketplace.OnChain.Core Plutus.Contracts.NftMarketplace.OffChain.Info Ext.Plutus.Ledger.Contexts Ext.Plutus.Ledger.Value Plutus.Contracts.NftMarketplace.OffChain.User Plutus.Abstract.ContractResponse Plutus.Abstract.OutputValue Plutus.Abstract.TxUtils Plutus.Contracts.NftMarketplace.Endpoints Plutus.Contracts.NftMarketplace.OffChain.Owner Plutus.Contracts.NftMarketplace.OnChain.Core.StateMachine Plutus.PAB.Simulation
+      Plutus.Contracts.NftMarketplace.OnChain.Core Plutus.Contracts.Services.Sale Plutus.Contracts.Services.Sale.Endpoints Plutus.Contracts.Services.Sale.StateMachine Plutus.Contracts.NftMarketplace.OffChain.Info Ext.Plutus.Ledger.Contexts Ext.Plutus.Ledger.Value Plutus.Contracts.NftMarketplace.OffChain.User Plutus.Abstract.ContractResponse Plutus.Abstract.OutputValue Plutus.Abstract.TxUtils Plutus.Contracts.NftMarketplace.Endpoints Plutus.Contracts.NftMarketplace.OffChain.Owner Plutus.Contracts.NftMarketplace.OnChain.Core.StateMachine Plutus.PAB.Simulation
     build-depends:
       base >= 4.9 && < 5,
       aeson,

MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OffChain/User.hs

@@ -13,6 +13,7 @@
 
 module Plutus.Contracts.NftMarketplace.OffChain.User where
 
+import           Control.Lens                                  ((^.))
 import qualified Control.Lens                                  as Lens
 import           Control.Monad                                 hiding (fmap)
 import qualified Data.Aeson                                    as J
@@ -24,7 +25,7 @@ import qualified GHC.Generics                                  as Haskell
 import           Ledger
 import qualified Ledger.Typed.Scripts                          as Scripts
 import           Ledger.Typed.Tx
-import           Ledger.Value
+import qualified Ledger.Value                                  as V
 import           Plutus.Abstract.ContractResponse              (ContractResponse,
                                                                 withContractResponse)
 import           Plutus.Contract
@@ -34,6 +35,7 @@ import           Plutus.Contracts.NftMarketplace.OffChain.Info (fundsAt,
                                                                 mapError',
                                                                 marketplaceStore)
 import qualified Plutus.Contracts.NftMarketplace.OnChain.Core  as Core
+import qualified Plutus.Contracts.Services.Sale                as Sale
 import qualified PlutusTx
 import qualified PlutusTx.AssocMap                             as AssocMap
 import           PlutusTx.Prelude                              hiding
@@ -43,6 +45,9 @@ import qualified Prelude                                       as Haskell
 import qualified Schema
 import           Text.Printf                                   (printf)
 
+getOwnPubKey :: Contract w s Text PubKeyHash
+getOwnPubKey = pubKeyHash <$> ownPubKey
+
 data CreateNftParams =
   CreateNftParams {
     cnpIpfsCid        :: ByteString,
@@ -56,7 +61,7 @@ data CreateNftParams =
 PlutusTx.unstableMakeIsData ''CreateNftParams
 PlutusTx.makeLift ''CreateNftParams
 
--- | The user specifizes which NFT to mint and add to marketplace store,
+-- | The user specifies which NFT to mint and add to marketplace store,
 --   he gets it into his wallet and the corresponding store entry is created
 createNft :: Core.Marketplace -> CreateNftParams -> Contract w s Text ()
 createNft marketplace CreateNftParams {..} = do
@@ -65,7 +70,7 @@ createNft marketplace CreateNftParams {..} = do
     when (isJust $ AssocMap.lookup ipfsCidHash nftStore) $ throwError "Nft entry already exists"
 
     pkh <- getOwnPubKey
-    let tokenName = TokenName cnpIpfsCid
+    let tokenName = V.TokenName cnpIpfsCid
     nft <-
            mapError (T.pack . Haskell.show @Currency.CurrencyError) $
            Currency.forgeContract pkh [(tokenName, 1)]
@@ -76,29 +81,119 @@ createNft marketplace CreateNftParams {..} = do
             , nftName        = cnpNftName
             , nftDescription = cnpNftDescription
             , nftIssuer      = if cnpRevealIssuer then Just pkh else Nothing
-            , nftIpfsCid     = Nothing
+            , nftSale     = Nothing -- TODO validate that it's Nothing
             }
     void $ mapError' $ runStep client $ Core.CreateNftRedeemer ipfsCidHash nftEntry
 
     logInfo @Haskell.String $ printf "Created NFT %s with store entry %s" (Haskell.show nft) (Haskell.show nftEntry)
     pure ()
 
-balanceAt :: PubKeyHash -> AssetClass -> Contract w s Text Integer
-balanceAt pkh asset = flip assetClassValueOf asset <$> fundsAt pkh
+data OpenSaleParams =
+  OpenSaleParams {
+    ospIpfsCid   :: ByteString,
+    ospSalePrice :: Sale.LovelacePrice
+  }
+    deriving stock    (Haskell.Eq, Haskell.Show, Haskell.Generic)
+    deriving anyclass (J.ToJSON, J.FromJSON, Schema.ToSchema)
 
-getOwnPubKey :: Contract w s Text PubKeyHash
-getOwnPubKey = pubKeyHash <$> ownPubKey
+PlutusTx.unstableMakeIsData ''OpenSaleParams
+PlutusTx.makeLift ''OpenSaleParams
+
+-- | The user opens sale for his NFT
+openSale :: Core.Marketplace -> OpenSaleParams -> Contract w s Text ()
+openSale marketplace OpenSaleParams {..} = do
+    let ipfsCidHash = sha2_256 ospIpfsCid
+    nftStore <- marketplaceStore marketplace
+    nftEntry <- maybe (throwError "NFT has not been created") pure $ AssocMap.lookup ipfsCidHash nftStore
+    let tokenName = V.TokenName ospIpfsCid
+
+    sale <- Sale.openSale
+              Sale.OpenSaleParams {
+                  ospSalePrice = ospSalePrice,
+                  ospSaleValue = V.singleton (Core.nftId nftEntry) tokenName 1
+              }
+
+    let client = Core.marketplaceClient marketplace
+    let lot = Core.Lot
+                { lotSale          = Sale.toTuple sale
+                , lotIpfsCid     = ospIpfsCid
+                }
+    void $ mapError' $ runStep client $ Core.OpenSaleRedeemer ipfsCidHash lot
+
+    logInfo @Haskell.String $ printf "Created NFT sale %s" (Haskell.show lot)
+    pure ()
+
+data BuyNftParams =
+  BuyNftParams {
+    bnpIpfsCid   :: ByteString
+  }
+    deriving stock    (Haskell.Eq, Haskell.Show, Haskell.Generic)
+    deriving anyclass (J.ToJSON, J.FromJSON, Schema.ToSchema)
+
+PlutusTx.unstableMakeIsData ''BuyNftParams
+PlutusTx.makeLift ''BuyNftParams
+
+-- | The user buys specified NFT lot
+buyNft :: Core.Marketplace -> BuyNftParams -> Contract w s Text ()
+buyNft marketplace BuyNftParams {..} = do
+    let ipfsCidHash = sha2_256 bnpIpfsCid
+    nftStore <- marketplaceStore marketplace
+    nftEntry <- maybe (throwError "NFT has not been created") pure $ AssocMap.lookup ipfsCidHash nftStore
+    nftLot <- maybe (throwError "NFT has not been put on sale") pure $ nftEntry ^. Core._nftSale
+
+    _ <- Sale.buyLot $ Sale.fromTuple $ nftLot ^. Core._lotSale
+
+    let client = Core.marketplaceClient marketplace
+    void $ mapError' $ runStep client $ Core.BuyNftRedeemer ipfsCidHash
+
+    logInfo @Haskell.String $ printf "Bought NFT lot %s" (Haskell.show nftLot)
+    pure ()
+
+data CloseSaleParams =
+  CloseSaleParams {
+    cspIpfsCid   :: ByteString
+  }
+    deriving stock    (Haskell.Eq, Haskell.Show, Haskell.Generic)
+    deriving anyclass (J.ToJSON, J.FromJSON, Schema.ToSchema)
+
+PlutusTx.unstableMakeIsData ''CloseSaleParams
+PlutusTx.makeLift ''CloseSaleParams
+
+-- | The user closes NFT sale and receives his token back
+closeSale :: Core.Marketplace -> CloseSaleParams -> Contract w s Text ()
+closeSale marketplace CloseSaleParams {..} = do
+    let ipfsCidHash = sha2_256 cspIpfsCid
+    nftStore <- marketplaceStore marketplace
+    nftEntry <- maybe (throwError "NFT has not been created") pure $ AssocMap.lookup ipfsCidHash nftStore
+    nftLot <- maybe (throwError "NFT has not been put on sale") pure $ nftEntry ^. Core._nftSale
+
+    _ <- Sale.redeemLot $ Sale.fromTuple $ nftLot ^. Core._lotSale
+
+    let client = Core.marketplaceClient marketplace
+    void $ mapError' $ runStep client $ Core.CloseSaleRedeemer ipfsCidHash
+
+    logInfo @Haskell.String $ printf "Closed NFT lot sale %s" (Haskell.show nftLot)
+    pure ()
+
+balanceAt :: PubKeyHash -> AssetClass -> Contract w s Text Integer
+balanceAt pkh asset = flip V.assetClassValueOf asset <$> fundsAt pkh
 
 ownPubKeyBalance :: Contract w s Text Value
 ownPubKeyBalance = getOwnPubKey >>= fundsAt
 
 type MarketplaceUserSchema =
     Endpoint "createNft" CreateNftParams
+    .\/ Endpoint "openSale" OpenSaleParams
+    .\/ Endpoint "buyNft" BuyNftParams
+    .\/ Endpoint "closeSale" CloseSaleParams
     .\/ Endpoint "ownPubKey" ()
     .\/ Endpoint "ownPubKeyBalance" ()
 
 data UserContractState =
     NftCreated
+    | OpenedSale
+    | NftBought
+    | ClosedSale
     | GetPubKey PubKeyHash
     | GetPubKeyBalance Value
     deriving stock (Haskell.Eq, Haskell.Show, Haskell.Generic)
@@ -109,5 +204,8 @@ Lens.makeClassyPrisms ''UserContractState
 userEndpoints :: Core.Marketplace -> Contract (ContractResponse Text UserContractState) MarketplaceUserSchema Void ()
 userEndpoints marketplace = forever $
     withContractResponse (Proxy @"createNft") (const NftCreated) (createNft marketplace)
+    `select` withContractResponse (Proxy @"openSale") (const OpenedSale) (openSale marketplace)
+    `select` withContractResponse (Proxy @"buyNft") (const NftBought) (buyNft marketplace)
+    `select` withContractResponse (Proxy @"closeSale") (const ClosedSale) (closeSale marketplace)
     `select` withContractResponse (Proxy @"ownPubKey") GetPubKey (const getOwnPubKey)
     `select` withContractResponse (Proxy @"ownPubKeyBalance") GetPubKeyBalance (const ownPubKeyBalance)

MetaLamp/nft-marketplace/src/Plutus/Contracts/NftMarketplace/OnChain/Core/StateMachine.hs

@@ -11,20 +11,23 @@
 
 module Plutus.Contracts.NftMarketplace.OnChain.Core.StateMachine where
 
-import qualified Data.Aeson                   as J
-import qualified Data.Text                    as T
-import qualified GHC.Generics                 as Haskell
+import           Control.Lens                   ((&), (.~), (?~), (^.))
+import qualified Control.Lens                   as Lens
+import qualified Data.Aeson                     as J
+import qualified Data.Text                      as T
+import qualified GHC.Generics                   as Haskell
 import           Ledger
-import qualified Ledger.Constraints           as Constraints
-import qualified Ledger.Typed.Scripts         as Scripts
-import           Ledger.Value
+import qualified Ledger.Constraints             as Constraints
+import qualified Ledger.Typed.Scripts           as Scripts
+import qualified Ledger.Value                   as V
 import           Plutus.Contract
 import           Plutus.Contract.StateMachine
+import qualified Plutus.Contracts.Services.Sale as Sale
 import qualified PlutusTx
-import qualified PlutusTx.AssocMap            as AssocMap
-import           PlutusTx.Prelude             hiding (Semigroup (..))
-import           Prelude                      (Semigroup (..))
-import qualified Prelude                      as Haskell
+import qualified PlutusTx.AssocMap              as AssocMap
+import           PlutusTx.Prelude               hiding (Semigroup (..))
+import           Prelude                        (Semigroup (..))
+import qualified Prelude                        as Haskell
 
 newtype Marketplace =
   Marketplace
@@ -36,14 +39,28 @@ newtype Marketplace =
 PlutusTx.makeLift ''Marketplace
 
 type IpfsCidHash = ByteString
+type Sale = (AssetClass, Sale.LovelacePrice, Value)
+
+data Lot = Lot
+                { lotSale    ::  Sale
+                , lotIpfsCid :: ByteString
+                }
+  deriving stock (Haskell.Eq, Haskell.Show, Haskell.Generic)
+  deriving anyclass (J.ToJSON, J.FromJSON)
+
+PlutusTx.unstableMakeIsData ''Lot
+
+PlutusTx.makeLift ''Lot
+
+Lens.makeClassy_ ''Lot
 
 data NFT =
   NFT
     { nftId          :: CurrencySymbol
     , nftName        :: ByteString
     , nftDescription :: ByteString
     , nftIssuer      :: Maybe PubKeyHash
-    , nftIpfsCid     :: Maybe ByteString
+    , nftSale        :: Maybe Lot
     }
   deriving stock (Haskell.Eq, Haskell.Show, Haskell.Generic)
   deriving anyclass (J.ToJSON, J.FromJSON)
@@ -52,15 +69,20 @@ PlutusTx.unstableMakeIsData ''NFT
 
 PlutusTx.makeLift ''NFT
 
+Lens.makeClassy_ ''NFT
+
 data MarketplaceRedeemer
   = CreateNftRedeemer IpfsCidHash NFT
+  | OpenSaleRedeemer IpfsCidHash Lot
+  | BuyNftRedeemer IpfsCidHash
+  | CloseSaleRedeemer IpfsCidHash
   deriving  (Haskell.Show)
 
 PlutusTx.unstableMakeIsData ''MarketplaceRedeemer
 
 PlutusTx.makeLift ''MarketplaceRedeemer
 
-data MarketplaceDatum =
+newtype MarketplaceDatum =
   MarketplaceDatum
     { getMarketplaceDatum :: AssocMap.Map IpfsCidHash NFT
     }
@@ -74,23 +96,68 @@ PlutusTx.makeLift ''MarketplaceDatum
 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 (MarketplaceDatum $ AssocMap.insert ipfsCidHash nftEntry nftStore) mempty
+                , State (MarketplaceDatum $ AssocMap.insert ipfsCidHash nftEntry nftStore) currStateValue
                 )
+    OpenSaleRedeemer ipfsCidHash lot
+        -> let newEntry = maybe (traceError "NFT has not been created.") (_nftSale ?~ lot) $
+                            AssocMap.lookup ipfsCidHash nftStore
+           in  Just ( mempty
+                    , State (MarketplaceDatum $ AssocMap.insert ipfsCidHash newEntry nftStore) currStateValue
+                    )
+    BuyNftRedeemer ipfsCidHash
+        -> let newEntry = maybe (traceError "NFT has not been created.") (_nftSale .~ Nothing) $
+                            AssocMap.lookup ipfsCidHash nftStore
+           in  Just ( mempty
+                    , State (MarketplaceDatum $ AssocMap.insert ipfsCidHash newEntry nftStore) currStateValue
+                    )
+    CloseSaleRedeemer ipfsCidHash
+        -> let newEntry = maybe (traceError "NFT has not been created.") (_nftSale .~ Nothing) $
+                            AssocMap.lookup ipfsCidHash nftStore
+           in  Just ( mempty
+                    , State (MarketplaceDatum $ AssocMap.insert ipfsCidHash newEntry nftStore) currStateValue
+                    )
     _                                        -> Nothing
   where
+    stateToken :: Value
+    stateToken = V.assetClassValue (marketplaceProtocolToken marketplace) 1
+
     nftStore :: AssocMap.Map IpfsCidHash NFT
     nftStore = getMarketplaceDatum $ stateData state
 
+    currStateValue = stateValue state - stateToken
+
     mustBeSignedByIssuer entry = case nftIssuer entry of
       Just pkh -> Constraints.mustBeSignedBy pkh
       Nothing  -> mempty
 
 {-# INLINABLE stateTransitionCheck #-}
 stateTransitionCheck :: MarketplaceDatum -> MarketplaceRedeemer -> ScriptContext -> Bool
 stateTransitionCheck (MarketplaceDatum nftStore) (CreateNftRedeemer ipfsCidHash nftEntry) ctx =
-  traceIfFalse "Nft entry already exists" $
+  traceIfFalse "CreateNftRedeemer: " $
+  traceIfFalse "NFT entry already exists" $
     isNothing $ AssocMap.lookup ipfsCidHash nftStore
+stateTransitionCheck (MarketplaceDatum nftStore) (OpenSaleRedeemer ipfsCidHash lot) ctx =
+  traceIfFalse "OpenSaleRedeemer: " $
+  let nftEntry = fromMaybe (traceError "NFT has not been created") $ AssocMap.lookup ipfsCidHash nftStore
+      nftIpfsCid = lotIpfsCid lot
+      sale = Sale.fromTuple $ lotSale lot
+      nftValue = V.singleton (nftId nftEntry) (V.TokenName nftIpfsCid) 1
+      hasBeenPutOnSale = Sale.saleValue sale == nftValue
+      isValidHash = sha2_256 nftIpfsCid == ipfsCidHash
+  in  traceIfFalse "NFT has not been put on sale" hasBeenPutOnSale &&
+      traceIfFalse "Invalid IPFS Cid Hash" isValidHash
+stateTransitionCheck (MarketplaceDatum nftStore) (BuyNftRedeemer ipfsCidHash) ctx =
+  traceIfFalse "BuyNftRedeemer: " $
+  let nftEntry = fromMaybe (traceError "NFT has not been created") $ AssocMap.lookup ipfsCidHash nftStore
+      hasBeenPutOnSale = isJust $ nftSale nftEntry
+  in  traceIfFalse "NFT has not been put on sale" hasBeenPutOnSale
+stateTransitionCheck (MarketplaceDatum nftStore) (CloseSaleRedeemer ipfsCidHash) ctx =
+  traceIfFalse "CloseSaleRedeemer: " $
+  let nftEntry = fromMaybe (traceError "NFT has not been created") $ AssocMap.lookup ipfsCidHash nftStore
+      hasBeenPutOnSale = isJust $ nftSale nftEntry
+  in  traceIfFalse "NFT has not been put on sale" hasBeenPutOnSale
 
 {-# INLINABLE marketplaceStateMachine #-}
 marketplaceStateMachine :: Marketplace -> StateMachine MarketplaceDatum MarketplaceRedeemer

MetaLamp/nft-marketplace/src/Plutus/Contracts/Services/Sale.hs

@@ -0,0 +1,4 @@
+module Plutus.Contracts.Services.Sale (module Export) where
+
+import           Plutus.Contracts.Services.Sale.Endpoints    as Export
+import           Plutus.Contracts.Services.Sale.StateMachine as Export