Merge pull request #1 from obsidiansystems/is-dapp-polish-phase1

Plutus Partners Dapp Polish Phase1

use-case-2/README.md

@@ -15,12 +15,16 @@ By the end of this README you will be able to run the POKE-DEX on your machine l
 ##  Running Plutus Application Backend (PAB)
 
 1. [Unpack plutus-starter GitHub Thunk]
-  1. After installing Obelisk, use `ob thunk unpack dep/plutus-starter/`
-  1. In another terminal `cd dep/plutus-starter` and run `nix-shell`
-  1. Then run `cabal new-repl exe:plutus-starter-pab`
-  1. And finally `main` to lauch the PAB and have it listen on port 8080
+  1. After installing Obelisk, use `./scripts/run-pab.sh`
+  1. Followed by `main` when prompted to lauch the PAB and have it listen on port 8080
 
 ##  Starting Obelisk Frontend
 
   1. After running the Plutus Application Backend, in a different terminal, run `ob run --no-interpret ./dep/plutus-starter`
   1. The frontend should be running on localhost:8000 when successful and visible via your browser.
+
+##  Supported Browsers
+  1. Google Chrome
+  1. Chromium
+
+  Note: Firefox can not run the app given that `ob run`(the only instructions provided to see the fronted) does not currently support this browser, app may appear to be broken. 

use-case-2/backend/src/Backend.hs

@@ -26,6 +26,7 @@ import Database.Beam (MonadBeam)
 import Database.Beam.Backend.SQL.BeamExtensions
 import Database.Beam.Postgres
 import Database.Beam.Query
+import Database.Beam.Schema.Tables (primaryKey)
 import qualified Database.PostgreSQL.Simple as Pg
 import Gargoyle.PostgreSQL.Connect
 import Obelisk.Backend
@@ -159,7 +160,7 @@ getPooledTokens httpManager pool = do
       -- Persist current state of pool tokens to Postgresql
       runNoLoggingT $ runDb (Identity pool) $ runBeamSerializable $ do
         runInsert $ insertOnConflict (_db_pooledTokens db) (insertValues pooledTokens)
-          (conflictingFields _pooledToken_symbol)
+          (conflictingFields primaryKey)
           onConflictDoNothing
       return ()
   return ()
@@ -177,19 +178,17 @@ executeSwap httpManager contractId (coinA, amountA) (coinB, amountB) = do
         , spAmountA = amountA
         , spAmountB = amountB
         }
-  print $ "executeSwap: requestUrl ..."  <> (show requestUrl)
   initReq <- parseRequest requestUrl
   let req = initReq
         { method = "POST"
         , requestHeaders = ("Content-Type","application/json"):(requestHeaders initReq)
         , requestBody = RequestBodyLBS $ Aeson.encode reqBody
         }
-  print $ "executeSwap: Json encoded SwapParams ..."  <> (show $ Aeson.encode reqBody)
   -- The response to this request does not return anything but an empty list.
   -- A useful response must be fetched from "observableState"
-  print ("are we hanging?" :: String)
+  print ("executeSwap: sending request to pab..." :: String)
   _ <- httpLbs req httpManager
-  print ("no we are not hanging" :: String)
+  print ("executeSwap: request sent." :: String)
   fetchObservableState httpManager contractId
 
 {-
@@ -204,19 +203,17 @@ executeStake httpManager contractId (coinA, amountA) (coinB, amountB) = do
         , apAmountA = amountA
         , apAmountB = amountB
         }
-  print $ "executeStake: requestUrl ..."  <> (show requestUrl)
   initReq <- parseRequest requestUrl
   let req = initReq
         { method = "POST"
         , requestHeaders = ("Content-Type","application/json"):(requestHeaders initReq)
         , requestBody = RequestBodyLBS $ Aeson.encode reqBody
         }
-  print $ "executeStake: Json encoded AddParams ..."  <> (show $ Aeson.encode reqBody)
   -- The response to this request does not return anything but an empty list.
   -- A useful response must be fetched from "observableState"
-  print ("are we hanging?" :: String)
+  print $ ("executeStake: sending request to pab..." :: String)
   _ <- httpLbs req httpManager
-  print ("no we are not hanging" :: String)
+  print $ ("executeStake: request sent." :: String)
   fetchObservableState httpManager contractId
 
 {-
@@ -230,19 +227,17 @@ executeRemove httpManager contractId coinA coinB amount = do
         , rpCoinB = coinB
         , rpDiff = amount
         }
-  print $ "executeRemove: requestUrl ..."  <> (show requestUrl)
   initReq <- parseRequest requestUrl
   let req = initReq
         { method = "POST"
         , requestHeaders = ("Content-Type","application/json"):(requestHeaders initReq)
         , requestBody = RequestBodyLBS $ Aeson.encode reqBody
         }
-  print $ "executeRemove: Json encoded RemoveParams ..."  <> (show $ Aeson.encode reqBody)
   -- The response to this request does not return anything but an empty list.
   -- A useful response must be fetched from "observableState"
-  print ("are we hanging?" :: String)
+  print $ ("executeRemove: sending request to pab..." :: String)
   _ <- httpLbs req httpManager
-  print ("no we are not hanging" :: String)
+  print $ ("executeRemove: request sent." :: String)
   fetchObservableState httpManager contractId
 
 -- Grabs `observaleState` field from the contract instance status endpoint. This is used to see smart contract's response to latest request processed.
@@ -254,11 +249,9 @@ fetchObservableState httpManager contractId = do
   let val = Aeson.eitherDecode (responseBody resp) :: Either String Aeson.Value
   case val of
     Left err -> do
-      print $ "fetchObservableState: Left ..."  <> (show err)
       return $ Left err
     Right obj -> do
       let observableState = obj ^.. values . key "cicCurrentState" . key "observableState" . _String
-      print $ "fetchObservableState: Right ..."  <> (show observableState)
       return $ Right observableState
 
 -- Grabs `observableState` field from the contract instance status endpoint. This is used to see smart contract's response to latest request processed.

use-case-2/common/src/Common/Plutus/Contracts/Uniswap/Types.hs

@@ -1,3 +1,8 @@
+{- Once GHC 8.10 is supported in Obelisk (currently only supports GHC 8.6)
+ - , we will be able to reference plutus and plutus-starter ADTs directly.
+ - For now, they will come from this module. This module is not necessary
+ - for creating smart contracts, view at your own discretion.
+-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}

use-case-2/common/src/Common/Schema.hs

@@ -54,9 +54,9 @@ instance Table ContractT where
   primaryKey = ContractId . _contract_id
 
 instance Table PooledTokenT where
-  newtype PrimaryKey PooledTokenT f = PooledTokenId { _pooledTokenId_symbol :: Columnar f Text }
+  data PrimaryKey PooledTokenT f = PooledTokenId { _pooledTokenId_symbol :: Columnar f Text, _pooledTokenId_name :: Columnar f Text }
     deriving (Generic)
-  primaryKey = PooledTokenId . _pooledToken_symbol
+  primaryKey pl = PooledTokenId (_pooledToken_symbol pl) (_pooledToken_name pl)
 
 instance Beamable (PrimaryKey CounterT)
 instance Beamable (PrimaryKey ContractT)

use-case-2/dep/plutus-starter/github.json

@@ -3,6 +3,6 @@
   "repo": "plutus-starter",
   "branch": "is/poke-dex-modifications",
   "private": false,
-  "rev": "0bc1b3839d194db2b137438735d27a604afc2437",
-  "sha256": "028403jsinn8391713c8vgn2ksly3mwvfdaai0mc38y2jgpdmw22"
+  "rev": "6d49c6285218cfc776f4e3cdb2e62a499d02c6c2",
+  "sha256": "1zkpzfcpw1za99i6894i8i61wf8h307x5bkjwzcgxyglhv6l3msv"
 }

use-case-2/scripts/run-pab.sh

@@ -0,0 +1,5 @@
+#!/usr/bin/env bash
+
+ob thunk unpack dep/plutus-starter
+cd dep/plutus-starter
+nix-shell --run "cabal new-repl exe:plutus-starter-pab"