started with oracle PAB

code/week06/app/oracle.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE DeriveAnyClass     #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts   #-}
+{-# LANGUAGE LambdaCase         #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE RankNTypes         #-}
+{-# LANGUAGE TypeApplications   #-}
+{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE TypeOperators      #-}
+
+module Main
+    ( main
+    ) where
+
+import           Control.Monad                           (void)
+import           Control.Monad.Freer                     (Eff, Member, interpret, type (~>))
+import           Control.Monad.Freer.Error               (Error)
+import           Control.Monad.Freer.Extras.Log          (LogMsg)
+import           Control.Monad.IO.Class                  (MonadIO (..))
+import           Data.Aeson                              (FromJSON, ToJSON)
+import           Data.Text.Prettyprint.Doc               (Pretty (..), viaShow)
+import           GHC.Generics                            (Generic)
+import           Plutus.Contract                         (BlockchainActions, ContractError)
+import           Plutus.PAB.Effects.Contract             (ContractEffect (..))
+import           Plutus.PAB.Effects.Contract.Builtin     (Builtin, SomeBuiltin (..), type (.\\), endpointsToSchemas, handleBuiltin)
+import           Plutus.PAB.Effects.ContractTest.Uniswap as US
+import           Plutus.PAB.Monitoring.PABLogMsg         (PABMultiAgentMsg)
+import           Plutus.PAB.Simulator                    (SimulatorEffectHandlers)
+import qualified Plutus.PAB.Simulator                    as Simulator
+import           Plutus.PAB.Types                        (PABError (..))
+import qualified Plutus.PAB.Webserver.Server             as PAB.Server
+
+import           Wallet.Emulator.Types                   (Wallet (..))
+
+import qualified Week06.Oracle.Core                      as Oracle
+import qualified Week06.Oracle.Swap                      as Oracle
+
+main :: IO ()
+main = void $ Simulator.runSimulationWith handlers $ do
+    Simulator.logString @(Builtin OracleContracts) "Starting Oracle PAB webserver on port 8080. Press enter to exit."
+    shutdown <- PAB.Server.startServerDebug
+
+    void $ liftIO getLine
+    shutdown
+
+data OracleContracts = Oracle | Swap Oracle.Oracle
+    deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)
+
+instance Pretty OracleContracts where
+    pretty = viaShow
+
+oracleParams :: Oracle.OracleParams
+oracleParams = Oracle.OracleParams
+    { Oracle.opFees   = 1_000_000
+    , Oracle.opSymbol = "ff"
+    , Oracle.opToken  = "USDT"
+    }
+
+handleOracleContracts ::
+    ( Member (Error PABError) effs
+    , Member (LogMsg (PABMultiAgentMsg (Builtin OracleContracts))) effs
+    )
+    => ContractEffect (Builtin OracleContracts)
+    ~> Eff effs
+handleOracleContracts = handleBuiltin getSchema getContract where
+    getSchema = \case
+        Oracle -> endpointsToSchemas @(Oracle.OracleSchema .\\ BlockchainActions)
+        Swap _ -> endpointsToSchemas @(Oracle.SwapSchema   .\\ BlockchainActions)
+    getContract = \case
+        Oracle      -> SomeBuiltin $ Oracle.runOracle oracleParams
+        Swap oracle -> SomeBuiltin $ Oracle.swap oracle
+
+handlers :: SimulatorEffectHandlers (Builtin OracleContracts)
+handlers =
+    Simulator.mkSimulatorHandlers @(Builtin OracleContracts) []
+    $ interpret handleOracleContracts

code/week06/cabal.project

@@ -19,6 +19,7 @@ source-repository-package
     plutus-contract
     plutus-ledger
     plutus-ledger-api
+    plutus-pab
     plutus-tx
     plutus-tx-plugin
     plutus-use-cases
@@ -32,6 +33,9 @@ source-repository-package
 -- not on Hackage, and so need to be pulled in as `source-repository-package`s themselves. Make sure to
 -- re-update this section from the template when you do an upgrade.
 
+-- This is also needed so evenful-sql-common will build with a
+-- newer version of persistent. See stack.yaml for the mirrored
+-- configuration.
 package eventful-sql-common
   ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances
 
@@ -48,6 +52,15 @@ allow-newer:
 constraints:
   -- aws-lambda-haskell-runtime-wai doesn't compile with newer versions
   aws-lambda-haskell-runtime <= 3.0.3
+  -- big breaking change here, inline-r doens't have an upper bound
+  , singletons < 3.0
+  -- breaks eventful even more than it already was
+  , persistent-template < 2.12
+
+-- See the note on nix/pkgs/default.nix:agdaPackages for why this is here.
+-- (NOTE this will change to ieee754 in newer versions of nixpkgs).
+extra-packages: ieee, filemanip
+
 
 -- Needs some patches, but upstream seems to be fairly dead (no activity in > 1 year)
 source-repository-package
@@ -65,12 +78,6 @@ source-repository-package
   location: https://github.com/input-output-hk/cardano-crypto.git
   tag: f73079303f663e028288f9f4a9e08bcca39a923e
 
--- Needs a fix (https://github.com/wenkokke/unlit/pull/11) and a Hackage release
-source-repository-package
-  type: git
-  location: https://github.com/michaelpj/unlit.git
-  tag: 9ca1112093c5ffd356fc99c7dafa080e686dd748
-
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base

code/week06/hie.yaml

@@ -2,3 +2,5 @@ cradle:
   cabal:
     - path: "./src"
       component: "lib:plutus-pioneer-program-week06"
+    - path: "./app/oracle.hs"
+      component: "exe:oracle"

code/week06/plutus-pioneer-program-week06.cabal

@@ -29,3 +29,17 @@ library
                      , text
   default-language:    Haskell2010
   ghc-options:         -Wall -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fno-strictness -fno-spec-constr -fno-specialise
+
+executable oracle
+  main-is: oracle.hs
+  hs-source-dirs:      app
+  ghc-options:         -threaded
+  build-depends:       aeson
+                     , base ^>= 4.14.1.0
+                     , freer-extras
+                     , freer-simple
+                     , plutus-contract
+                     , plutus-ledger
+                     , plutus-pab
+                     , plutus-pioneer-program-week06
+                     , prettyprinter

code/week06/src/Week06/Oracle/Core.hs

@@ -42,13 +42,14 @@ import           Ledger.Value              as Value
 import           Ledger.Ada                as Ada
 import           Plutus.Contracts.Currency as Currency
 import           Prelude                   (Semigroup (..))
+import qualified Prelude                   as Prelude
 
 data Oracle = Oracle
     { oSymbol   :: !CurrencySymbol
     , oOperator :: !PubKeyHash
     , oFee      :: !Integer
     , oAsset    :: !AssetClass
-    } deriving (Show, Generic, FromJSON, ToJSON)
+    } deriving (Show, Generic, FromJSON, ToJSON, Prelude.Eq, Prelude.Ord)
 
 PlutusTx.makeLift ''Oracle
 

code/week06/src/Week06/Oracle/Swap.hs

@@ -12,9 +12,8 @@
 {-# LANGUAGE TypeOperators         #-}
 
 module Week06.Oracle.Swap
-    ( offerSwap
+    ( SwapSchema
-    , retrieveSwaps
+    , swap
-    , useSwap
     ) where
 
 import           Control.Monad        hiding (fmap)
@@ -199,3 +198,37 @@ useSwap oracle = do
 
     f :: Integer -> Integer -> (TxOutRef, TxOutTx, PubKeyHash) -> Bool
     f amt x (_, o, _) = getPrice x o <= amt
+
+type SwapSchema =
+    BlockchainActions
+        .\/ Endpoint "offer"    Integer
+        .\/ Endpoint "retrieve" ()
+        .\/ Endpoint "use"      ()
+        .\/ Endpoint "funds"    ()
+
+swap :: Oracle -> Contract (Last Value) SwapSchema Text ()
+swap oracle = (offer `select` retrieve `select` use `select` funds) >> swap oracle
+  where
+    offer :: Contract (Last Value) SwapSchema Text ()
+    offer = h $ do
+        amt <- endpoint @"offer"
+        offerSwap oracle amt
+
+    retrieve :: Contract (Last Value) SwapSchema Text ()
+    retrieve = h $ do
+        endpoint @"retrieve"
+        retrieveSwaps oracle
+
+    use :: Contract (Last Value) SwapSchema Text ()
+    use = h $ do
+        endpoint @"use"
+        useSwap oracle
+
+    funds :: Contract (Last Value) SwapSchema Text ()
+    funds = h $ do
+        endpoint @"funds"
+        v <- ownFunds
+        tell $ Last $ Just v
+
+    h :: Contract (Last Value) SwapSchema Text () -> Contract (Last Value) SwapSchema Text ()
+    h = handleError logError

code/week06/src/Week06/Oracle/Test.hs

@@ -64,35 +64,42 @@ myTrace = do
                 , opToken  = assetToken
                 }
 
-    h <- activateContractWallet (Wallet 1) $ runOracle op
+    h1 <- activateContractWallet (Wallet 1) $ runOracle op
     void $ Emulator.waitNSlots 1
-    oracle <- getOracle h
+    oracle <- getOracle h1
 
     void $ activateContractWallet (Wallet 2) $ checkOracle oracle
 
-    callEndpoint @"update" h 1_500_000
+    callEndpoint @"update" h1 1_500_000
     void $ Emulator.waitNSlots 3
 
-    void $ activateContractWallet (Wallet 3) (offerSwap oracle 10_000_000 :: Contract () BlockchainActions Text ())
+    h3 <- activateContractWallet (Wallet 3) $ swap oracle
-    void $ activateContractWallet (Wallet 4) (offerSwap oracle 20_000_000 :: Contract () BlockchainActions Text ())
+    h4 <- activateContractWallet (Wallet 4) $ swap oracle
+    h5 <- activateContractWallet (Wallet 5) $ swap oracle
+
+    callEndpoint @"offer" h3 10_000_000
+    callEndpoint @"offer" h4 20_000_000
     void $ Emulator.waitNSlots 3
 
-    void $ activateContractWallet (Wallet 5) (useSwap oracle :: Contract () BlockchainActions Text ())
+    callEndpoint @"use" h5 ()
     void $ Emulator.waitNSlots 3
 
-    callEndpoint @"update" h 1_700_000
+    callEndpoint @"update" h1 1_700_000
     void $ Emulator.waitNSlots 3
 
-    void $ activateContractWallet (Wallet 5) (useSwap oracle :: Contract () BlockchainActions Text ())
+    callEndpoint @"use" h5 ()
     void $ Emulator.waitNSlots 3
 
-    callEndpoint @"update" h 1_800_000
+    callEndpoint @"update" h1 1_800_000
     void $ Emulator.waitNSlots 3
 
-    void $ activateContractWallet (Wallet 3) (retrieveSwaps oracle :: Contract () BlockchainActions Text ())
+    callEndpoint @"retrieve" h3 ()
-    void $ activateContractWallet (Wallet 4) (retrieveSwaps oracle :: Contract () BlockchainActions Text ())
+    callEndpoint @"retrieve" h4 ()
     void $ Emulator.waitNSlots 3
 
+    callEndpoint @"funds" h3 ()
+    callEndpoint @"funds" h4 ()
+    callEndpoint @"funds" h5 ()
   where
     getOracle :: ContractHandle (Last Oracle) OracleSchema Text -> EmulatorTrace Oracle
     getOracle h = do