operator fee on finish auction

MetaLamp/nft-marketplace/Makefile

@@ -1,3 +1,3 @@
 fmt:
-	find pab src -type f -name \*.hs -exec \
-		stylish-haskell --inplace '{}' +
+	fix-stylish-haskell
+	fix-purty

MetaLamp/nft-marketplace/src/Ext/Plutus/Contracts/Auction.hs

@@ -39,13 +39,19 @@ import qualified Plutus.Contracts.Currency        as Currency
 import qualified PlutusTx
 import           PlutusTx.Prelude
 import qualified Prelude                          as Haskell
+import qualified Plutus.Contracts.NftMarketplace.OnChain.Core.NFT as Core
+import Plutus.Types.Percentage (Percentage(..))
+import qualified PlutusTx.Ratio as Ratio
 
 -- | Definition of an auction
 data AuctionParams
     = AuctionParams
         { apOwner   :: PubKeyHash -- ^ Current owner of the asset. This is where the proceeds of the auction will be sent.
         , apAsset   :: Value -- ^ The asset itself. This value is going to be locked by the auction script output.
         , apEndTime :: Ledger.POSIXTime -- ^ When the time window for bidding ends.
+        , apInitialPrice :: Value
+        , apMarketplaceOperator :: PubKeyHash
+        , apMarketplaceFee    :: Percentage
         }
         deriving stock (Haskell.Eq, Haskell.Show, Generic)
         deriving anyclass (ToJSON, FromJSON)
@@ -54,17 +60,33 @@ PlutusTx.makeLift ''AuctionParams
 
 PlutusTx.unstableMakeIsData ''AuctionParams
 
-{-# INLINABLE fromTuple #-}
-fromTuple :: (SM.ThreadToken, PubKeyHash, Value, Integer) -> AuctionParams
-fromTuple (_, apOwner, apAsset, endTime) = AuctionParams {apEndTime = Ledger.POSIXTime endTime, ..}
-
-{-# INLINABLE toTuple #-}
-toTuple :: SM.ThreadToken -> AuctionParams -> (SM.ThreadToken, PubKeyHash, Value, Integer)
-toTuple threadToken AuctionParams {..} = (threadToken, apOwner, apAsset, Ledger.getPOSIXTime apEndTime)
+{-# INLINABLE fromAuction #-}
+fromAuction :: Core.Auction -> AuctionParams
+fromAuction Core.Auction {..} = AuctionParams {
+    apOwner = aOwner,
+    apAsset = aAsset,
+    apEndTime = Ledger.POSIXTime aEndTime,
+    apInitialPrice = aInitialPrice,
+    apMarketplaceOperator = aMarketplaceOperator,
+    apMarketplaceFee = aMarketplaceFee
+    }
+
+{-# INLINABLE toAuction #-}
+toAuction :: SM.ThreadToken -> AuctionParams -> Core.Auction
+toAuction threadToken AuctionParams {..} = 
+    Core.Auction {
+        aThreadToken = threadToken
+        , aOwner = apOwner
+        , aAsset = apAsset
+        , aInitialPrice = apInitialPrice
+        , aEndTime = Ledger.getPOSIXTime apEndTime
+        , aMarketplaceOperator = apMarketplaceOperator
+        , aMarketplaceFee = apMarketplaceFee
+    }
 
 {-# INLINABLE getStateToken #-}
-getStateToken :: (SM.ThreadToken, PubKeyHash, Value, Integer) -> SM.ThreadToken
-getStateToken (token, _, _, _) = token
+getStateToken :: Core.Auction -> SM.ThreadToken
+getStateToken auction = Core.aThreadToken auction
 
 data HighestBid =
     HighestBid
@@ -123,7 +145,7 @@ type AuctionMachine = StateMachine AuctionState AuctionInput
 {-# INLINABLE auctionTransition #-}
 -- | The transitions of the auction state machine.
 auctionTransition :: AuctionParams -> State AuctionState -> AuctionInput -> Maybe (TxConstraints Void Void, State AuctionState)
-auctionTransition AuctionParams{apOwner, apAsset, apEndTime} State{stateData=oldState} input =
+auctionTransition AuctionParams{..} State{stateData=oldState} input =
     case (oldState, input) of
 
         (Ongoing HighestBid{highestBid, highestBidder}, Bid{newBid, newBidder}) | newBid > highestBid -> -- if the new bid is higher,
@@ -140,9 +162,13 @@ auctionTransition AuctionParams{apOwner, apAsset, apEndTime} State{stateData=old
         (Ongoing h@HighestBid{highestBidder, highestBid}, Payout) ->
             let constraints =
                     Constraints.mustValidateIn (Interval.from apEndTime) -- When the auction has ended,
-                    <> Constraints.mustPayToPubKey apOwner (Ada.toValue highestBid) -- the owner receives the payment
+                    <> Constraints.mustPayToPubKey apOwner (Ada.lovelaceValueOf saleProfit) -- the owner receives the payment
                     <> Constraints.mustPayToPubKey highestBidder apAsset -- and the highest bidder the asset
+                    <> Constraints.mustPayToPubKey apMarketplaceOperator (Ada.lovelaceValueOf operatorFee)
                 newState = State { stateData = Finished h, stateValue = mempty }
+                highestBidInLovelace = Ada.getLovelace highestBid
+                saleProfit = highestBidInLovelace - operatorFee
+                operatorFee = Ratio.round $ (highestBidInLovelace % 100) * (getPercentage apMarketplaceFee)
             in Just (constraints, newState)
 
         -- Any other combination of 'AuctionState' and 'AuctionInput' is disallowed.
@@ -209,21 +235,19 @@ instance SM.AsSMContractError AuctionError where
     _SMContractError = _StateMachineContractError . SM._SMContractError
 
 -- | Client code for the seller
-startAuction :: Value -> Ledger.POSIXTime -> Contract w s AuctionError (SM.ThreadToken, AuctionParams)
-startAuction value time = do
+startAuction :: AuctionParams -> Contract w s AuctionError SM.ThreadToken
+startAuction auctionParams@AuctionParams{..} = do
     threadToken <- SM.getThreadToken
     logInfo $ "Obtained thread token: " <> Haskell.show threadToken
-    self <- Ledger.pubKeyHash <$> ownPubKey
-    let params       = AuctionParams{apOwner = self, apAsset = value, apEndTime = time }
-        inst         = typedValidator (threadToken, params)
-        client       = machineClient inst threadToken params
+    let inst         = typedValidator (threadToken, auctionParams)
+        client       = machineClient inst threadToken auctionParams
 
     _ <- handleError
             (\e -> do { logError (AuctionFailed e); throwError (StateMachineContractError e) })
-            (SM.runInitialise client (initialState self) value)
+            (SM.runInitialise client (initialState apOwner) apAsset)
 
-    logInfo $ AuctionStarted params
-    pure (threadToken, params)
+    logInfo $ AuctionStarted auctionParams
+    pure threadToken
 
 -- | Client code for the seller
 payoutAuction :: SM.ThreadToken -> AuctionParams -> Contract w s AuctionError ()

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

@@ -87,7 +87,7 @@ getAuctionState marketplace itemId = do
             bundleEntry ^. Core._nbTokens ^? Core._HasLot . _2 . _Right
 
     let auctionToken = Auction.getStateToken auction
-    let auctionParams = Auction.fromTuple auction
+    let auctionParams = Auction.fromAuction auction
     auctionState <- do
         st <- mapError (T.pack . Haskell.show) $ Auction.currentState auctionToken auctionParams
         maybe (throwError "Auction state not found") pure st

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

@@ -83,7 +83,7 @@ createNft marketplace CreateNftParams {..} = do
     nft <-
            mapError (T.pack . Haskell.show @Currency.CurrencyError) $
            Currency.mintContract pkh [(tokenName, 1)]
-           -- TODO: get operatiorGasFee by minting (const fee?? We haven't a price on this step)
+           -- TODO: get operatiorFee by minting (const fee?? We haven't a price on this step)
     let client = Core.marketplaceClient marketplace
     let nftEntry = Core.NftInfo
             { niCurrency          = Currency.currencySymbol nft
@@ -192,7 +192,8 @@ deriving newtype instance Schema.ToSchema DiffMilliSeconds
 data StartAnAuctionParams =
   StartAnAuctionParams {
     saapItemId   :: UserItemId,
-    saapDuration :: DiffMilliSeconds
+    saapDuration :: DiffMilliSeconds,
+    saapInitialPrice :: Value
   }
     deriving stock    (Haskell.Eq, Haskell.Show, Haskell.Generic)
     deriving anyclass (J.ToJSON, J.FromJSON, Schema.ToSchema)
@@ -201,7 +202,7 @@ Lens.makeClassy_ ''StartAnAuctionParams
 
 -- | The user starts an auction for specified NFT
 startAnAuction :: Core.Marketplace -> StartAnAuctionParams -> Contract w s Text ()
-startAnAuction marketplace StartAnAuctionParams {..} = do
+startAnAuction marketplace@Core.Marketplace{..} StartAnAuctionParams {..} = do
     let internalId = toInternalId saapItemId
     nftStore <- marketplaceStore marketplace
     auctionValue <- case internalId of
@@ -212,10 +213,19 @@ startAnAuction marketplace StartAnAuctionParams {..} = do
 
     currTime <- currentTime
     let endTime = currTime + fromMilliSeconds saapDuration
-    (auctionToken, auctionParams) <- mapError (T.pack . Haskell.show) $ Auction.startAuction auctionValue endTime
+    self <- Ledger.pubKeyHash <$> ownPubKey
+    let auctionParams = Auction.AuctionParams {
+      apOwner = self,
+      apAsset = auctionValue,
+      apEndTime = endTime,
+      apInitialPrice = saapInitialPrice,
+      apMarketplaceOperator = marketplaceOperator,
+      apMarketplaceFee = marketplaceFee
+    }
+    auctionToken <- mapError (T.pack . Haskell.show) $ Auction.startAuction auctionParams
 
     let client = Core.marketplaceClient marketplace
-    let lot = Right $ Auction.toTuple auctionToken auctionParams
+    let lot = Right $ Auction.toAuction auctionToken auctionParams
     void $ mapError' $ runStep client $ Core.PutLotRedeemer internalId lot
 
     logInfo @Haskell.String $ printf "Started an auction %s" (Haskell.show auctionParams)
@@ -237,7 +247,7 @@ completeAnAuction marketplace CloseLotParams {..} = do
             bundleEntry ^. Core._nbTokens ^? Core._HasLot . _2 . _Right
 
     let auctionToken = Auction.getStateToken auction
-    let auctionParams = Auction.fromTuple auction
+    let auctionParams = Auction.fromAuction auction
     _ <- mapError (T.pack . Haskell.show) $ Auction.payoutAuction auctionToken auctionParams
 
     let client = Core.marketplaceClient marketplace
@@ -273,7 +283,7 @@ bidOnAuction marketplace BidOnAuctionParams {..} = do
             bundleEntry ^. Core._nbTokens ^? Core._HasLot . _2 . _Right
 
     let auctionToken = Auction.getStateToken auction
-    let auctionParams = Auction.fromTuple auction
+    let auctionParams = Auction.fromAuction auction
     _ <- mapError (T.pack . Haskell.show) $ Auction.submitBid auctionToken auctionParams boapBid
 
     logInfo @Haskell.String $ printf "Submitted bid for auction %s" (Haskell.show auction)

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

@@ -23,7 +23,6 @@ import qualified Data.Aeson                     as J
 import qualified Data.ByteArray                 as BA
 import qualified Data.List                      as HL
 import qualified Data.Text                      as T
-import qualified Ext.Plutus.Contracts.Auction   as Auction
 import qualified GHC.Generics                   as Haskell
 import           Ledger
 import qualified Ledger.Constraints             as Constraints
@@ -37,6 +36,7 @@ import qualified PlutusTx.AssocMap              as AssocMap
 import           PlutusTx.Prelude               hiding (Semigroup (..))
 import           Prelude                        (Semigroup (..))
 import qualified Prelude                        as Haskell
+import Plutus.Types.Percentage (Percentage)
 
 -- TODO can't use POSIXTime directly because of custom JSON instances defined in Plutus:
 -- generated purescript type has generic instances
@@ -47,11 +47,29 @@ type POSIXTimeT = Integer
 -- 2. acts as a list of tags
 type IpfsCid = BuiltinByteString
 type IpfsCidHash = BuiltinByteString
-type Auction = (ThreadToken, PubKeyHash, Value, POSIXTimeT)
+-- type Auction = (ThreadToken, PubKeyHash, Value, POSIXTimeT)
 type Category = [BuiltinByteString]
 type LotLink = Either Sale.Sale Auction
 type BundleId = BuiltinByteString
 
+data Auction = Auction {
+    aThreadToken :: ThreadToken,
+    aOwner :: PubKeyHash,
+    aAsset :: Value,
+    aInitialPrice :: Value,
+    aEndTime :: POSIXTimeT,
+    aMarketplaceOperator :: PubKeyHash,
+    aMarketplaceFee :: Percentage
+  }
+  deriving stock (Haskell.Eq, Haskell.Show, Haskell.Generic)
+  deriving anyclass (J.ToJSON, J.FromJSON)
+
+PlutusTx.unstableMakeIsData ''Auction
+
+PlutusTx.makeLift ''Auction
+
+Lens.makeClassy_ ''Auction
+
 data NftInfo =
   NftInfo
     { niCurrency    :: !CurrencySymbol

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

@@ -183,7 +183,7 @@ stateTransitionCheck nftStore (CreateNftRedeemer ipfsCidHash nftEntry) ctx =
 stateTransitionCheck MarketplaceDatum {..} (PutLotRedeemer (Left (InternalNftId ipfsCidHash ipfsCid)) lot) ctx =
   traceIfFalse "PutLotRedeemer: " $
   let nftEntry = fromMaybe (traceError "NFT has not been created") $ AssocMap.lookup ipfsCidHash mdSingletons
-      lotValue = either Sale.saleValue (Auction.apAsset . Auction.fromTuple) lot
+      lotValue = either Sale.saleValue (Auction.apAsset . Auction.fromAuction) lot
       hasBeenPutOnSale = lotValue == nftValue ipfsCid nftEntry
       isValidHash = sha2_256 ipfsCid == ipfsCidHash
       hasNoExistingLot = isNothing $ nftLot nftEntry
@@ -193,7 +193,7 @@ stateTransitionCheck MarketplaceDatum {..} (PutLotRedeemer (Left (InternalNftId
 stateTransitionCheck MarketplaceDatum {..} (PutLotRedeemer (Right (InternalBundleId bundleId cids)) lot) ctx =
   traceIfFalse "PutLotRedeemer: " $
   let bundle = fromMaybe (traceError "Bundle has not been created") $ AssocMap.lookup bundleId mdBundles
-      lotValue = either Sale.saleValue (Auction.apAsset . Auction.fromTuple) lot
+      lotValue = either Sale.saleValue (Auction.apAsset . Auction.fromAuction) lot
       cidHashes = case nbTokens bundle of
           NoLot tokens    -> AssocMap.keys tokens
           HasLot tokens _ -> AssocMap.keys tokens

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

@@ -63,7 +63,7 @@ openSale OpenSaleParams {..}  Marketplace.Marketplace {..} = do
                   saleValue         = ospSaleValue,
                   saleOwner         = pkh,
                   marketplaceOperator = marketplaceOperator,
-                  marketplaceFee    = marketplaceGasFee
+                  marketplaceFee    = marketplaceFee
                 }
     let client = Core.saleClient sale
     void $ mapError (T.pack . Haskell.show @SMContractError) $ runInitialise client Core.SaleOngoing ospSaleValue

MetaLamp/nft-marketplace/src/Plutus/PAB/Simulation.hs

@@ -38,7 +38,8 @@ import           Ledger
 import           Ledger.Ada                                   (adaSymbol,
                                                                adaToken,
                                                                adaValueOf,
-                                                               lovelaceValueOf)
+                                                               lovelaceValueOf
+                                                               )
 import           Ledger.Constraints
 import qualified Ledger.Constraints.OffChain                  as Constraints
 import qualified Ledger.Typed.Scripts                         as Scripts
@@ -76,6 +77,9 @@ userWallets = [Wallet i | i <- [2 .. 4]]
 operatorFee :: Ratio Integer
 operatorFee = 5 % 2
 
+initialLotPrice :: Value.Value
+initialLotPrice = lovelaceValueOf 100000000 -- 100 ADA
+
 data ContractIDs = ContractIDs { cidUser :: Map.Map Wallet ContractInstanceId, cidInfo :: ContractInstanceId }
 
 activateContracts :: Simulation (Builtin MarketplaceContracts) ContractIDs
@@ -190,7 +194,8 @@ runNftMarketplace = void $ Simulator.runSimulationWith handlers $ do
 
     let auction = Marketplace.StartAnAuctionParams {
                         saapItemId  = Marketplace.UserNftId photoTokenIpfsCid,
-                        saapDuration = 80 * 1000
+                        saapDuration = 80 * 1000,
+                        saapInitialPrice = initialLotPrice
                     }
     _  <-
         Simulator.callEndpointOnInstance userCid "startAnAuction" auction

MetaLamp/nft-marketplace/src/Plutus/Types/Marketplace.hs

@@ -17,7 +17,7 @@ import           Ledger
 data Marketplace =
   Marketplace
     { marketplaceOperator :: PubKeyHash,
-      marketplaceGasFee :: Percentage
+      marketplaceFee :: Percentage
     }
   deriving stock (Eq, Show, Generic)
   deriving anyclass (J.ToJSON, J.FromJSON)

MetaLamp/nft-marketplace/test/Marketplace/Fixtures/Script.hs

@@ -18,7 +18,7 @@ marketplace :: Marketplace.Marketplace
 marketplace =
   Marketplace.Marketplace {
     Marketplace.marketplaceOperator = pubKeyHash $ walletPubKey Fixtures.ownerWallet,
-    Marketplace.marketplaceGasFee = percentage
+    Marketplace.marketplaceFee = percentage
   }
 
 percentage :: Percentage

MetaLamp/nft-marketplace/test/Marketplace/Spec/Auction.hs

@@ -30,6 +30,7 @@ import qualified PlutusTx.AssocMap                            as AssocMap
 import           Test.Tasty
 import qualified Utils
 import           Wallet.Emulator.Wallet                       (walletAddress)
+import           Ledger.Ada                                   (lovelaceValueOf)
 
 tests :: TestTree
 tests =
@@ -105,14 +106,15 @@ tests =
     ]]
 
 auctionValue :: Marketplace.Auction -> Value
-auctionValue = Auction.apAsset . Auction.fromTuple
+auctionValue = Auction.apAsset . Auction.fromAuction
 
 -- \/\/\/ "NFT singletons"
 startAnAuctionParams ::        Marketplace.StartAnAuctionParams
 startAnAuctionParams =  Marketplace.StartAnAuctionParams
         {
     Marketplace.saapItemId   = Marketplace.UserNftId Fixtures.catTokenIpfsCid,
-    Marketplace.saapDuration = 155 * 1000
+    Marketplace.saapDuration = 155 * 1000,
+    Marketplace.saapInitialPrice = lovelaceValueOf 100000000
   }
 
 closeLotParams ::        Marketplace.CloseLotParams
@@ -245,7 +247,8 @@ startAnAuctionParamsB ::        Marketplace.StartAnAuctionParams
 startAnAuctionParamsB =  Marketplace.StartAnAuctionParams
         {
     Marketplace.saapItemId   = Marketplace.UserBundleId Fixtures.cids,
-    Marketplace.saapDuration = 142 * 1000
+    Marketplace.saapDuration = 142 * 1000,
+    Marketplace.saapInitialPrice = lovelaceValueOf 100000000
   }
 
 closeLotParamsB ::        Marketplace.CloseLotParams