{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:coverage-all #-}

module Plutus.Contracts.Uniswap.OffChain
    ( poolStateCoinFromUniswapCurrency, liquidityCoin
    , CreateParams (..)
    , SwapParams (..)
    , CloseParams (..)
    , RemoveParams (..)
    , AddParams (..)
    , UniswapUserSchema, UserContractState (..)
    , UniswapOwnerSchema
    , start, create, add, remove, close, swap, pools
    , ownerEndpoint, userEndpoints
    , findSwapA, findSwapB, covIdx
    -- exported for defining test endpoints
    , findUniswapFactoryAndPool, uniswapInstance, liquidityPolicy
    , uniswapScript, poolStateCoin, liquidityCurrency, lpTicker
    , calculateRemoval, funds
    ) where

import Cardano.Node.Emulator.Internal.Node.Params (testnet)
import Control.Lens ((^?))
import Control.Monad hiding (fmap)
import Data.Aeson (FromJSON, ToJSON)
import Data.Map qualified as Map
import Data.Monoid (Last (..))
import Data.Proxy (Proxy (..))
import Data.Text (Text, pack)
import Data.Void (Void, absurd)
import GHC.Generics (Generic)
import Ledger (CardanoAddress, DecoratedTxOut, datumInDatumFromQuery, decoratedTxOutPlutusValue,
               decoratedTxOutScriptDatum)
import Ledger.Tx.Constraints as Constraints hiding (adjustUnbalancedTx)
import Ledger.Typed.Scripts qualified as Scripts
import Plutus.Contract as Contract
import Plutus.Contract.Test.Coverage.Analysis
import Plutus.Contracts.Currency qualified as Currency
import Plutus.Contracts.Uniswap.OnChain (mkUniswapValidator, validateLiquidityMinting)
import Plutus.Contracts.Uniswap.Pool
import Plutus.Contracts.Uniswap.Types
import Plutus.Script.Utils.V2.Address (mkValidatorCardanoAddress)
import Plutus.Script.Utils.V2.Scripts (scriptCurrencySymbol)
import Plutus.Script.Utils.V2.Typed.Scripts qualified as V2
import Plutus.V2.Ledger.Api (CurrencySymbol, Datum (Datum), DatumHash, MintingPolicy, Redeemer (Redeemer), TokenName,
                             TxOutRef, Validator, Value)
import Plutus.V2.Ledger.Api qualified as V2
import PlutusTx qualified
import PlutusTx.Coverage
import PlutusTx.Prelude hiding (Semigroup (..), dropWhile, flip, unless)
import Prelude as Haskell (Int, Semigroup (..), Show, String, div, dropWhile, flip, show, (^))
import Text.Printf (printf)

data Uniswapping
instance Scripts.ValidatorTypes Uniswapping where
    type instance RedeemerType Uniswapping = UniswapAction
    type instance DatumType    Uniswapping = UniswapDatum

type UniswapOwnerSchema = Endpoint "start" ()

-- | Schema for the endpoints for users of Uniswap.
type UniswapUserSchema =
        Endpoint "create" CreateParams
        .\/ Endpoint "swap"   SwapParams
        .\/ Endpoint "close"  CloseParams
        .\/ Endpoint "remove" RemoveParams
        .\/ Endpoint "add"    AddParams
        .\/ Endpoint "pools"  ()
        .\/ Endpoint "funds"  ()
        .\/ Endpoint "stop"   ()

-- | Type of the Uniswap user contract state.
data UserContractState =
      Pools [((Coin A, Amount A), (Coin B, Amount B))]
    | Funds Value
    | Created
    | Swapped
    | Added
    | Removed
    | Closed
    | Stopped
    deriving (Int -> UserContractState -> ShowS
[UserContractState] -> ShowS
UserContractState -> String
(Int -> UserContractState -> ShowS)
-> (UserContractState -> String)
-> ([UserContractState] -> ShowS)
-> Show UserContractState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserContractState] -> ShowS
$cshowList :: [UserContractState] -> ShowS
show :: UserContractState -> String
$cshow :: UserContractState -> String
showsPrec :: Int -> UserContractState -> ShowS
$cshowsPrec :: Int -> UserContractState -> ShowS
Show, (forall x. UserContractState -> Rep UserContractState x)
-> (forall x. Rep UserContractState x -> UserContractState)
-> Generic UserContractState
forall x. Rep UserContractState x -> UserContractState
forall x. UserContractState -> Rep UserContractState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserContractState x -> UserContractState
$cfrom :: forall x. UserContractState -> Rep UserContractState x
Generic, Value -> Parser [UserContractState]
Value -> Parser UserContractState
(Value -> Parser UserContractState)
-> (Value -> Parser [UserContractState])
-> FromJSON UserContractState
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UserContractState]
$cparseJSONList :: Value -> Parser [UserContractState]
parseJSON :: Value -> Parser UserContractState
$cparseJSON :: Value -> Parser UserContractState
FromJSON, [UserContractState] -> Encoding
[UserContractState] -> Value
UserContractState -> Encoding
UserContractState -> Value
(UserContractState -> Value)
-> (UserContractState -> Encoding)
-> ([UserContractState] -> Value)
-> ([UserContractState] -> Encoding)
-> ToJSON UserContractState
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserContractState] -> Encoding
$ctoEncodingList :: [UserContractState] -> Encoding
toJSONList :: [UserContractState] -> Value
$ctoJSONList :: [UserContractState] -> Value
toEncoding :: UserContractState -> Encoding
$ctoEncoding :: UserContractState -> Encoding
toJSON :: UserContractState -> Value
$ctoJSON :: UserContractState -> Value
ToJSON)


uniswapTokenName, poolStateTokenName :: TokenName
uniswapTokenName :: TokenName
uniswapTokenName = TokenName
"Uniswap"
poolStateTokenName :: TokenName
poolStateTokenName = TokenName
"Pool State"

uniswapInstance :: Uniswap -> V2.TypedValidator Uniswapping
uniswapInstance :: Uniswap -> TypedValidator Uniswapping
uniswapInstance Uniswap
us = CompiledCode (ValidatorType Uniswapping)
-> CompiledCode (ValidatorType Uniswapping -> UntypedValidator)
-> TypedValidator Uniswapping
forall a.
CompiledCode (ValidatorType a)
-> CompiledCode (ValidatorType a -> UntypedValidator)
-> TypedValidator a
V2.mkTypedValidator @Uniswapping
    ($$(PlutusTx.compile [|| mkUniswapValidator ||])
        CompiledCode
  (Uniswap
   -> Coin PoolState
   -> UniswapDatum
   -> UniswapAction
   -> ScriptContext
   -> Bool)
-> CompiledCodeIn DefaultUni DefaultFun Uniswap
-> CompiledCodeIn
     DefaultUni
     DefaultFun
     (Coin PoolState
      -> UniswapDatum -> UniswapAction -> ScriptContext -> Bool)
forall (uni :: * -> *) fun a b.
(Closed uni, Everywhere uni Flat, Flat fun,
 Everywhere uni PrettyConst, GShow uni, Pretty fun) =>
CompiledCodeIn uni fun (a -> b)
-> CompiledCodeIn uni fun a -> CompiledCodeIn uni fun b
`PlutusTx.applyCode` Uniswap -> CompiledCodeIn DefaultUni DefaultFun Uniswap
forall (uni :: * -> *) a fun.
(Lift uni a, Throwable uni fun, Typecheckable uni fun) =>
a -> CompiledCodeIn uni fun a
PlutusTx.liftCode Uniswap
us
        CompiledCodeIn
  DefaultUni
  DefaultFun
  (Coin PoolState
   -> UniswapDatum -> UniswapAction -> ScriptContext -> Bool)
-> CompiledCodeIn DefaultUni DefaultFun (Coin PoolState)
-> CompiledCodeIn
     DefaultUni
     DefaultFun
     (UniswapDatum -> UniswapAction -> ScriptContext -> Bool)
forall (uni :: * -> *) fun a b.
(Closed uni, Everywhere uni Flat, Flat fun,
 Everywhere uni PrettyConst, GShow uni, Pretty fun) =>
CompiledCodeIn uni fun (a -> b)
-> CompiledCodeIn uni fun a -> CompiledCodeIn uni fun b
`PlutusTx.applyCode` Coin PoolState
-> CompiledCodeIn DefaultUni DefaultFun (Coin PoolState)
forall (uni :: * -> *) a fun.
(Lift uni a, Throwable uni fun, Typecheckable uni fun) =>
a -> CompiledCodeIn uni fun a
PlutusTx.liftCode Coin PoolState
c)
     $$(PlutusTx.compile [|| wrap ||])
  where
    c :: Coin PoolState
    c :: Coin PoolState
c = Uniswap -> Coin PoolState
poolStateCoin Uniswap
us

    wrap :: (UniswapDatum -> UniswapAction -> ScriptContext -> Bool)
-> UntypedValidator
wrap = (UnsafeFromData UniswapDatum, UnsafeFromData UniswapAction) =>
(UniswapDatum -> UniswapAction -> ScriptContext -> Bool)
-> UntypedValidator
forall sc d r.
(IsScriptContext sc, UnsafeFromData d, UnsafeFromData r) =>
(d -> r -> sc -> Bool) -> UntypedValidator
Scripts.mkUntypedValidator @Scripts.ScriptContextV2 @UniswapDatum @UniswapAction

uniswapScript :: Uniswap -> Validator
uniswapScript :: Uniswap -> Validator
uniswapScript = TypedValidator Uniswapping -> Validator
forall a. TypedValidator a -> Validator
Scripts.validatorScript (TypedValidator Uniswapping -> Validator)
-> (Uniswap -> TypedValidator Uniswapping) -> Uniswap -> Validator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uniswap -> TypedValidator Uniswapping
uniswapInstance

uniswapAddress :: Uniswap -> CardanoAddress
uniswapAddress :: Uniswap -> CardanoAddress
uniswapAddress = NetworkId -> Validator -> CardanoAddress
mkValidatorCardanoAddress NetworkId
testnet (Validator -> CardanoAddress)
-> (Uniswap -> Validator) -> Uniswap -> CardanoAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uniswap -> Validator
uniswapScript

uniswap :: CurrencySymbol -> Uniswap
uniswap :: CurrencySymbol -> Uniswap
uniswap CurrencySymbol
cs = Coin U -> Uniswap
Uniswap (Coin U -> Uniswap) -> Coin U -> Uniswap
forall a b. (a -> b) -> a -> b
$ CurrencySymbol -> TokenName -> Coin U
forall a. CurrencySymbol -> TokenName -> Coin a
mkCoin CurrencySymbol
cs TokenName
uniswapTokenName

liquidityPolicy :: Uniswap -> MintingPolicy
liquidityPolicy :: Uniswap -> MintingPolicy
liquidityPolicy Uniswap
us = CompiledCode (BuiltinData -> BuiltinData -> ()) -> MintingPolicy
V2.mkMintingPolicyScript (CompiledCode (BuiltinData -> BuiltinData -> ()) -> MintingPolicy)
-> CompiledCode (BuiltinData -> BuiltinData -> ()) -> MintingPolicy
forall a b. (a -> b) -> a -> b
$
    $$(PlutusTx.compile [|| \u t -> Scripts.mkUntypedMintingPolicy (validateLiquidityMinting u t) ||])
        CompiledCode
  (Uniswap -> TokenName -> BuiltinData -> BuiltinData -> ())
-> CompiledCodeIn DefaultUni DefaultFun Uniswap
-> CompiledCodeIn
     DefaultUni
     DefaultFun
     (TokenName -> BuiltinData -> BuiltinData -> ())
forall (uni :: * -> *) fun a b.
(Closed uni, Everywhere uni Flat, Flat fun,
 Everywhere uni PrettyConst, GShow uni, Pretty fun) =>
CompiledCodeIn uni fun (a -> b)
-> CompiledCodeIn uni fun a -> CompiledCodeIn uni fun b
`PlutusTx.applyCode` Uniswap -> CompiledCodeIn DefaultUni DefaultFun Uniswap
forall (uni :: * -> *) a fun.
(Lift uni a, Throwable uni fun, Typecheckable uni fun) =>
a -> CompiledCodeIn uni fun a
PlutusTx.liftCode Uniswap
us
        CompiledCodeIn
  DefaultUni
  DefaultFun
  (TokenName -> BuiltinData -> BuiltinData -> ())
-> CompiledCodeIn DefaultUni DefaultFun TokenName
-> CompiledCode (BuiltinData -> BuiltinData -> ())
forall (uni :: * -> *) fun a b.
(Closed uni, Everywhere uni Flat, Flat fun,
 Everywhere uni PrettyConst, GShow uni, Pretty fun) =>
CompiledCodeIn uni fun (a -> b)
-> CompiledCodeIn uni fun a -> CompiledCodeIn uni fun b
`PlutusTx.applyCode` TokenName -> CompiledCodeIn DefaultUni DefaultFun TokenName
forall (uni :: * -> *) a fun.
(Lift uni a, Throwable uni fun, Typecheckable uni fun) =>
a -> CompiledCodeIn uni fun a
PlutusTx.liftCode TokenName
poolStateTokenName

covIdx :: CoverageIndex
covIdx :: CoverageIndex
covIdx = Int
String
String -> Int -> CoverageIndex -> CoverageIndex
CompiledCodeIn
  DefaultUni
  DefaultFun
  (Uniswap
   -> Coin PoolState
   -> UniswapDatum
   -> UniswapAction
   -> ScriptContext
   -> ())
-> CoverageIndex
(CoverageIndex -> CoverageIndex)
-> (CompiledCodeIn
      DefaultUni
      DefaultFun
      (Uniswap
       -> Coin PoolState
       -> UniswapDatum
       -> UniswapAction
       -> ScriptContext
       -> ())
    -> CoverageIndex)
-> CompiledCodeIn
     DefaultUni
     DefaultFun
     (Uniswap
      -> Coin PoolState
      -> UniswapDatum
      -> UniswapAction
      -> ScriptContext
      -> ())
-> CoverageIndex
forall a. CompiledCodeIn DefaultUni DefaultFun a -> CoverageIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
unsafeIgnoreLocationInCoverageIndex :: String -> Int -> CoverageIndex -> CoverageIndex
computeRefinedCoverageIndex :: forall a. CompiledCodeIn DefaultUni DefaultFun a -> CoverageIndex
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$refinedCoverageIndex $$(PlutusTx.compile [|| \u s r d c -> check $ mkUniswapValidator u s r d c ||])

liquidityCurrency :: Uniswap -> CurrencySymbol
liquidityCurrency :: Uniswap -> CurrencySymbol
liquidityCurrency = MintingPolicy -> CurrencySymbol
scriptCurrencySymbol (MintingPolicy -> CurrencySymbol)
-> (Uniswap -> MintingPolicy) -> Uniswap -> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uniswap -> MintingPolicy
liquidityPolicy

poolStateCoin :: Uniswap -> Coin PoolState
poolStateCoin :: Uniswap -> Coin PoolState
poolStateCoin = (CurrencySymbol -> TokenName -> Coin PoolState)
-> TokenName -> CurrencySymbol -> Coin PoolState
forall a b c. (a -> b -> c) -> b -> a -> c
flip CurrencySymbol -> TokenName -> Coin PoolState
forall a. CurrencySymbol -> TokenName -> Coin a
mkCoin TokenName
poolStateTokenName (CurrencySymbol -> Coin PoolState)
-> (Uniswap -> CurrencySymbol) -> Uniswap -> Coin PoolState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uniswap -> CurrencySymbol
liquidityCurrency

-- | Gets the 'Coin' used to identity liquidity pools.
poolStateCoinFromUniswapCurrency :: CurrencySymbol -- ^ The currency identifying the Uniswap instance.
                                 -> Coin PoolState
poolStateCoinFromUniswapCurrency :: CurrencySymbol -> Coin PoolState
poolStateCoinFromUniswapCurrency = Uniswap -> Coin PoolState
poolStateCoin (Uniswap -> Coin PoolState)
-> (CurrencySymbol -> Uniswap) -> CurrencySymbol -> Coin PoolState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> Uniswap
uniswap

-- | Gets the liquidity token for a given liquidity pool.
liquidityCoin :: CurrencySymbol -- ^ The currency identifying the Uniswap instance.
              -> Coin A         -- ^ One coin in the liquidity pair.
              -> Coin B         -- ^ The other coin in the liquidity pair.
              -> Coin Liquidity
liquidityCoin :: CurrencySymbol -> Coin A -> Coin B -> Coin Liquidity
liquidityCoin CurrencySymbol
cs Coin A
coinA Coin B
coinB = CurrencySymbol -> TokenName -> Coin Liquidity
forall a. CurrencySymbol -> TokenName -> Coin a
mkCoin (Uniswap -> CurrencySymbol
liquidityCurrency (Uniswap -> CurrencySymbol) -> Uniswap -> CurrencySymbol
forall a b. (a -> b) -> a -> b
$ CurrencySymbol -> Uniswap
uniswap CurrencySymbol
cs) (TokenName -> Coin Liquidity) -> TokenName -> Coin Liquidity
forall a b. (a -> b) -> a -> b
$ LiquidityPool -> TokenName
lpTicker (LiquidityPool -> TokenName) -> LiquidityPool -> TokenName
forall a b. (a -> b) -> a -> b
$ Coin A -> Coin B -> LiquidityPool
LiquidityPool Coin A
coinA Coin B
coinB

-- | Parameters for the @create@-endpoint, which creates a new liquidity pool.
data CreateParams = CreateParams
    { CreateParams -> Coin A
cpCoinA   :: Coin A   -- ^ One 'Coin' of the liquidity pair.
    , CreateParams -> Coin B
cpCoinB   :: Coin B   -- ^ The other 'Coin'.
    , CreateParams -> Amount A
cpAmountA :: Amount A -- ^ Amount of liquidity for the first 'Coin'.
    , CreateParams -> Amount B
cpAmountB :: Amount B -- ^ Amount of liquidity for the second 'Coin'.
    } deriving (Int -> CreateParams -> ShowS
[CreateParams] -> ShowS
CreateParams -> String
(Int -> CreateParams -> ShowS)
-> (CreateParams -> String)
-> ([CreateParams] -> ShowS)
-> Show CreateParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateParams] -> ShowS
$cshowList :: [CreateParams] -> ShowS
show :: CreateParams -> String
$cshow :: CreateParams -> String
showsPrec :: Int -> CreateParams -> ShowS
$cshowsPrec :: Int -> CreateParams -> ShowS
Show, (forall x. CreateParams -> Rep CreateParams x)
-> (forall x. Rep CreateParams x -> CreateParams)
-> Generic CreateParams
forall x. Rep CreateParams x -> CreateParams
forall x. CreateParams -> Rep CreateParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateParams x -> CreateParams
$cfrom :: forall x. CreateParams -> Rep CreateParams x
Generic, [CreateParams] -> Encoding
[CreateParams] -> Value
CreateParams -> Encoding
CreateParams -> Value
(CreateParams -> Value)
-> (CreateParams -> Encoding)
-> ([CreateParams] -> Value)
-> ([CreateParams] -> Encoding)
-> ToJSON CreateParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CreateParams] -> Encoding
$ctoEncodingList :: [CreateParams] -> Encoding
toJSONList :: [CreateParams] -> Value
$ctoJSONList :: [CreateParams] -> Value
toEncoding :: CreateParams -> Encoding
$ctoEncoding :: CreateParams -> Encoding
toJSON :: CreateParams -> Value
$ctoJSON :: CreateParams -> Value
ToJSON, Value -> Parser [CreateParams]
Value -> Parser CreateParams
(Value -> Parser CreateParams)
-> (Value -> Parser [CreateParams]) -> FromJSON CreateParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CreateParams]
$cparseJSONList :: Value -> Parser [CreateParams]
parseJSON :: Value -> Parser CreateParams
$cparseJSON :: Value -> Parser CreateParams
FromJSON)

-- | Parameters for the @swap@-endpoint, which allows swaps between the two different coins in a liquidity pool.
-- One of the provided amounts must be positive, the other must be zero.
data SwapParams = SwapParams
    { SwapParams -> Coin A
spCoinA   :: Coin A         -- ^ One 'Coin' of the liquidity pair.
    , SwapParams -> Coin B
spCoinB   :: Coin B         -- ^ The other 'Coin'.
    , SwapParams -> Amount A
spAmountA :: Amount A       -- ^ The amount the first 'Coin' that should be swapped.
    , SwapParams -> Amount B
spAmountB :: Amount B       -- ^ The amount of the second 'Coin' that should be swapped.
    } deriving (Int -> SwapParams -> ShowS
[SwapParams] -> ShowS
SwapParams -> String
(Int -> SwapParams -> ShowS)
-> (SwapParams -> String)
-> ([SwapParams] -> ShowS)
-> Show SwapParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwapParams] -> ShowS
$cshowList :: [SwapParams] -> ShowS
show :: SwapParams -> String
$cshow :: SwapParams -> String
showsPrec :: Int -> SwapParams -> ShowS
$cshowsPrec :: Int -> SwapParams -> ShowS
Show, (forall x. SwapParams -> Rep SwapParams x)
-> (forall x. Rep SwapParams x -> SwapParams) -> Generic SwapParams
forall x. Rep SwapParams x -> SwapParams
forall x. SwapParams -> Rep SwapParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SwapParams x -> SwapParams
$cfrom :: forall x. SwapParams -> Rep SwapParams x
Generic, [SwapParams] -> Encoding
[SwapParams] -> Value
SwapParams -> Encoding
SwapParams -> Value
(SwapParams -> Value)
-> (SwapParams -> Encoding)
-> ([SwapParams] -> Value)
-> ([SwapParams] -> Encoding)
-> ToJSON SwapParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SwapParams] -> Encoding
$ctoEncodingList :: [SwapParams] -> Encoding
toJSONList :: [SwapParams] -> Value
$ctoJSONList :: [SwapParams] -> Value
toEncoding :: SwapParams -> Encoding
$ctoEncoding :: SwapParams -> Encoding
toJSON :: SwapParams -> Value
$ctoJSON :: SwapParams -> Value
ToJSON, Value -> Parser [SwapParams]
Value -> Parser SwapParams
(Value -> Parser SwapParams)
-> (Value -> Parser [SwapParams]) -> FromJSON SwapParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SwapParams]
$cparseJSONList :: Value -> Parser [SwapParams]
parseJSON :: Value -> Parser SwapParams
$cparseJSON :: Value -> Parser SwapParams
FromJSON)

-- | Parameters for the @close@-endpoint, which closes a liquidity pool.
data CloseParams = CloseParams
    { CloseParams -> Coin A
clpCoinA :: Coin A         -- ^ One 'Coin' of the liquidity pair.
    , CloseParams -> Coin B
clpCoinB :: Coin B         -- ^ The other 'Coin' of the liquidity pair.
    } deriving (Int -> CloseParams -> ShowS
[CloseParams] -> ShowS
CloseParams -> String
(Int -> CloseParams -> ShowS)
-> (CloseParams -> String)
-> ([CloseParams] -> ShowS)
-> Show CloseParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CloseParams] -> ShowS
$cshowList :: [CloseParams] -> ShowS
show :: CloseParams -> String
$cshow :: CloseParams -> String
showsPrec :: Int -> CloseParams -> ShowS
$cshowsPrec :: Int -> CloseParams -> ShowS
Show, (forall x. CloseParams -> Rep CloseParams x)
-> (forall x. Rep CloseParams x -> CloseParams)
-> Generic CloseParams
forall x. Rep CloseParams x -> CloseParams
forall x. CloseParams -> Rep CloseParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CloseParams x -> CloseParams
$cfrom :: forall x. CloseParams -> Rep CloseParams x
Generic, [CloseParams] -> Encoding
[CloseParams] -> Value
CloseParams -> Encoding
CloseParams -> Value
(CloseParams -> Value)
-> (CloseParams -> Encoding)
-> ([CloseParams] -> Value)
-> ([CloseParams] -> Encoding)
-> ToJSON CloseParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CloseParams] -> Encoding
$ctoEncodingList :: [CloseParams] -> Encoding
toJSONList :: [CloseParams] -> Value
$ctoJSONList :: [CloseParams] -> Value
toEncoding :: CloseParams -> Encoding
$ctoEncoding :: CloseParams -> Encoding
toJSON :: CloseParams -> Value
$ctoJSON :: CloseParams -> Value
ToJSON, Value -> Parser [CloseParams]
Value -> Parser CloseParams
(Value -> Parser CloseParams)
-> (Value -> Parser [CloseParams]) -> FromJSON CloseParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CloseParams]
$cparseJSONList :: Value -> Parser [CloseParams]
parseJSON :: Value -> Parser CloseParams
$cparseJSON :: Value -> Parser CloseParams
FromJSON)

-- | Parameters for the @remove@-endpoint, which removes some liquidity from a liquidity pool.
data RemoveParams = RemoveParams
    { RemoveParams -> Coin A
rpCoinA :: Coin A           -- ^ One 'Coin' of the liquidity pair.
    , RemoveParams -> Coin B
rpCoinB :: Coin B           -- ^ The other 'Coin' of the liquidity pair.
    , RemoveParams -> Amount Liquidity
rpDiff  :: Amount Liquidity -- ^ The amount of liquidity tokens to burn in exchange for liquidity from the pool.
    } deriving (Int -> RemoveParams -> ShowS
[RemoveParams] -> ShowS
RemoveParams -> String
(Int -> RemoveParams -> ShowS)
-> (RemoveParams -> String)
-> ([RemoveParams] -> ShowS)
-> Show RemoveParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveParams] -> ShowS
$cshowList :: [RemoveParams] -> ShowS
show :: RemoveParams -> String
$cshow :: RemoveParams -> String
showsPrec :: Int -> RemoveParams -> ShowS
$cshowsPrec :: Int -> RemoveParams -> ShowS
Show, (forall x. RemoveParams -> Rep RemoveParams x)
-> (forall x. Rep RemoveParams x -> RemoveParams)
-> Generic RemoveParams
forall x. Rep RemoveParams x -> RemoveParams
forall x. RemoveParams -> Rep RemoveParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoveParams x -> RemoveParams
$cfrom :: forall x. RemoveParams -> Rep RemoveParams x
Generic, [RemoveParams] -> Encoding
[RemoveParams] -> Value
RemoveParams -> Encoding
RemoveParams -> Value
(RemoveParams -> Value)
-> (RemoveParams -> Encoding)
-> ([RemoveParams] -> Value)
-> ([RemoveParams] -> Encoding)
-> ToJSON RemoveParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RemoveParams] -> Encoding
$ctoEncodingList :: [RemoveParams] -> Encoding
toJSONList :: [RemoveParams] -> Value
$ctoJSONList :: [RemoveParams] -> Value
toEncoding :: RemoveParams -> Encoding
$ctoEncoding :: RemoveParams -> Encoding
toJSON :: RemoveParams -> Value
$ctoJSON :: RemoveParams -> Value
ToJSON, Value -> Parser [RemoveParams]
Value -> Parser RemoveParams
(Value -> Parser RemoveParams)
-> (Value -> Parser [RemoveParams]) -> FromJSON RemoveParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RemoveParams]
$cparseJSONList :: Value -> Parser [RemoveParams]
parseJSON :: Value -> Parser RemoveParams
$cparseJSON :: Value -> Parser RemoveParams
FromJSON)

-- | Parameters for the @add@-endpoint, which adds liquidity to a liquidity pool in exchange for liquidity tokens.
data AddParams = AddParams
    { AddParams -> Coin A
apCoinA   :: Coin A         -- ^ One 'Coin' of the liquidity pair.
    , AddParams -> Coin B
apCoinB   :: Coin B         -- ^ The other 'Coin' of the liquidity pair.
    , AddParams -> Amount A
apAmountA :: Amount A       -- ^ The amount of coins of the first kind to add to the pool.
    , AddParams -> Amount B
apAmountB :: Amount B       -- ^ The amount of coins of the second kind to add to the pool.
    } deriving (Int -> AddParams -> ShowS
[AddParams] -> ShowS
AddParams -> String
(Int -> AddParams -> ShowS)
-> (AddParams -> String)
-> ([AddParams] -> ShowS)
-> Show AddParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddParams] -> ShowS
$cshowList :: [AddParams] -> ShowS
show :: AddParams -> String
$cshow :: AddParams -> String
showsPrec :: Int -> AddParams -> ShowS
$cshowsPrec :: Int -> AddParams -> ShowS
Show, (forall x. AddParams -> Rep AddParams x)
-> (forall x. Rep AddParams x -> AddParams) -> Generic AddParams
forall x. Rep AddParams x -> AddParams
forall x. AddParams -> Rep AddParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddParams x -> AddParams
$cfrom :: forall x. AddParams -> Rep AddParams x
Generic, [AddParams] -> Encoding
[AddParams] -> Value
AddParams -> Encoding
AddParams -> Value
(AddParams -> Value)
-> (AddParams -> Encoding)
-> ([AddParams] -> Value)
-> ([AddParams] -> Encoding)
-> ToJSON AddParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AddParams] -> Encoding
$ctoEncodingList :: [AddParams] -> Encoding
toJSONList :: [AddParams] -> Value
$ctoJSONList :: [AddParams] -> Value
toEncoding :: AddParams -> Encoding
$ctoEncoding :: AddParams -> Encoding
toJSON :: AddParams -> Value
$ctoJSON :: AddParams -> Value
ToJSON, Value -> Parser [AddParams]
Value -> Parser AddParams
(Value -> Parser AddParams)
-> (Value -> Parser [AddParams]) -> FromJSON AddParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AddParams]
$cparseJSONList :: Value -> Parser [AddParams]
parseJSON :: Value -> Parser AddParams
$cparseJSON :: Value -> Parser AddParams
FromJSON)

-- | Creates a Uniswap "factory". This factory will keep track of the existing liquidity pools and enforce that there will be at most one liquidity pool
-- for any pair of tokens at any given time.
start :: forall w s. Contract w s Text Uniswap
start :: Contract w s Text Uniswap
start = do
    CardanoAddress
addr <- Contract w s Text CardanoAddress
forall w (s :: Row *) e.
AsContractError e =>
Contract w s e CardanoAddress
Contract.ownAddress
    CurrencySymbol
cs  <- (OneShotCurrency -> CurrencySymbol)
-> Contract w s Text OneShotCurrency
-> Contract w s Text CurrencySymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OneShotCurrency -> CurrencySymbol
Currency.currencySymbol (Contract w s Text OneShotCurrency
 -> Contract w s Text CurrencySymbol)
-> Contract w s Text OneShotCurrency
-> Contract w s Text CurrencySymbol
forall a b. (a -> b) -> a -> b
$
           (CurrencyError -> Text)
-> Contract w s CurrencyError OneShotCurrency
-> Contract w s Text OneShotCurrency
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError (String -> Text
pack (String -> Text)
-> (CurrencyError -> String) -> CurrencyError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Show CurrencyError => CurrencyError -> String
forall a. Show a => a -> String
show @Currency.CurrencyError) (Contract w s CurrencyError OneShotCurrency
 -> Contract w s Text OneShotCurrency)
-> Contract w s CurrencyError OneShotCurrency
-> Contract w s Text OneShotCurrency
forall a b. (a -> b) -> a -> b
$
           CardanoAddress
-> [(TokenName, Integer)]
-> Contract w s CurrencyError OneShotCurrency
forall w (s :: Row *) e.
AsCurrencyError e =>
CardanoAddress
-> [(TokenName, Integer)] -> Contract w s e OneShotCurrency
Currency.mintContract CardanoAddress
addr [(TokenName
uniswapTokenName, Integer
1)]
    let c :: Coin Any
c    = CurrencySymbol -> TokenName -> Coin Any
forall a. CurrencySymbol -> TokenName -> Coin a
mkCoin CurrencySymbol
cs TokenName
uniswapTokenName
        us :: Uniswap
us   = CurrencySymbol -> Uniswap
uniswap CurrencySymbol
cs
        inst :: TypedValidator Uniswapping
inst = Uniswap -> TypedValidator Uniswapping
uniswapInstance Uniswap
us
        tx :: TxConstraints UniswapAction UniswapDatum
tx   = UniswapDatum -> Value -> TxConstraints UniswapAction UniswapDatum
forall o i. o -> Value -> TxConstraints i o
mustPayToTheScriptWithDatumInTx ([LiquidityPool] -> UniswapDatum
Factory []) (Value -> TxConstraints UniswapAction UniswapDatum)
-> Value -> TxConstraints UniswapAction UniswapDatum
forall a b. (a -> b) -> a -> b
$ Coin Any -> Value
forall a. Coin a -> Value
unitValue Coin Any
c

    ScriptLookups Uniswapping
-> TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
-> Contract w s Text UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints (TypedValidator Uniswapping -> ScriptLookups Uniswapping
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator Uniswapping
inst) TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
TxConstraints UniswapAction UniswapDatum
tx
      Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text UnbalancedTx)
-> Contract w s Text UnbalancedTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text UnbalancedTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e UnbalancedTx
adjustUnbalancedTx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text ()) -> Contract w s Text ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text ()
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e ()
submitTxConfirmed
    Contract w s Text Slot -> Contract w s Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract w s Text Slot -> Contract w s Text ())
-> Contract w s Text Slot -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ Natural -> Contract w s Text Slot
forall w (s :: Row *) e.
AsContractError e =>
Natural -> Contract w s e Slot
waitNSlots Natural
1

    forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
forall w (s :: Row *) e.
ToJSON String =>
String -> Contract w s e ()
logInfo @String (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"started Uniswap %s at address %s" (Uniswap -> String
forall a. Show a => a -> String
show Uniswap
us) (CardanoAddress -> String
forall a. Show a => a -> String
show (CardanoAddress -> String) -> CardanoAddress -> String
forall a b. (a -> b) -> a -> b
$ Uniswap -> CardanoAddress
uniswapAddress Uniswap
us)
    Uniswap -> Contract w s Text Uniswap
forall (m :: * -> *) a. Monad m => a -> m a
return Uniswap
us

-- | Creates a liquidity pool for a pair of coins. The creator provides liquidity for both coins and gets liquidity tokens in return.
create :: forall w s. Uniswap -> CreateParams -> Contract w s Text ()
create :: Uniswap -> CreateParams -> Contract w s Text ()
create Uniswap
us CreateParams{Coin A
Coin B
Amount A
Amount B
cpAmountB :: Amount B
cpAmountA :: Amount A
cpCoinB :: Coin B
cpCoinA :: Coin A
cpAmountB :: CreateParams -> Amount B
cpAmountA :: CreateParams -> Amount A
cpCoinB :: CreateParams -> Coin B
cpCoinA :: CreateParams -> Coin A
..} = do
    Bool -> Contract w s Text () -> Contract w s Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Coin A -> AssetClass
forall a. Coin a -> AssetClass
unCoin Coin A
cpCoinA AssetClass -> AssetClass -> Bool
forall a. Eq a => a -> a -> Bool
== Coin B -> AssetClass
forall a. Coin a -> AssetClass
unCoin Coin B
cpCoinB) (Contract w s Text () -> Contract w s Text ())
-> Contract w s Text () -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Contract w s Text ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"coins must be different"
    Bool -> Contract w s Text () -> Contract w s Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Amount A
cpAmountA Amount A -> Amount A -> Bool
forall a. Ord a => a -> a -> Bool
<= Amount A
0 Bool -> Bool -> Bool
|| Amount B
cpAmountB Amount B -> Amount B -> Bool
forall a. Ord a => a -> a -> Bool
<= Amount B
0) (Contract w s Text () -> Contract w s Text ())
-> Contract w s Text () -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Contract w s Text ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"amounts must be positive"
    (TxOutRef
oref, DecoratedTxOut
o, [LiquidityPool]
lps) <- Uniswap
-> Contract w s Text (TxOutRef, DecoratedTxOut, [LiquidityPool])
forall w (s :: Row *).
Uniswap
-> Contract w s Text (TxOutRef, DecoratedTxOut, [LiquidityPool])
findUniswapFactory Uniswap
us
    let liquidity :: Amount Liquidity
liquidity = Amount A -> Amount B -> Amount Liquidity
calculateInitialLiquidity Amount A
cpAmountA Amount B
cpAmountB
        lp :: LiquidityPool
lp        = LiquidityPool :: Coin A -> Coin B -> LiquidityPool
LiquidityPool {lpCoinA :: Coin A
lpCoinA = Coin A
cpCoinA, lpCoinB :: Coin B
lpCoinB = Coin B
cpCoinB}
    let usInst :: TypedValidator Uniswapping
usInst   = Uniswap -> TypedValidator Uniswapping
uniswapInstance Uniswap
us
        usScript :: Validator
usScript = Uniswap -> Validator
uniswapScript Uniswap
us
        usDat1 :: UniswapDatum
usDat1   = [LiquidityPool] -> UniswapDatum
Factory ([LiquidityPool] -> UniswapDatum)
-> [LiquidityPool] -> UniswapDatum
forall a b. (a -> b) -> a -> b
$ LiquidityPool
lp LiquidityPool -> [LiquidityPool] -> [LiquidityPool]
forall a. a -> [a] -> [a]
: [LiquidityPool]
lps
        usDat2 :: UniswapDatum
usDat2   = LiquidityPool -> Amount Liquidity -> UniswapDatum
Pool LiquidityPool
lp Amount Liquidity
liquidity
        psC :: Coin PoolState
psC      = Uniswap -> Coin PoolState
poolStateCoin Uniswap
us
        lC :: Coin Liquidity
lC       = CurrencySymbol -> TokenName -> Coin Liquidity
forall a. CurrencySymbol -> TokenName -> Coin a
mkCoin (Uniswap -> CurrencySymbol
liquidityCurrency Uniswap
us) (TokenName -> Coin Liquidity) -> TokenName -> Coin Liquidity
forall a b. (a -> b) -> a -> b
$ LiquidityPool -> TokenName
lpTicker LiquidityPool
lp
        usVal :: Value
usVal    = Coin U -> Value
forall a. Coin a -> Value
unitValue (Coin U -> Value) -> Coin U -> Value
forall a b. (a -> b) -> a -> b
$ Uniswap -> Coin U
usCoin Uniswap
us
        lpVal :: Value
lpVal    = Coin A -> Amount A -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin A
cpCoinA Amount A
cpAmountA Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Coin B -> Amount B -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin B
cpCoinB Amount B
cpAmountB Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Coin PoolState -> Value
forall a. Coin a -> Value
unitValue Coin PoolState
psC

        lookups :: ScriptLookups Uniswapping
lookups  = TypedValidator Uniswapping -> ScriptLookups Uniswapping
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator Uniswapping
usInst        ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   Validator -> ScriptLookups Uniswapping
forall a. Validator -> ScriptLookups a
Constraints.plutusV2OtherScript Validator
usScript                ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   MintingPolicy -> ScriptLookups Uniswapping
forall a. MintingPolicy -> ScriptLookups a
Constraints.plutusV2MintingPolicy (Uniswap -> MintingPolicy
liquidityPolicy Uniswap
us) ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   Map TxOutRef DecoratedTxOut -> ScriptLookups Uniswapping
forall a. Map TxOutRef DecoratedTxOut -> ScriptLookups a
Constraints.unspentOutputs (TxOutRef -> DecoratedTxOut -> Map TxOutRef DecoratedTxOut
forall k a. k -> a -> Map k a
Map.singleton TxOutRef
oref DecoratedTxOut
o)

        tx :: TxConstraints UniswapAction UniswapDatum
tx       = UniswapDatum -> Value -> TxConstraints UniswapAction UniswapDatum
forall o i. o -> Value -> TxConstraints i o
Constraints.mustPayToTheScriptWithDatumInTx UniswapDatum
usDat1 Value
usVal                                     TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   UniswapDatum -> Value -> TxConstraints UniswapAction UniswapDatum
forall o i. o -> Value -> TxConstraints i o
Constraints.mustPayToTheScriptWithDatumInTx UniswapDatum
usDat2 Value
lpVal                                     TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   Value -> TxConstraints UniswapAction UniswapDatum
forall i o. Value -> TxConstraints i o
Constraints.mustMintValue (Coin PoolState -> Value
forall a. Coin a -> Value
unitValue Coin PoolState
psC Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Coin Liquidity -> Amount Liquidity -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin Liquidity
lC Amount Liquidity
liquidity)              TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   TxOutRef -> Redeemer -> TxConstraints UniswapAction UniswapDatum
forall i o. TxOutRef -> Redeemer -> TxConstraints i o
Constraints.mustSpendScriptOutput TxOutRef
oref (BuiltinData -> Redeemer
Redeemer (BuiltinData -> Redeemer) -> BuiltinData -> Redeemer
forall a b. (a -> b) -> a -> b
$ UniswapAction -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData (UniswapAction -> BuiltinData) -> UniswapAction -> BuiltinData
forall a b. (a -> b) -> a -> b
$ LiquidityPool -> UniswapAction
Create LiquidityPool
lp)

    ScriptLookups Uniswapping
-> TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
-> Contract w s Text UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints ScriptLookups Uniswapping
lookups TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
TxConstraints UniswapAction UniswapDatum
tx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text UnbalancedTx)
-> Contract w s Text UnbalancedTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text UnbalancedTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e UnbalancedTx
adjustUnbalancedTx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text ()) -> Contract w s Text ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text ()
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e ()
submitTxConfirmed

    String -> Contract w s Text ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String
"created liquidity pool: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LiquidityPool -> String
forall a. Show a => a -> String
show LiquidityPool
lp

-- | Closes a liquidity pool by burning all remaining liquidity tokens in exchange for all liquidity remaining in the pool.
close :: forall w s. Uniswap -> CloseParams -> Contract w s Text ()
close :: Uniswap -> CloseParams -> Contract w s Text ()
close Uniswap
us CloseParams{Coin A
Coin B
clpCoinB :: Coin B
clpCoinA :: Coin A
clpCoinB :: CloseParams -> Coin B
clpCoinA :: CloseParams -> Coin A
..} = do
    ((TxOutRef
oref1, DecoratedTxOut
o1, [LiquidityPool]
lps), (TxOutRef
oref2, DecoratedTxOut
o2, LiquidityPool
lp, Amount Liquidity
liquidity)) <- Uniswap
-> Coin A
-> Coin B
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
forall w (s :: Row *).
Uniswap
-> Coin A
-> Coin B
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
findUniswapFactoryAndPool Uniswap
us Coin A
clpCoinA Coin B
clpCoinB
    let usInst :: TypedValidator Uniswapping
usInst   = Uniswap -> TypedValidator Uniswapping
uniswapInstance Uniswap
us
        usScript :: Validator
usScript = Uniswap -> Validator
uniswapScript Uniswap
us
        usDat :: UniswapDatum
usDat    = [LiquidityPool] -> UniswapDatum
Factory ([LiquidityPool] -> UniswapDatum)
-> [LiquidityPool] -> UniswapDatum
forall a b. (a -> b) -> a -> b
$ (LiquidityPool -> Bool) -> [LiquidityPool] -> [LiquidityPool]
forall a. (a -> Bool) -> [a] -> [a]
filter (LiquidityPool -> LiquidityPool -> Bool
forall a. Eq a => a -> a -> Bool
/= LiquidityPool
lp) [LiquidityPool]
lps
        usC :: Coin U
usC      = Uniswap -> Coin U
usCoin Uniswap
us
        psC :: Coin PoolState
psC      = Uniswap -> Coin PoolState
poolStateCoin Uniswap
us
        lC :: Coin Liquidity
lC       = CurrencySymbol -> TokenName -> Coin Liquidity
forall a. CurrencySymbol -> TokenName -> Coin a
mkCoin (Uniswap -> CurrencySymbol
liquidityCurrency Uniswap
us) (TokenName -> Coin Liquidity) -> TokenName -> Coin Liquidity
forall a b. (a -> b) -> a -> b
$ LiquidityPool -> TokenName
lpTicker LiquidityPool
lp
        usVal :: Value
usVal    = Coin U -> Value
forall a. Coin a -> Value
unitValue Coin U
usC
        psVal :: Value
psVal    = Coin PoolState -> Value
forall a. Coin a -> Value
unitValue Coin PoolState
psC
        lVal :: Value
lVal     = Coin Liquidity -> Amount Liquidity -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin Liquidity
lC Amount Liquidity
liquidity
        redeemer :: Redeemer
redeemer = BuiltinData -> Redeemer
Redeemer (BuiltinData -> Redeemer) -> BuiltinData -> Redeemer
forall a b. (a -> b) -> a -> b
$ UniswapAction -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData UniswapAction
Close

        lookups :: ScriptLookups Uniswapping
lookups  = TypedValidator Uniswapping -> ScriptLookups Uniswapping
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator Uniswapping
usInst        ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   Validator -> ScriptLookups Uniswapping
forall a. Validator -> ScriptLookups a
Constraints.plutusV2OtherScript Validator
usScript                ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   MintingPolicy -> ScriptLookups Uniswapping
forall a. MintingPolicy -> ScriptLookups a
Constraints.plutusV2MintingPolicy (Uniswap -> MintingPolicy
liquidityPolicy Uniswap
us) ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   Map TxOutRef DecoratedTxOut -> ScriptLookups Uniswapping
forall a. Map TxOutRef DecoratedTxOut -> ScriptLookups a
Constraints.unspentOutputs (TxOutRef -> DecoratedTxOut -> Map TxOutRef DecoratedTxOut
forall k a. k -> a -> Map k a
Map.singleton TxOutRef
oref1 DecoratedTxOut
o1 Map TxOutRef DecoratedTxOut
-> Map TxOutRef DecoratedTxOut -> Map TxOutRef DecoratedTxOut
forall a. Semigroup a => a -> a -> a
<> TxOutRef -> DecoratedTxOut -> Map TxOutRef DecoratedTxOut
forall k a. k -> a -> Map k a
Map.singleton TxOutRef
oref2 DecoratedTxOut
o2)

        tx :: TxConstraints UniswapAction UniswapDatum
tx       = UniswapDatum -> Value -> TxConstraints UniswapAction UniswapDatum
forall o i. o -> Value -> TxConstraints i o
Constraints.mustPayToTheScriptWithDatumInTx UniswapDatum
usDat Value
usVal TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   Value -> TxConstraints UniswapAction UniswapDatum
forall i o. Value -> TxConstraints i o
Constraints.mustMintValue (Value -> Value
forall a. AdditiveGroup a => a -> a
negate (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Value
psVal Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
lVal) TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   TxOutRef -> Redeemer -> TxConstraints UniswapAction UniswapDatum
forall i o. TxOutRef -> Redeemer -> TxConstraints i o
Constraints.mustSpendScriptOutput TxOutRef
oref1 Redeemer
redeemer TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   TxOutRef -> Redeemer -> TxConstraints UniswapAction UniswapDatum
forall i o. TxOutRef -> Redeemer -> TxConstraints i o
Constraints.mustSpendScriptOutput TxOutRef
oref2 Redeemer
redeemer TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   Datum -> TxConstraints UniswapAction UniswapDatum
forall i o. Datum -> TxConstraints i o
Constraints.mustIncludeDatumInTx (BuiltinData -> Datum
Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ UniswapDatum -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData (UniswapDatum -> BuiltinData) -> UniswapDatum -> BuiltinData
forall a b. (a -> b) -> a -> b
$ LiquidityPool -> Amount Liquidity -> UniswapDatum
Pool LiquidityPool
lp Amount Liquidity
liquidity)

    ScriptLookups Uniswapping
-> TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
-> Contract w s Text UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints ScriptLookups Uniswapping
lookups TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
TxConstraints UniswapAction UniswapDatum
tx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text UnbalancedTx)
-> Contract w s Text UnbalancedTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text UnbalancedTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e UnbalancedTx
adjustUnbalancedTx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text ()) -> Contract w s Text ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text ()
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e ()
submitTxConfirmed

    String -> Contract w s Text ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String
"closed liquidity pool: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LiquidityPool -> String
forall a. Show a => a -> String
show LiquidityPool
lp

-- | Removes some liquidity from a liquidity pool in exchange for liquidity tokens.
remove :: forall w s. Uniswap -> RemoveParams -> Contract w s Text ()
remove :: Uniswap -> RemoveParams -> Contract w s Text ()
remove Uniswap
us RemoveParams{Coin A
Coin B
Amount Liquidity
rpDiff :: Amount Liquidity
rpCoinB :: Coin B
rpCoinA :: Coin A
rpDiff :: RemoveParams -> Amount Liquidity
rpCoinB :: RemoveParams -> Coin B
rpCoinA :: RemoveParams -> Coin A
..} = do
    ((TxOutRef, DecoratedTxOut, [LiquidityPool])
_, (TxOutRef
oref, DecoratedTxOut
o, LiquidityPool
lp, Amount Liquidity
liquidity)) <- Uniswap
-> Coin A
-> Coin B
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
forall w (s :: Row *).
Uniswap
-> Coin A
-> Coin B
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
findUniswapFactoryAndPool Uniswap
us Coin A
rpCoinA Coin B
rpCoinB
    Bool -> Contract w s Text () -> Contract w s Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Amount Liquidity
rpDiff Amount Liquidity -> Amount Liquidity -> Bool
forall a. Ord a => a -> a -> Bool
< Amount Liquidity
1 Bool -> Bool -> Bool
|| Amount Liquidity
rpDiff Amount Liquidity -> Amount Liquidity -> Bool
forall a. Ord a => a -> a -> Bool
>= Amount Liquidity
liquidity) (Contract w s Text () -> Contract w s Text ())
-> Contract w s Text () -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Contract w s Text ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"removed liquidity must be positive and less than total liquidity"
    let usInst :: TypedValidator Uniswapping
usInst       = Uniswap -> TypedValidator Uniswapping
uniswapInstance Uniswap
us
        usScript :: Validator
usScript     = Uniswap -> Validator
uniswapScript Uniswap
us
        dat :: UniswapDatum
dat          = LiquidityPool -> Amount Liquidity -> UniswapDatum
Pool LiquidityPool
lp (Amount Liquidity -> UniswapDatum)
-> Amount Liquidity -> UniswapDatum
forall a b. (a -> b) -> a -> b
$ Amount Liquidity
liquidity Amount Liquidity -> Amount Liquidity -> Amount Liquidity
forall a. AdditiveGroup a => a -> a -> a
- Amount Liquidity
rpDiff
        psC :: Coin PoolState
psC          = Uniswap -> Coin PoolState
poolStateCoin Uniswap
us
        lC :: Coin Liquidity
lC           = CurrencySymbol -> TokenName -> Coin Liquidity
forall a. CurrencySymbol -> TokenName -> Coin a
mkCoin (Uniswap -> CurrencySymbol
liquidityCurrency Uniswap
us) (TokenName -> Coin Liquidity) -> TokenName -> Coin Liquidity
forall a b. (a -> b) -> a -> b
$ LiquidityPool -> TokenName
lpTicker LiquidityPool
lp
        psVal :: Value
psVal        = Coin PoolState -> Value
forall a. Coin a -> Value
unitValue Coin PoolState
psC
        lVal :: Value
lVal         = Coin Liquidity -> Amount Liquidity -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin Liquidity
lC Amount Liquidity
rpDiff
        inVal :: Value
inVal        = DecoratedTxOut -> Value
decoratedTxOutPlutusValue DecoratedTxOut
o
        inA :: Amount A
inA          = Value -> Coin A -> Amount A
forall a. Value -> Coin a -> Amount a
amountOf Value
inVal Coin A
rpCoinA
        inB :: Amount B
inB          = Value -> Coin B -> Amount B
forall a. Value -> Coin a -> Amount a
amountOf Value
inVal Coin B
rpCoinB
        (Amount A
outA, Amount B
outB) = Amount A
-> Amount B
-> Amount Liquidity
-> Amount Liquidity
-> (Amount A, Amount B)
calculateRemoval Amount A
inA Amount B
inB Amount Liquidity
liquidity Amount Liquidity
rpDiff
        val :: Value
val          = Value
psVal Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Coin A -> Amount A -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin A
rpCoinA Amount A
outA Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Coin B -> Amount B -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin B
rpCoinB Amount B
outB
        redeemer :: Redeemer
redeemer     = BuiltinData -> Redeemer
Redeemer (BuiltinData -> Redeemer) -> BuiltinData -> Redeemer
forall a b. (a -> b) -> a -> b
$ UniswapAction -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData UniswapAction
Remove

        lookups :: ScriptLookups Uniswapping
lookups  = TypedValidator Uniswapping -> ScriptLookups Uniswapping
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator Uniswapping
usInst          ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   Validator -> ScriptLookups Uniswapping
forall a. Validator -> ScriptLookups a
Constraints.plutusV2OtherScript Validator
usScript                  ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   MintingPolicy -> ScriptLookups Uniswapping
forall a. MintingPolicy -> ScriptLookups a
Constraints.plutusV2MintingPolicy (Uniswap -> MintingPolicy
liquidityPolicy Uniswap
us)   ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   Map TxOutRef DecoratedTxOut -> ScriptLookups Uniswapping
forall a. Map TxOutRef DecoratedTxOut -> ScriptLookups a
Constraints.unspentOutputs (TxOutRef -> DecoratedTxOut -> Map TxOutRef DecoratedTxOut
forall k a. k -> a -> Map k a
Map.singleton TxOutRef
oref DecoratedTxOut
o)

        tx :: TxConstraints UniswapAction UniswapDatum
tx       = UniswapDatum -> Value -> TxConstraints UniswapAction UniswapDatum
forall o i. o -> Value -> TxConstraints i o
Constraints.mustPayToTheScriptWithDatumInTx UniswapDatum
dat Value
val          TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   Value -> TxConstraints UniswapAction UniswapDatum
forall i o. Value -> TxConstraints i o
Constraints.mustMintValue (Value -> Value
forall a. AdditiveGroup a => a -> a
negate Value
lVal)        TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   TxOutRef -> Redeemer -> TxConstraints UniswapAction UniswapDatum
forall i o. TxOutRef -> Redeemer -> TxConstraints i o
Constraints.mustSpendScriptOutput TxOutRef
oref Redeemer
redeemer

    ScriptLookups Uniswapping
-> TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
-> Contract w s Text UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints ScriptLookups Uniswapping
lookups TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
TxConstraints UniswapAction UniswapDatum
tx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text UnbalancedTx)
-> Contract w s Text UnbalancedTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text UnbalancedTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e UnbalancedTx
adjustUnbalancedTx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text ()) -> Contract w s Text ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text ()
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e ()
submitTxConfirmed

    String -> Contract w s Text ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String
"removed liquidity from pool: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LiquidityPool -> String
forall a. Show a => a -> String
show LiquidityPool
lp

-- | Adds some liquidity to an existing liquidity pool in exchange for newly minted liquidity tokens.
add :: forall w s. Uniswap -> AddParams -> Contract w s Text ()
add :: Uniswap -> AddParams -> Contract w s Text ()
add Uniswap
us AddParams{Coin A
Coin B
Amount A
Amount B
apAmountB :: Amount B
apAmountA :: Amount A
apCoinB :: Coin B
apCoinA :: Coin A
apAmountB :: AddParams -> Amount B
apAmountA :: AddParams -> Amount A
apCoinB :: AddParams -> Coin B
apCoinA :: AddParams -> Coin A
..} = do
    ((TxOutRef, DecoratedTxOut, [LiquidityPool])
_, (TxOutRef
oref, DecoratedTxOut
o, LiquidityPool
lp, Amount Liquidity
liquidity)) <- Uniswap
-> Coin A
-> Coin B
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
forall w (s :: Row *).
Uniswap
-> Coin A
-> Coin B
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
findUniswapFactoryAndPool Uniswap
us Coin A
apCoinA Coin B
apCoinB
    Bool -> Contract w s Text () -> Contract w s Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Amount A
apAmountA Amount A -> Amount A -> Bool
forall a. Ord a => a -> a -> Bool
< Amount A
0 Bool -> Bool -> Bool
|| Amount B
apAmountB Amount B -> Amount B -> Bool
forall a. Ord a => a -> a -> Bool
< Amount B
0) (Contract w s Text () -> Contract w s Text ())
-> Contract w s Text () -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Contract w s Text ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"amounts must not be negative"
    let outVal :: Value
outVal = DecoratedTxOut -> Value
decoratedTxOutPlutusValue DecoratedTxOut
o
        oldA :: Amount A
oldA   = Value -> Coin A -> Amount A
forall a. Value -> Coin a -> Amount a
amountOf Value
outVal Coin A
apCoinA
        oldB :: Amount B
oldB   = Value -> Coin B -> Amount B
forall a. Value -> Coin a -> Amount a
amountOf Value
outVal Coin B
apCoinB
        newA :: Amount A
newA   = Amount A
oldA Amount A -> Amount A -> Amount A
forall a. AdditiveSemigroup a => a -> a -> a
+ Amount A
apAmountA
        newB :: Amount B
newB   = Amount B
oldB Amount B -> Amount B -> Amount B
forall a. AdditiveSemigroup a => a -> a -> a
+ Amount B
apAmountB
        delL :: Amount Liquidity
delL   = Amount A
-> Amount B
-> Amount Liquidity
-> Amount A
-> Amount B
-> Amount Liquidity
calculateAdditionalLiquidity Amount A
oldA Amount B
oldB Amount Liquidity
liquidity Amount A
apAmountA Amount B
apAmountB
        inVal :: Value
inVal  = Coin A -> Amount A -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin A
apCoinA Amount A
apAmountA Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Coin B -> Amount B -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin B
apCoinB Amount B
apAmountB
    Bool -> Contract w s Text () -> Contract w s Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Amount Liquidity
delL Amount Liquidity -> Amount Liquidity -> Bool
forall a. Ord a => a -> a -> Bool
<= Amount Liquidity
0) (Contract w s Text () -> Contract w s Text ())
-> Contract w s Text () -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Contract w s Text ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"insufficient liquidity"
    forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
forall w (s :: Row *) e.
ToJSON String =>
String -> Contract w s e ()
logInfo @String (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String
-> Amount A
-> Amount B
-> Amount A
-> Amount B
-> Amount Liquidity
-> String
forall r. PrintfType r => String -> r
printf String
"oldA = %d, oldB = %d, newA = %d, newB = %d, delL = %d" Amount A
oldA Amount B
oldB Amount A
newA Amount B
newB Amount Liquidity
delL

    let usInst :: TypedValidator Uniswapping
usInst       = Uniswap -> TypedValidator Uniswapping
uniswapInstance Uniswap
us
        usScript :: Validator
usScript     = Uniswap -> Validator
uniswapScript Uniswap
us
        dat :: UniswapDatum
dat          = LiquidityPool -> Amount Liquidity -> UniswapDatum
Pool LiquidityPool
lp (Amount Liquidity -> UniswapDatum)
-> Amount Liquidity -> UniswapDatum
forall a b. (a -> b) -> a -> b
$ Amount Liquidity
liquidity Amount Liquidity -> Amount Liquidity -> Amount Liquidity
forall a. AdditiveSemigroup a => a -> a -> a
+ Amount Liquidity
delL
        psC :: Coin PoolState
psC          = Uniswap -> Coin PoolState
poolStateCoin Uniswap
us
        lC :: Coin Liquidity
lC           = CurrencySymbol -> TokenName -> Coin Liquidity
forall a. CurrencySymbol -> TokenName -> Coin a
mkCoin (Uniswap -> CurrencySymbol
liquidityCurrency Uniswap
us) (TokenName -> Coin Liquidity) -> TokenName -> Coin Liquidity
forall a b. (a -> b) -> a -> b
$ LiquidityPool -> TokenName
lpTicker LiquidityPool
lp
        psVal :: Value
psVal        = Coin PoolState -> Value
forall a. Coin a -> Value
unitValue Coin PoolState
psC
        lVal :: Value
lVal         = Coin Liquidity -> Amount Liquidity -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin Liquidity
lC Amount Liquidity
delL
        val :: Value
val          = Value
psVal Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Coin A -> Amount A -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin A
apCoinA Amount A
newA Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Coin B -> Amount B -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin B
apCoinB Amount B
newB
        redeemer :: Redeemer
redeemer     = BuiltinData -> Redeemer
Redeemer (BuiltinData -> Redeemer) -> BuiltinData -> Redeemer
forall a b. (a -> b) -> a -> b
$ UniswapAction -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData UniswapAction
Add

        lookups :: ScriptLookups Uniswapping
lookups  = TypedValidator Uniswapping -> ScriptLookups Uniswapping
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator Uniswapping
usInst             ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   Validator -> ScriptLookups Uniswapping
forall a. Validator -> ScriptLookups a
Constraints.plutusV2OtherScript Validator
usScript                     ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   MintingPolicy -> ScriptLookups Uniswapping
forall a. MintingPolicy -> ScriptLookups a
Constraints.plutusV2MintingPolicy (Uniswap -> MintingPolicy
liquidityPolicy Uniswap
us)       ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                   Map TxOutRef DecoratedTxOut -> ScriptLookups Uniswapping
forall a. Map TxOutRef DecoratedTxOut -> ScriptLookups a
Constraints.unspentOutputs (TxOutRef -> DecoratedTxOut -> Map TxOutRef DecoratedTxOut
forall k a. k -> a -> Map k a
Map.singleton TxOutRef
oref DecoratedTxOut
o)

        tx :: TxConstraints UniswapAction UniswapDatum
tx       = UniswapDatum -> Value -> TxConstraints UniswapAction UniswapDatum
forall o i. o -> Value -> TxConstraints i o
Constraints.mustPayToTheScriptWithDatumInTx UniswapDatum
dat Value
val          TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   Value -> TxConstraints UniswapAction UniswapDatum
forall i o. Value -> TxConstraints i o
Constraints.mustMintValue Value
lVal                  TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                   TxOutRef -> Redeemer -> TxConstraints UniswapAction UniswapDatum
forall i o. TxOutRef -> Redeemer -> TxConstraints i o
Constraints.mustSpendScriptOutput TxOutRef
oref Redeemer
redeemer

    forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
forall w (s :: Row *) e.
ToJSON String =>
String -> Contract w s e ()
logInfo @String (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"val = %s, inVal = %s" (Value -> String
forall a. Show a => a -> String
show Value
val) (Value -> String
forall a. Show a => a -> String
show Value
inVal)
    String -> Contract w s Text ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ ScriptLookups Uniswapping -> String
forall a. Show a => a -> String
show ScriptLookups Uniswapping
lookups
    String -> Contract w s Text ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ TxConstraints UniswapAction UniswapDatum -> String
forall a. Show a => a -> String
show TxConstraints UniswapAction UniswapDatum
tx

    ScriptLookups Uniswapping
-> TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
-> Contract w s Text UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints ScriptLookups Uniswapping
lookups TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
TxConstraints UniswapAction UniswapDatum
tx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text UnbalancedTx)
-> Contract w s Text UnbalancedTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text UnbalancedTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e UnbalancedTx
adjustUnbalancedTx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text ()) -> Contract w s Text ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text ()
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e ()
submitTxConfirmed

    String -> Contract w s Text ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String
"added liquidity to pool: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LiquidityPool -> String
forall a. Show a => a -> String
show LiquidityPool
lp

-- | Uses a liquidity pool two swap one sort of coins in the pool against the other.
swap :: forall w s. Uniswap -> SwapParams -> Contract w s Text ()
swap :: Uniswap -> SwapParams -> Contract w s Text ()
swap Uniswap
us SwapParams{Coin A
Coin B
Amount A
Amount B
spAmountB :: Amount B
spAmountA :: Amount A
spCoinB :: Coin B
spCoinA :: Coin A
spAmountB :: SwapParams -> Amount B
spAmountA :: SwapParams -> Amount A
spCoinB :: SwapParams -> Coin B
spCoinA :: SwapParams -> Coin A
..} = do
    Bool -> Contract w s Text () -> Contract w s Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Amount A
spAmountA Amount A -> Amount A -> Bool
forall a. Ord a => a -> a -> Bool
> Amount A
0 Bool -> Bool -> Bool
&& Amount B
spAmountB Amount B -> Amount B -> Bool
forall a. Eq a => a -> a -> Bool
== Amount B
0 Bool -> Bool -> Bool
|| Amount A
spAmountA Amount A -> Amount A -> Bool
forall a. Eq a => a -> a -> Bool
== Amount A
0 Bool -> Bool -> Bool
&& Amount B
spAmountB Amount B -> Amount B -> Bool
forall a. Ord a => a -> a -> Bool
> Amount B
0) (Contract w s Text () -> Contract w s Text ())
-> Contract w s Text () -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Contract w s Text ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"exactly one amount must be positive"
    ((TxOutRef, DecoratedTxOut, [LiquidityPool])
_, (TxOutRef
oref, DecoratedTxOut
o, LiquidityPool
lp, Amount Liquidity
liquidity)) <- Uniswap
-> Coin A
-> Coin B
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
forall w (s :: Row *).
Uniswap
-> Coin A
-> Coin B
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
findUniswapFactoryAndPool Uniswap
us Coin A
spCoinA Coin B
spCoinB
    let outVal :: Value
outVal = DecoratedTxOut -> Value
decoratedTxOutPlutusValue DecoratedTxOut
o
    let oldA :: Amount A
oldA = Value -> Coin A -> Amount A
forall a. Value -> Coin a -> Amount a
amountOf Value
outVal Coin A
spCoinA
        oldB :: Amount B
oldB = Value -> Coin B -> Amount B
forall a. Value -> Coin a -> Amount a
amountOf Value
outVal Coin B
spCoinB
    (Amount A
newA, Amount B
newB) <- if Amount A
spAmountA Amount A -> Amount A -> Bool
forall a. Ord a => a -> a -> Bool
> Amount A
0 then do
        let outB :: Amount B
outB = Integer -> Amount B
forall a. Integer -> Amount a
Amount (Integer -> Amount B) -> Integer -> Amount B
forall a b. (a -> b) -> a -> b
$ Amount A -> Amount B -> Amount A -> Integer
findSwapA Amount A
oldA Amount B
oldB Amount A
spAmountA
        Bool -> Contract w s Text () -> Contract w s Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Amount B
outB Amount B -> Amount B -> Bool
forall a. Eq a => a -> a -> Bool
== Amount B
0) (Contract w s Text () -> Contract w s Text ())
-> Contract w s Text () -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Contract w s Text ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no payout"
        (Amount A, Amount B) -> Contract w s Text (Amount A, Amount B)
forall (m :: * -> *) a. Monad m => a -> m a
return (Amount A
oldA Amount A -> Amount A -> Amount A
forall a. AdditiveSemigroup a => a -> a -> a
+ Amount A
spAmountA, Amount B
oldB Amount B -> Amount B -> Amount B
forall a. AdditiveGroup a => a -> a -> a
- Amount B
outB)
                                     else do
        let outA :: Amount A
outA = Integer -> Amount A
forall a. Integer -> Amount a
Amount (Integer -> Amount A) -> Integer -> Amount A
forall a b. (a -> b) -> a -> b
$ Amount A -> Amount B -> Amount B -> Integer
findSwapB Amount A
oldA Amount B
oldB Amount B
spAmountB
        Bool -> Contract w s Text () -> Contract w s Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Amount A
outA Amount A -> Amount A -> Bool
forall a. Eq a => a -> a -> Bool
== Amount A
0) (Contract w s Text () -> Contract w s Text ())
-> Contract w s Text () -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Contract w s Text ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no payout"
        (Amount A, Amount B) -> Contract w s Text (Amount A, Amount B)
forall (m :: * -> *) a. Monad m => a -> m a
return (Amount A
oldA Amount A -> Amount A -> Amount A
forall a. AdditiveGroup a => a -> a -> a
- Amount A
outA, Amount B
oldB Amount B -> Amount B -> Amount B
forall a. AdditiveSemigroup a => a -> a -> a
+ Amount B
spAmountB)

    forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
forall w (s :: Row *) e.
ToJSON String =>
String -> Contract w s e ()
logInfo @String (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String
-> Amount A
-> Amount B
-> Integer
-> Amount A
-> Amount B
-> Integer
-> String
forall r. PrintfType r => String -> r
printf String
"oldA = %d, oldB = %d, old product = %d, newA = %d, newB = %d, new product = %d" Amount A
oldA Amount B
oldB (Amount A -> Integer
forall a. Amount a -> Integer
unAmount Amount A
oldA Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
* Amount B -> Integer
forall a. Amount a -> Integer
unAmount Amount B
oldB) Amount A
newA Amount B
newB (Amount A -> Integer
forall a. Amount a -> Integer
unAmount Amount A
newA Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
* Amount B -> Integer
forall a. Amount a -> Integer
unAmount Amount B
newB)

    let inst :: TypedValidator Uniswapping
inst    = Uniswap -> TypedValidator Uniswapping
uniswapInstance Uniswap
us
        val :: Value
val     = Coin A -> Amount A -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin A
spCoinA Amount A
newA Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Coin B -> Amount B -> Value
forall a. Coin a -> Amount a -> Value
valueOf Coin B
spCoinB Amount B
newB Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Coin PoolState -> Value
forall a. Coin a -> Value
unitValue (Uniswap -> Coin PoolState
poolStateCoin Uniswap
us)

        lookups :: ScriptLookups Uniswapping
lookups = TypedValidator Uniswapping -> ScriptLookups Uniswapping
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator Uniswapping
inst                 ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                  Validator -> ScriptLookups Uniswapping
forall a. Validator -> ScriptLookups a
Constraints.plutusV2OtherScript (TypedValidator Uniswapping -> Validator
forall a. TypedValidator a -> Validator
Scripts.validatorScript TypedValidator Uniswapping
inst) ScriptLookups Uniswapping
-> ScriptLookups Uniswapping -> ScriptLookups Uniswapping
forall a. Semigroup a => a -> a -> a
<>
                  Map TxOutRef DecoratedTxOut -> ScriptLookups Uniswapping
forall a. Map TxOutRef DecoratedTxOut -> ScriptLookups a
Constraints.unspentOutputs (TxOutRef -> DecoratedTxOut -> Map TxOutRef DecoratedTxOut
forall k a. k -> a -> Map k a
Map.singleton TxOutRef
oref DecoratedTxOut
o)

        tx :: TxConstraints UniswapAction UniswapDatum
tx      = TxOutRef -> Redeemer -> TxConstraints UniswapAction UniswapDatum
forall i o. TxOutRef -> Redeemer -> TxConstraints i o
mustSpendScriptOutput TxOutRef
oref (BuiltinData -> Redeemer
Redeemer (BuiltinData -> Redeemer) -> BuiltinData -> Redeemer
forall a b. (a -> b) -> a -> b
$ UniswapAction -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData UniswapAction
Swap) TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
-> TxConstraints UniswapAction UniswapDatum
forall a. Semigroup a => a -> a -> a
<>
                  UniswapDatum -> Value -> TxConstraints UniswapAction UniswapDatum
forall o i. o -> Value -> TxConstraints i o
Constraints.mustPayToTheScriptWithDatumInTx (LiquidityPool -> Amount Liquidity -> UniswapDatum
Pool LiquidityPool
lp Amount Liquidity
liquidity) Value
val

    ScriptLookups Uniswapping
-> TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
-> Contract w s Text UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints ScriptLookups Uniswapping
lookups TxConstraints (RedeemerType Uniswapping) (DatumType Uniswapping)
TxConstraints UniswapAction UniswapDatum
tx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text UnbalancedTx)
-> Contract w s Text UnbalancedTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text UnbalancedTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e UnbalancedTx
adjustUnbalancedTx Contract w s Text UnbalancedTx
-> (UnbalancedTx -> Contract w s Text ()) -> Contract w s Text ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s Text ()
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e ()
submitTxConfirmed

    String -> Contract w s Text ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String
"swapped with: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LiquidityPool -> String
forall a. Show a => a -> String
show LiquidityPool
lp

-- | Finds all liquidity pools and their liquidity belonging to the Uniswap instance.
-- This merely inspects the blockchain and does not issue any transactions.
pools :: forall w s. Uniswap -> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
pools :: Uniswap
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
pools Uniswap
us = do
    Map TxOutRef DecoratedTxOut
utxos <- CardanoAddress -> Contract w s Text (Map TxOutRef DecoratedTxOut)
forall w (s :: Row *) e.
AsContractError e =>
CardanoAddress -> Contract w s e (Map TxOutRef DecoratedTxOut)
utxosAt (Uniswap -> CardanoAddress
uniswapAddress Uniswap
us)
    [DecoratedTxOut]
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
go ([DecoratedTxOut]
 -> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))])
-> [DecoratedTxOut]
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
forall a b. (a -> b) -> a -> b
$ (TxOutRef, DecoratedTxOut) -> DecoratedTxOut
forall a b. (a, b) -> b
snd ((TxOutRef, DecoratedTxOut) -> DecoratedTxOut)
-> [(TxOutRef, DecoratedTxOut)] -> [DecoratedTxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxOutRef DecoratedTxOut -> [(TxOutRef, DecoratedTxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxOutRef DecoratedTxOut
utxos
  where
    go :: [DecoratedTxOut] -> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
    go :: [DecoratedTxOut]
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
go []       = [((Coin A, Amount A), (Coin B, Amount B))]
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    go (DecoratedTxOut
o : [DecoratedTxOut]
os) = do
        let v :: Value
v = DecoratedTxOut -> Value
decoratedTxOutPlutusValue DecoratedTxOut
o
        if Value -> Coin PoolState -> Bool
forall a. Value -> Coin a -> Bool
isUnity Value
v Coin PoolState
c
            then do
                UniswapDatum
d <- DecoratedTxOut -> Contract w s Text UniswapDatum
forall w (s :: Row *).
DecoratedTxOut -> Contract w s Text UniswapDatum
getUniswapDatum DecoratedTxOut
o
                case UniswapDatum
d of
                    Factory [LiquidityPool]
_ -> [DecoratedTxOut]
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
go [DecoratedTxOut]
os
                    Pool LiquidityPool
lp Amount Liquidity
_ -> do
                        let coinA :: Coin A
coinA = LiquidityPool -> Coin A
lpCoinA LiquidityPool
lp
                            coinB :: Coin B
coinB = LiquidityPool -> Coin B
lpCoinB LiquidityPool
lp
                            amtA :: Amount A
amtA  = Value -> Coin A -> Amount A
forall a. Value -> Coin a -> Amount a
amountOf Value
v Coin A
coinA
                            amtB :: Amount B
amtB  = Value -> Coin B -> Amount B
forall a. Value -> Coin a -> Amount a
amountOf Value
v Coin B
coinB
                            s :: ((Coin A, Amount A), (Coin B, Amount B))
s     = ((Coin A
coinA, Amount A
amtA), (Coin B
coinB, Amount B
amtB))
                        String -> Contract w s Text ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String
"found pool: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((Coin A, Amount A), (Coin B, Amount B)) -> String
forall a. Show a => a -> String
show ((Coin A, Amount A), (Coin B, Amount B))
s
                        [((Coin A, Amount A), (Coin B, Amount B))]
ss <- [DecoratedTxOut]
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
go [DecoratedTxOut]
os
                        [((Coin A, Amount A), (Coin B, Amount B))]
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([((Coin A, Amount A), (Coin B, Amount B))]
 -> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))])
-> [((Coin A, Amount A), (Coin B, Amount B))]
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
forall a b. (a -> b) -> a -> b
$ ((Coin A, Amount A), (Coin B, Amount B))
s ((Coin A, Amount A), (Coin B, Amount B))
-> [((Coin A, Amount A), (Coin B, Amount B))]
-> [((Coin A, Amount A), (Coin B, Amount B))]
forall a. a -> [a] -> [a]
: [((Coin A, Amount A), (Coin B, Amount B))]
ss
            else [DecoratedTxOut]
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
go [DecoratedTxOut]
os
      where
        c :: Coin PoolState
        c :: Coin PoolState
c = Uniswap -> Coin PoolState
poolStateCoin Uniswap
us

-- | Gets the caller's funds.
funds :: forall w s. Contract w s Text Value
funds :: Contract w s Text Value
funds = do
    CardanoAddress
addr <- Contract w s Text CardanoAddress
forall w (s :: Row *) e.
AsContractError e =>
Contract w s e CardanoAddress
Contract.ownAddress
    [DecoratedTxOut]
os   <- ((TxOutRef, DecoratedTxOut) -> DecoratedTxOut)
-> [(TxOutRef, DecoratedTxOut)] -> [DecoratedTxOut]
forall a b. (a -> b) -> [a] -> [b]
map (TxOutRef, DecoratedTxOut) -> DecoratedTxOut
forall a b. (a, b) -> b
snd ([(TxOutRef, DecoratedTxOut)] -> [DecoratedTxOut])
-> (Map TxOutRef DecoratedTxOut -> [(TxOutRef, DecoratedTxOut)])
-> Map TxOutRef DecoratedTxOut
-> [DecoratedTxOut]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef DecoratedTxOut -> [(TxOutRef, DecoratedTxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxOutRef DecoratedTxOut -> [DecoratedTxOut])
-> Contract w s Text (Map TxOutRef DecoratedTxOut)
-> Contract w s Text [DecoratedTxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoAddress -> Contract w s Text (Map TxOutRef DecoratedTxOut)
forall w (s :: Row *) e.
AsContractError e =>
CardanoAddress -> Contract w s e (Map TxOutRef DecoratedTxOut)
utxosAt CardanoAddress
addr
    Value -> Contract w s Text Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Contract w s Text Value)
-> Value -> Contract w s Text Value
forall a b. (a -> b) -> a -> b
$ (DecoratedTxOut -> Value) -> [DecoratedTxOut] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DecoratedTxOut -> Value
decoratedTxOutPlutusValue [DecoratedTxOut]
os

getUniswapDatum :: DecoratedTxOut -> Contract w s Text UniswapDatum
getUniswapDatum :: DecoratedTxOut -> Contract w s Text UniswapDatum
getUniswapDatum DecoratedTxOut
o = do
  (DatumHash
dh, DatumFromQuery
d) <- Contract w s Text (DatumHash, DatumFromQuery)
-> ((DatumHash, DatumFromQuery)
    -> Contract w s Text (DatumHash, DatumFromQuery))
-> Maybe (DatumHash, DatumFromQuery)
-> Contract w s Text (DatumHash, DatumFromQuery)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
               (Text -> Contract w s Text (DatumHash, DatumFromQuery)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"no datum for a txout of a public key address")
               (DatumHash, DatumFromQuery)
-> Contract w s Text (DatumHash, DatumFromQuery)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (DecoratedTxOut
o DecoratedTxOut
-> Getting
     (First (DatumHash, DatumFromQuery))
     DecoratedTxOut
     (DatumHash, DatumFromQuery)
-> Maybe (DatumHash, DatumFromQuery)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (DatumHash, DatumFromQuery))
  DecoratedTxOut
  (DatumHash, DatumFromQuery)
Traversal' DecoratedTxOut (DatumHash, DatumFromQuery)
decoratedTxOutScriptDatum)
  Datum BuiltinData
e <- Contract w s Text Datum
-> (Datum -> Contract w s Text Datum)
-> Maybe Datum
-> Contract w s Text Datum
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DatumHash -> Contract w s Text Datum
forall w (s :: Row *). DatumHash -> Contract w s Text Datum
getDatum DatumHash
dh) Datum -> Contract w s Text Datum
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatumFromQuery
d DatumFromQuery
-> Getting (First Datum) DatumFromQuery Datum -> Maybe Datum
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Datum) DatumFromQuery Datum
Traversal' DatumFromQuery Datum
datumInDatumFromQuery)
  Contract w s Text UniswapDatum
-> (UniswapDatum -> Contract w s Text UniswapDatum)
-> Maybe UniswapDatum
-> Contract w s Text UniswapDatum
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Contract w s Text UniswapDatum
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"datum hash wrong type")
        UniswapDatum -> Contract w s Text UniswapDatum
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (BuiltinData -> Maybe UniswapDatum
forall a. FromData a => BuiltinData -> Maybe a
PlutusTx.fromBuiltinData BuiltinData
e)
  where
    getDatum :: DatumHash -> Contract w s Text Datum
    getDatum :: DatumHash -> Contract w s Text Datum
getDatum DatumHash
dh =
      DatumHash -> Contract w s Text (Maybe Datum)
forall w (s :: Row *) e.
AsContractError e =>
DatumHash -> Contract w s e (Maybe Datum)
datumFromHash DatumHash
dh Contract w s Text (Maybe Datum)
-> (Maybe Datum -> Contract w s Text Datum)
-> Contract w s Text Datum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case Maybe Datum
Nothing -> Text -> Contract w s Text Datum
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"datum not found"
                                 Just Datum
d  -> Datum -> Contract w s Text Datum
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datum
d

findUniswapInstance ::
    forall a b w s.
    Uniswap
    -> Coin b
    -> (UniswapDatum -> Maybe a)
    -> Contract w s Text (TxOutRef, DecoratedTxOut, a)
findUniswapInstance :: Uniswap
-> Coin b
-> (UniswapDatum -> Maybe a)
-> Contract w s Text (TxOutRef, DecoratedTxOut, a)
findUniswapInstance Uniswap
us Coin b
c UniswapDatum -> Maybe a
f = do
    let addr :: CardanoAddress
addr = Uniswap -> CardanoAddress
uniswapAddress Uniswap
us
    forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
forall w (s :: Row *) e.
ToJSON String =>
String -> Contract w s e ()
logInfo @String (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"looking for Uniswap instance at address %s containing coin %s " (CardanoAddress -> String
forall a. Show a => a -> String
show CardanoAddress
addr) (Coin b -> String
forall a. Show a => a -> String
show Coin b
c)
    Map TxOutRef DecoratedTxOut
utxos <- CardanoAddress -> Contract w s Text (Map TxOutRef DecoratedTxOut)
forall w (s :: Row *) e.
AsContractError e =>
CardanoAddress -> Contract w s e (Map TxOutRef DecoratedTxOut)
utxosAt CardanoAddress
addr
    [(TxOutRef, DecoratedTxOut)]
-> Contract w s Text (TxOutRef, DecoratedTxOut, a)
go  [(TxOutRef, DecoratedTxOut)
x | x :: (TxOutRef, DecoratedTxOut)
x@(TxOutRef
_, DecoratedTxOut
o) <- Map TxOutRef DecoratedTxOut -> [(TxOutRef, DecoratedTxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxOutRef DecoratedTxOut
utxos, Value -> Coin b -> Bool
forall a. Value -> Coin a -> Bool
isUnity (DecoratedTxOut -> Value
decoratedTxOutPlutusValue DecoratedTxOut
o) Coin b
c]
  where
    go :: [(TxOutRef, DecoratedTxOut)]
-> Contract w s Text (TxOutRef, DecoratedTxOut, a)
go [] = Text -> Contract w s Text (TxOutRef, DecoratedTxOut, a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"Uniswap instance not found"
    go ((TxOutRef
oref, DecoratedTxOut
o) : [(TxOutRef, DecoratedTxOut)]
xs) = do
        UniswapDatum
d <- DecoratedTxOut -> Contract w s Text UniswapDatum
forall w (s :: Row *).
DecoratedTxOut -> Contract w s Text UniswapDatum
getUniswapDatum DecoratedTxOut
o
        case UniswapDatum -> Maybe a
f UniswapDatum
d of
            Maybe a
Nothing -> [(TxOutRef, DecoratedTxOut)]
-> Contract w s Text (TxOutRef, DecoratedTxOut, a)
go [(TxOutRef, DecoratedTxOut)]
xs
            Just a
a  -> do
                forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
forall w (s :: Row *) e.
ToJSON String =>
String -> Contract w s e ()
logInfo @String (String -> Contract w s Text ()) -> String -> Contract w s Text ()
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall r. PrintfType r => String -> r
printf String
"found Uniswap instance with datum: %s" (UniswapDatum -> String
forall a. Show a => a -> String
show UniswapDatum
d)
                (TxOutRef, DecoratedTxOut, a)
-> Contract w s Text (TxOutRef, DecoratedTxOut, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxOutRef
oref, DecoratedTxOut
o, a
a)

findUniswapFactory :: forall w s. Uniswap -> Contract w s Text (TxOutRef, DecoratedTxOut, [LiquidityPool])
findUniswapFactory :: Uniswap
-> Contract w s Text (TxOutRef, DecoratedTxOut, [LiquidityPool])
findUniswapFactory us :: Uniswap
us@Uniswap{Coin U
usCoin :: Coin U
usCoin :: Uniswap -> Coin U
..} = Uniswap
-> Coin U
-> (UniswapDatum -> Maybe [LiquidityPool])
-> Contract w s Text (TxOutRef, DecoratedTxOut, [LiquidityPool])
forall a b w (s :: Row *).
Uniswap
-> Coin b
-> (UniswapDatum -> Maybe a)
-> Contract w s Text (TxOutRef, DecoratedTxOut, a)
findUniswapInstance Uniswap
us Coin U
usCoin ((UniswapDatum -> Maybe [LiquidityPool])
 -> Contract w s Text (TxOutRef, DecoratedTxOut, [LiquidityPool]))
-> (UniswapDatum -> Maybe [LiquidityPool])
-> Contract w s Text (TxOutRef, DecoratedTxOut, [LiquidityPool])
forall a b. (a -> b) -> a -> b
$ \case
    Factory [LiquidityPool]
lps -> [LiquidityPool] -> Maybe [LiquidityPool]
forall a. a -> Maybe a
Just [LiquidityPool]
lps
    Pool LiquidityPool
_ Amount Liquidity
_    -> Maybe [LiquidityPool]
forall a. Maybe a
Nothing

findUniswapPool :: forall w s. Uniswap -> LiquidityPool -> Contract w s Text (TxOutRef, DecoratedTxOut, Amount Liquidity)
findUniswapPool :: Uniswap
-> LiquidityPool
-> Contract w s Text (TxOutRef, DecoratedTxOut, Amount Liquidity)
findUniswapPool Uniswap
us LiquidityPool
lp = Uniswap
-> Coin PoolState
-> (UniswapDatum -> Maybe (Amount Liquidity))
-> Contract w s Text (TxOutRef, DecoratedTxOut, Amount Liquidity)
forall a b w (s :: Row *).
Uniswap
-> Coin b
-> (UniswapDatum -> Maybe a)
-> Contract w s Text (TxOutRef, DecoratedTxOut, a)
findUniswapInstance Uniswap
us (Uniswap -> Coin PoolState
poolStateCoin Uniswap
us) ((UniswapDatum -> Maybe (Amount Liquidity))
 -> Contract w s Text (TxOutRef, DecoratedTxOut, Amount Liquidity))
-> (UniswapDatum -> Maybe (Amount Liquidity))
-> Contract w s Text (TxOutRef, DecoratedTxOut, Amount Liquidity)
forall a b. (a -> b) -> a -> b
$ \case
        Pool LiquidityPool
lp' Amount Liquidity
l
            | LiquidityPool
lp LiquidityPool -> LiquidityPool -> Bool
forall a. Eq a => a -> a -> Bool
== LiquidityPool
lp' -> Amount Liquidity -> Maybe (Amount Liquidity)
forall a. a -> Maybe a
Just Amount Liquidity
l
        UniswapDatum
_               -> Maybe (Amount Liquidity)
forall a. Maybe a
Nothing

findUniswapFactoryAndPool :: forall w s.
                          Uniswap
                          -> Coin A
                          -> Coin B
                          -> Contract w s Text ( (TxOutRef, DecoratedTxOut, [LiquidityPool])
                                               , (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity)
                                               )
findUniswapFactoryAndPool :: Uniswap
-> Coin A
-> Coin B
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
findUniswapFactoryAndPool Uniswap
us Coin A
coinA Coin B
coinB = do
    (TxOutRef
oref1, DecoratedTxOut
o1, [LiquidityPool]
lps) <- Uniswap
-> Contract w s Text (TxOutRef, DecoratedTxOut, [LiquidityPool])
forall w (s :: Row *).
Uniswap
-> Contract w s Text (TxOutRef, DecoratedTxOut, [LiquidityPool])
findUniswapFactory Uniswap
us
    case [ LiquidityPool
lp'
         | LiquidityPool
lp' <- [LiquidityPool]
lps
         , LiquidityPool
lp' LiquidityPool -> LiquidityPool -> Bool
forall a. Eq a => a -> a -> Bool
== Coin A -> Coin B -> LiquidityPool
LiquidityPool Coin A
coinA Coin B
coinB
         ] of
        [LiquidityPool
lp] -> do
            (TxOutRef
oref2, DecoratedTxOut
o2, Amount Liquidity
a) <- Uniswap
-> LiquidityPool
-> Contract w s Text (TxOutRef, DecoratedTxOut, Amount Liquidity)
forall w (s :: Row *).
Uniswap
-> LiquidityPool
-> Contract w s Text (TxOutRef, DecoratedTxOut, Amount Liquidity)
findUniswapPool Uniswap
us LiquidityPool
lp
            ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
 (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
forall (m :: * -> *) a. Monad m => a -> m a
return ( (TxOutRef
oref1, DecoratedTxOut
o1, [LiquidityPool]
lps)
                   , (TxOutRef
oref2, DecoratedTxOut
o2, LiquidityPool
lp, Amount Liquidity
a)
                   )
        [LiquidityPool]
_    -> Text
-> Contract
     w
     s
     Text
     ((TxOutRef, DecoratedTxOut, [LiquidityPool]),
      (TxOutRef, DecoratedTxOut, LiquidityPool, Amount Liquidity))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"liquidity pool not found"

findSwapA :: Amount A -> Amount B -> Amount A -> Integer
findSwapA :: Amount A -> Amount B -> Amount A -> Integer
findSwapA Amount A
oldA Amount B
oldB Amount A
inA
    | Integer
ub' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
1   = Integer
0
    | Bool
otherwise  = Integer -> Integer -> Integer
go Integer
1 Integer
ub'
  where
    cs :: Integer -> Bool
    cs :: Integer -> Bool
cs Integer
outB = Amount A -> Amount B -> Amount A -> Amount B -> Bool
checkSwap Amount A
oldA Amount B
oldB (Amount A
oldA Amount A -> Amount A -> Amount A
forall a. AdditiveSemigroup a => a -> a -> a
+ Amount A
inA) (Amount B
oldB Amount B -> Amount B -> Amount B
forall a. AdditiveGroup a => a -> a -> a
- Integer -> Amount B
forall a. Integer -> Amount a
Amount Integer
outB)

    ub' :: Integer
    ub' :: Integer
ub' = [Integer] -> Integer
forall a. [a] -> a
head ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Integer -> Bool
cs [Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i | Int
i <- [Int
0 :: Int ..]]

    go :: Integer -> Integer -> Integer
    go :: Integer -> Integer -> Integer
go Integer
lb Integer
ub
        | Integer
ub Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer
lb Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
1) = Integer
lb
        | Bool
otherwise      =
      let
        m :: Integer
m = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
ub Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
lb) Integer
2
      in
        if Integer -> Bool
cs Integer
m then Integer -> Integer -> Integer
go Integer
m Integer
ub else Integer -> Integer -> Integer
go Integer
lb Integer
m

findSwapB :: Amount A -> Amount B -> Amount B -> Integer
findSwapB :: Amount A -> Amount B -> Amount B -> Integer
findSwapB Amount A
oldA Amount B
oldB Amount B
inB = Amount A -> Amount B -> Amount A -> Integer
findSwapA (Amount B -> Amount A
forall a a. Amount a -> Amount a
switch Amount B
oldB) (Amount A -> Amount B
forall a a. Amount a -> Amount a
switch Amount A
oldA) (Amount B -> Amount A
forall a a. Amount a -> Amount a
switch Amount B
inB)
  where
    switch :: Amount a -> Amount a
switch = Integer -> Amount a
forall a. Integer -> Amount a
Amount (Integer -> Amount a)
-> (Amount a -> Integer) -> Amount a -> Amount a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount a -> Integer
forall a. Amount a -> Integer
unAmount

ownerEndpoint :: Contract (Last (Either Text Uniswap)) EmptySchema ContractError ()
ownerEndpoint :: Contract (Last (Either Text Uniswap)) EmptySchema ContractError ()
ownerEndpoint = do
    Either Text Uniswap
e <- (Void -> ContractError)
-> Contract
     (Last (Either Text Uniswap)) EmptySchema Void (Either Text Uniswap)
-> Contract
     (Last (Either Text Uniswap))
     EmptySchema
     ContractError
     (Either Text Uniswap)
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError Void -> ContractError
forall a. Void -> a
absurd (Contract
   (Last (Either Text Uniswap)) EmptySchema Void (Either Text Uniswap)
 -> Contract
      (Last (Either Text Uniswap))
      EmptySchema
      ContractError
      (Either Text Uniswap))
-> Contract
     (Last (Either Text Uniswap)) EmptySchema Void (Either Text Uniswap)
-> Contract
     (Last (Either Text Uniswap))
     EmptySchema
     ContractError
     (Either Text Uniswap)
forall a b. (a -> b) -> a -> b
$ Contract (Last (Either Text Uniswap)) EmptySchema Text Uniswap
-> Contract
     (Last (Either Text Uniswap)) EmptySchema Void (Either Text Uniswap)
forall w (s :: Row *) e e0 a.
Contract w s e a -> Contract w s e0 (Either e a)
runError Contract (Last (Either Text Uniswap)) EmptySchema Text Uniswap
forall w (s :: Row *). Contract w s Text Uniswap
start
    Contract
  (Last (Either Text Uniswap)) EmptySchema ContractError Slot
-> Contract
     (Last (Either Text Uniswap)) EmptySchema ContractError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract
   (Last (Either Text Uniswap)) EmptySchema ContractError Slot
 -> Contract
      (Last (Either Text Uniswap)) EmptySchema ContractError ())
-> Contract
     (Last (Either Text Uniswap)) EmptySchema ContractError Slot
-> Contract
     (Last (Either Text Uniswap)) EmptySchema ContractError ()
forall a b. (a -> b) -> a -> b
$ Natural
-> Contract
     (Last (Either Text Uniswap)) EmptySchema ContractError Slot
forall w (s :: Row *) e.
AsContractError e =>
Natural -> Contract w s e Slot
waitNSlots Natural
1
    Last (Either Text Uniswap)
-> Contract
     (Last (Either Text Uniswap)) EmptySchema ContractError ()
forall w (s :: Row *) e. w -> Contract w s e ()
tell (Last (Either Text Uniswap)
 -> Contract
      (Last (Either Text Uniswap)) EmptySchema ContractError ())
-> Last (Either Text Uniswap)
-> Contract
     (Last (Either Text Uniswap)) EmptySchema ContractError ()
forall a b. (a -> b) -> a -> b
$ Maybe (Either Text Uniswap) -> Last (Either Text Uniswap)
forall a. Maybe a -> Last a
Last (Maybe (Either Text Uniswap) -> Last (Either Text Uniswap))
-> Maybe (Either Text Uniswap) -> Last (Either Text Uniswap)
forall a b. (a -> b) -> a -> b
$ Either Text Uniswap -> Maybe (Either Text Uniswap)
forall a. a -> Maybe a
Just Either Text Uniswap
e

-- | Provides the following endpoints for users of a Uniswap instance:
--
--      [@create@]: Creates a liquidity pool for a pair of coins. The creator provides liquidity for both coins and gets liquidity tokens in return.
--      [@swap@]: Uses a liquidity pool two swap one sort of coins in the pool against the other.
--      [@close@]: Closes a liquidity pool by burning all remaining liquidity tokens in exchange for all liquidity remaining in the pool.
--      [@remove@]: Removes some liquidity from a liquidity pool in exchange for liquidity tokens.
--      [@add@]: Adds some liquidity to an existing liquidity pool in exchange for newly minted liquidity tokens.
--      [@pools@]: Finds all liquidity pools and their liquidity belonging to the Uniswap instance. This merely inspects the blockchain and does not issue any transactions.
--      [@funds@]: Gets the caller's funds. This merely inspects the blockchain and does not issue any transactions.
--      [@stop@]: Stops the contract.
userEndpoints :: Uniswap -> Promise (Last (Either Text UserContractState)) UniswapUserSchema Void ()
userEndpoints :: Uniswap
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
userEndpoints Uniswap
us =
    Promise
  (Last (Either Text UserContractState)) UniswapUserSchema Void ()
Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
stop
        Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e a.
Promise w s e a -> Promise w s e a -> Promise w s e a
`select`
    (Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Proxy "create"
-> (() -> UserContractState)
-> (Uniswap
    -> CreateParams
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text ())
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
forall (l :: Symbol) a p.
(HasEndpoint l p UniswapUserSchema, FromJSON p) =>
Proxy l
-> (a -> UserContractState)
-> (Uniswap
    -> p
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text a)
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
f (Proxy "create"
forall k (t :: k). Proxy t
Proxy @"create") (UserContractState -> () -> UserContractState
forall a b. a -> b -> a
const UserContractState
Created) Uniswap
-> CreateParams
-> Contract
     (Last (Either Text UserContractState)) UniswapUserSchema Text ()
forall w (s :: Row *).
Uniswap -> CreateParams -> Contract w s Text ()
create                 Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e a.
Promise w s e a -> Promise w s e a -> Promise w s e a
`select`
           Proxy "swap"
-> (() -> UserContractState)
-> (Uniswap
    -> SwapParams
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text ())
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
forall (l :: Symbol) a p.
(HasEndpoint l p UniswapUserSchema, FromJSON p) =>
Proxy l
-> (a -> UserContractState)
-> (Uniswap
    -> p
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text a)
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
f (Proxy "swap"
forall k (t :: k). Proxy t
Proxy @"swap")   (UserContractState -> () -> UserContractState
forall a b. a -> b -> a
const UserContractState
Swapped) Uniswap
-> SwapParams
-> Contract
     (Last (Either Text UserContractState)) UniswapUserSchema Text ()
forall w (s :: Row *).
Uniswap -> SwapParams -> Contract w s Text ()
swap                   Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e a.
Promise w s e a -> Promise w s e a -> Promise w s e a
`select`
           Proxy "close"
-> (() -> UserContractState)
-> (Uniswap
    -> CloseParams
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text ())
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
forall (l :: Symbol) a p.
(HasEndpoint l p UniswapUserSchema, FromJSON p) =>
Proxy l
-> (a -> UserContractState)
-> (Uniswap
    -> p
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text a)
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
f (Proxy "close"
forall k (t :: k). Proxy t
Proxy @"close")  (UserContractState -> () -> UserContractState
forall a b. a -> b -> a
const UserContractState
Closed)  Uniswap
-> CloseParams
-> Contract
     (Last (Either Text UserContractState)) UniswapUserSchema Text ()
forall w (s :: Row *).
Uniswap -> CloseParams -> Contract w s Text ()
close                  Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e a.
Promise w s e a -> Promise w s e a -> Promise w s e a
`select`
           Proxy "remove"
-> (() -> UserContractState)
-> (Uniswap
    -> RemoveParams
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text ())
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
forall (l :: Symbol) a p.
(HasEndpoint l p UniswapUserSchema, FromJSON p) =>
Proxy l
-> (a -> UserContractState)
-> (Uniswap
    -> p
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text a)
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
f (Proxy "remove"
forall k (t :: k). Proxy t
Proxy @"remove") (UserContractState -> () -> UserContractState
forall a b. a -> b -> a
const UserContractState
Removed) Uniswap
-> RemoveParams
-> Contract
     (Last (Either Text UserContractState)) UniswapUserSchema Text ()
forall w (s :: Row *).
Uniswap -> RemoveParams -> Contract w s Text ()
remove                 Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e a.
Promise w s e a -> Promise w s e a -> Promise w s e a
`select`
           Proxy "add"
-> (() -> UserContractState)
-> (Uniswap
    -> AddParams
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text ())
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
forall (l :: Symbol) a p.
(HasEndpoint l p UniswapUserSchema, FromJSON p) =>
Proxy l
-> (a -> UserContractState)
-> (Uniswap
    -> p
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text a)
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
f (Proxy "add"
forall k (t :: k). Proxy t
Proxy @"add")    (UserContractState -> () -> UserContractState
forall a b. a -> b -> a
const UserContractState
Added)   Uniswap
-> AddParams
-> Contract
     (Last (Either Text UserContractState)) UniswapUserSchema Text ()
forall w (s :: Row *). Uniswap -> AddParams -> Contract w s Text ()
add                    Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e a.
Promise w s e a -> Promise w s e a -> Promise w s e a
`select`
           Proxy "pools"
-> ([((Coin A, Amount A), (Coin B, Amount B))]
    -> UserContractState)
-> (Uniswap
    -> ()
    -> Contract
         (Last (Either Text UserContractState))
         UniswapUserSchema
         Text
         [((Coin A, Amount A), (Coin B, Amount B))])
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
forall (l :: Symbol) a p.
(HasEndpoint l p UniswapUserSchema, FromJSON p) =>
Proxy l
-> (a -> UserContractState)
-> (Uniswap
    -> p
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text a)
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
f (Proxy "pools"
forall k (t :: k). Proxy t
Proxy @"pools")  [((Coin A, Amount A), (Coin B, Amount B))] -> UserContractState
Pools           (\Uniswap
us' () -> Uniswap
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Text
     [((Coin A, Amount A), (Coin B, Amount B))]
forall w (s :: Row *).
Uniswap
-> Contract w s Text [((Coin A, Amount A), (Coin B, Amount B))]
pools Uniswap
us') Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e a.
Promise w s e a -> Promise w s e a -> Promise w s e a
`select`
           Proxy "funds"
-> (Value -> UserContractState)
-> (Uniswap
    -> ()
    -> Contract
         (Last (Either Text UserContractState))
         UniswapUserSchema
         Text
         Value)
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
forall (l :: Symbol) a p.
(HasEndpoint l p UniswapUserSchema, FromJSON p) =>
Proxy l
-> (a -> UserContractState)
-> (Uniswap
    -> p
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text a)
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
f (Proxy "funds"
forall k (t :: k). Proxy t
Proxy @"funds")  Value -> UserContractState
Funds           (\Uniswap
_us () -> Contract
  (Last (Either Text UserContractState)) UniswapUserSchema Text Value
forall w (s :: Row *). Contract w s Text Value
funds))
     Promise
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Void
  ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall a. Semigroup a => a -> a -> a
<> Uniswap
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
userEndpoints Uniswap
us)
  where
    f :: forall l a p.
         (HasEndpoint l p UniswapUserSchema, FromJSON p)
      => Proxy l
      -> (a -> UserContractState)
      -> (Uniswap -> p -> Contract (Last (Either Text UserContractState)) UniswapUserSchema Text a)
      -> Promise (Last (Either Text UserContractState)) UniswapUserSchema Void ()
    f :: Proxy l
-> (a -> UserContractState)
-> (Uniswap
    -> p
    -> Contract
         (Last (Either Text UserContractState)) UniswapUserSchema Text a)
-> Promise
     (Last (Either Text UserContractState)) UniswapUserSchema Void ()
f Proxy l
_ a -> UserContractState
g Uniswap
-> p
-> Contract
     (Last (Either Text UserContractState)) UniswapUserSchema Text a
c = forall a w (s :: Row *) e1 e2 b.
(HasEndpoint l a s, AsContractError e1, FromJSON a) =>
(Either e1 a -> Contract w s e2 b) -> Promise w s e2 b
forall (l :: Symbol) a w (s :: Row *) e1 e2 b.
(HasEndpoint l a s, AsContractError e1, FromJSON a) =>
(Either e1 a -> Contract w s e2 b) -> Promise w s e2 b
handleEndpoint @l ((Either Text p
  -> Contract
       (Last (Either Text UserContractState))
       ('R
          '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
             "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
             "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
             "funds" ':-> (EndpointValue (), ActiveEndpoint),
             "pools" ':-> (EndpointValue (), ActiveEndpoint),
             "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
             "stop" ':-> (EndpointValue (), ActiveEndpoint),
             "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
       Void
       ())
 -> Promise
      (Last (Either Text UserContractState))
      ('R
         '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
            "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
            "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
            "funds" ':-> (EndpointValue (), ActiveEndpoint),
            "pools" ':-> (EndpointValue (), ActiveEndpoint),
            "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
      Void
      ())
-> (Either Text p
    -> Contract
         (Last (Either Text UserContractState))
         ('R
            '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
               "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
               "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
               "funds" ':-> (EndpointValue (), ActiveEndpoint),
               "pools" ':-> (EndpointValue (), ActiveEndpoint),
               "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
               "stop" ':-> (EndpointValue (), ActiveEndpoint),
               "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
         Void
         ())
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall a b. (a -> b) -> a -> b
$ \Either Text p
p -> do
        Either Text a
e <- (Text
 -> Contract
      (Last (Either Text UserContractState))
      ('R
         '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
            "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
            "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
            "funds" ':-> (EndpointValue (), ActiveEndpoint),
            "pools" ':-> (EndpointValue (), ActiveEndpoint),
            "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
      Void
      (Either Text a))
-> (p
    -> Contract
         (Last (Either Text UserContractState))
         ('R
            '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
               "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
               "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
               "funds" ':-> (EndpointValue (), ActiveEndpoint),
               "pools" ':-> (EndpointValue (), ActiveEndpoint),
               "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
               "stop" ':-> (EndpointValue (), ActiveEndpoint),
               "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
         Void
         (Either Text a))
-> Either Text p
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     (Either Text a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either Text a
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     (Either Text a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text a
 -> Contract
      (Last (Either Text UserContractState))
      ('R
         '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
            "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
            "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
            "funds" ':-> (EndpointValue (), ActiveEndpoint),
            "pools" ':-> (EndpointValue (), ActiveEndpoint),
            "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
      Void
      (Either Text a))
-> (Text -> Either Text a)
-> Text
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text a
forall a b. a -> Either a b
Left) (Contract
  (Last (Either Text UserContractState))
  ('R
     '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
        "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
        "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
        "funds" ':-> (EndpointValue (), ActiveEndpoint),
        "pools" ':-> (EndpointValue (), ActiveEndpoint),
        "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
        "stop" ':-> (EndpointValue (), ActiveEndpoint),
        "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
  Text
  a
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     (Either Text a)
forall w (s :: Row *) e e0 a.
Contract w s e a -> Contract w s e0 (Either e a)
runError (Contract
   (Last (Either Text UserContractState))
   ('R
      '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
         "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
         "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
         "funds" ':-> (EndpointValue (), ActiveEndpoint),
         "pools" ':-> (EndpointValue (), ActiveEndpoint),
         "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
         "stop" ':-> (EndpointValue (), ActiveEndpoint),
         "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
   Text
   a
 -> Contract
      (Last (Either Text UserContractState))
      ('R
         '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
            "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
            "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
            "funds" ':-> (EndpointValue (), ActiveEndpoint),
            "pools" ':-> (EndpointValue (), ActiveEndpoint),
            "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
      Void
      (Either Text a))
-> (p
    -> Contract
         (Last (Either Text UserContractState))
         ('R
            '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
               "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
               "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
               "funds" ':-> (EndpointValue (), ActiveEndpoint),
               "pools" ':-> (EndpointValue (), ActiveEndpoint),
               "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
               "stop" ':-> (EndpointValue (), ActiveEndpoint),
               "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
         Text
         a)
-> p
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uniswap
-> p
-> Contract
     (Last (Either Text UserContractState)) UniswapUserSchema Text a
c Uniswap
us) Either Text p
p
        Last (Either Text UserContractState)
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e. w -> Contract w s e ()
tell (Last (Either Text UserContractState)
 -> Contract
      (Last (Either Text UserContractState))
      ('R
         '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
            "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
            "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
            "funds" ':-> (EndpointValue (), ActiveEndpoint),
            "pools" ':-> (EndpointValue (), ActiveEndpoint),
            "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
      Void
      ())
-> Last (Either Text UserContractState)
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall a b. (a -> b) -> a -> b
$ Maybe (Either Text UserContractState)
-> Last (Either Text UserContractState)
forall a. Maybe a -> Last a
Last (Maybe (Either Text UserContractState)
 -> Last (Either Text UserContractState))
-> Maybe (Either Text UserContractState)
-> Last (Either Text UserContractState)
forall a b. (a -> b) -> a -> b
$ Either Text UserContractState
-> Maybe (Either Text UserContractState)
forall a. a -> Maybe a
Just (Either Text UserContractState
 -> Maybe (Either Text UserContractState))
-> Either Text UserContractState
-> Maybe (Either Text UserContractState)
forall a b. (a -> b) -> a -> b
$ case Either Text a
e of
            Left Text
err -> Text -> Either Text UserContractState
forall a b. a -> Either a b
Left Text
err
            Right a
a  -> UserContractState -> Either Text UserContractState
forall a b. b -> Either a b
Right (UserContractState -> Either Text UserContractState)
-> UserContractState -> Either Text UserContractState
forall a b. (a -> b) -> a -> b
$ a -> UserContractState
g a
a

    stop :: Promise (Last (Either Text UserContractState)) UniswapUserSchema Void ()
    stop :: Promise
  (Last (Either Text UserContractState)) UniswapUserSchema Void ()
stop = forall a w (s :: Row *) e1 e2 b.
(HasEndpoint "stop" a s, AsContractError e1, FromJSON a) =>
(Either e1 a -> Contract w s e2 b) -> Promise w s e2 b
forall (l :: Symbol) a w (s :: Row *) e1 e2 b.
(HasEndpoint l a s, AsContractError e1, FromJSON a) =>
(Either e1 a -> Contract w s e2 b) -> Promise w s e2 b
handleEndpoint @"stop" ((Either Text ()
  -> Contract
       (Last (Either Text UserContractState))
       ('R
          '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
             "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
             "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
             "funds" ':-> (EndpointValue (), ActiveEndpoint),
             "pools" ':-> (EndpointValue (), ActiveEndpoint),
             "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
             "stop" ':-> (EndpointValue (), ActiveEndpoint),
             "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
       Void
       ())
 -> Promise
      (Last (Either Text UserContractState))
      ('R
         '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
            "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
            "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
            "funds" ':-> (EndpointValue (), ActiveEndpoint),
            "pools" ':-> (EndpointValue (), ActiveEndpoint),
            "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
      Void
      ())
-> (Either Text ()
    -> Contract
         (Last (Either Text UserContractState))
         ('R
            '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
               "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
               "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
               "funds" ':-> (EndpointValue (), ActiveEndpoint),
               "pools" ':-> (EndpointValue (), ActiveEndpoint),
               "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
               "stop" ':-> (EndpointValue (), ActiveEndpoint),
               "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
         Void
         ())
-> Promise
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall a b. (a -> b) -> a -> b
$ \Either Text ()
e -> do
        Last (Either Text UserContractState)
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall w (s :: Row *) e. w -> Contract w s e ()
tell (Last (Either Text UserContractState)
 -> Contract
      (Last (Either Text UserContractState))
      ('R
         '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
            "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
            "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
            "funds" ':-> (EndpointValue (), ActiveEndpoint),
            "pools" ':-> (EndpointValue (), ActiveEndpoint),
            "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
            "stop" ':-> (EndpointValue (), ActiveEndpoint),
            "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
      Void
      ())
-> Last (Either Text UserContractState)
-> Contract
     (Last (Either Text UserContractState))
     ('R
        '[ "add" ':-> (EndpointValue AddParams, ActiveEndpoint),
           "close" ':-> (EndpointValue CloseParams, ActiveEndpoint),
           "create" ':-> (EndpointValue CreateParams, ActiveEndpoint),
           "funds" ':-> (EndpointValue (), ActiveEndpoint),
           "pools" ':-> (EndpointValue (), ActiveEndpoint),
           "remove" ':-> (EndpointValue RemoveParams, ActiveEndpoint),
           "stop" ':-> (EndpointValue (), ActiveEndpoint),
           "swap" ':-> (EndpointValue SwapParams, ActiveEndpoint)])
     Void
     ()
forall a b. (a -> b) -> a -> b
$ Maybe (Either Text UserContractState)
-> Last (Either Text UserContractState)
forall a. Maybe a -> Last a
Last (Maybe (Either Text UserContractState)
 -> Last (Either Text UserContractState))
-> Maybe (Either Text UserContractState)
-> Last (Either Text UserContractState)
forall a b. (a -> b) -> a -> b
$ Either Text UserContractState
-> Maybe (Either Text UserContractState)
forall a. a -> Maybe a
Just (Either Text UserContractState
 -> Maybe (Either Text UserContractState))
-> Either Text UserContractState
-> Maybe (Either Text UserContractState)
forall a b. (a -> b) -> a -> b
$ case Either Text ()
e of
            Left Text
err -> Text -> Either Text UserContractState
forall a b. a -> Either a b
Left Text
err
            Right () -> UserContractState -> Either Text UserContractState
forall a b. b -> Either a b
Right UserContractState
Stopped