{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}

module Deal.DealValidation (validateRun,validatePreRun,validateReq)
  where 

import Deal.DealBase
import Types
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Maybe

import qualified Waterfall as W
import qualified CreditEnhancement as CE
import qualified Liability as L
import qualified Accounts as A
import qualified Expense as F
import qualified Asset as P
import qualified Assumptions as AP
import qualified InterestRate as IR

import Control.Lens hiding (element)
import Control.Lens.TH

import Data.Maybe
import qualified Assumptions as A


import Debug.Trace
debug :: c -> [Char] -> c
debug = ([Char] -> c -> c) -> c -> [Char] -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> c -> c
forall a. [Char] -> a -> a
trace

validateAction :: [W.Action] -> [ResultComponent] -> Set.Set String -> Set.Set String -> Set.Set String -> Set.Set String-> Set.Set String-> Set.Set String -> Set.Set String -> Set.Set String -> Set.Set String -> Set.Set PoolId -> [ResultComponent]
validateAction :: [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [] [ResultComponent]
rs Set [Char]
_ Set [Char]
_ Set [Char]
_ Set [Char]
_ Set [Char]
_ Set [Char]
_ Set [Char]
_ Set [Char]
_ Set [Char]
_ Set PoolId
_ = [ResultComponent]
rs
validateAction ((W.Transfer Maybe Limit
_ [Char]
acc1 [Char]
acc2 Maybe TxnComment
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
acc1 Set [Char]
accKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
acc2 Set [Char]
accKeys 
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
acc1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
","[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
acc2[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.CalcFee [[Char]]
fees):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
fees) Set [Char]
feeKeys)
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
fees [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
feeKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayFee Maybe Limit
_ [Char]
accName [[Char]]
fees Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
fees) Set [Char]
feeKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
fees [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
feeKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
accName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys  Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys  Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.CalcAndPayFee Maybe Limit
_ [Char]
accName [[Char]]
fees Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
fees) Set [Char]
feeKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
fees [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
feeKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
accName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayFeeResidual Maybe Limit
_ [Char]
accName [Char]
feeName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
feeName Set [Char]
feeKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
feeName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
feeKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.CalcBondInt [[Char]]
bnds):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayInt Maybe Limit
_ [Char]
accName [[Char]]
bnds Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayIntBySeq Maybe Limit
_ [Char]
accName [[Char]]
bndNames Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bndNames) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bndNames [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.AccrueAndPayIntBySeq Maybe Limit
_ [Char]
accName [[Char]]
bndNames Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bndNames) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bndNames [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayIntOverIntBySeq Maybe Limit
_ [Char]
accName [[Char]]
bnds Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames  Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayIntOverInt Maybe Limit
_ [Char]
accName [[Char]]
bnds Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames  Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.AccrueAndPayInt Maybe Limit
_ [Char]
accName [[Char]]
bnds Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames  Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayIntResidual Maybe Limit
_ [Char]
accName [Char]
bndName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
bndName Set [Char]
bndKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
bndName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayPrin Maybe Limit
_ [Char]
accName [[Char]]
bnds Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayPrinResidual [Char]
accName [[Char]]
bnds):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayPrinWithDue [Char]
accName [[Char]]
bnds Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayPrinBySeq Maybe Limit
_ [Char]
accName [[Char]]
bnds Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayPrinGroup Maybe Limit
_ [Char]
accName [Char]
bg PayOrderBy
_ Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
bg Set [Char]
bgNames Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
bg[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bgNames [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.AccrueAndPayIntGroup Maybe Limit
_ [Char]
accName [Char]
bg PayOrderBy
_ Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
bg Set [Char]
bgNames Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
bg[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bgNames [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayIntGroup Maybe Limit
_ [Char]
accName [Char]
bg PayOrderBy
_ Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
bg Set [Char]
bgNames Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
bg[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bgNames [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.AccrueIntGroup [[Char]]
bgs ):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bgs) Set [Char]
bgNames) = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bgs[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bgNames)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayPrinResidual [Char]
accName [[Char]]
bnds):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.BuyAsset Maybe Limit
_ PricingMethod
_ [Char]
accName Maybe PoolId
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.BuyAssetFrom Maybe Limit
_ PricingMethod
_ [Char]
accName Maybe [Char]
mRPoolName Maybe PoolId
mPid):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | PoolId -> Set PoolId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember (PoolId -> Maybe PoolId -> PoolId
forall a. a -> Maybe a -> a
fromMaybe PoolId
PoolConsol Maybe PoolId
mPid) Set PoolId
poolKeys = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg (Maybe PoolId -> [Char]
forall a. Show a => a -> [Char]
show Maybe PoolId
mPid[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set PoolId -> [Char]
forall a. Show a => a -> [Char]
show Set PoolId
poolKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayPrinBySeq Maybe Limit
_ [Char]
accName [[Char]]
bnds Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayPrinGroup Maybe Limit
_ [Char]
accName [Char]
bg PayOrderBy
_ Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
bg Set [Char]
bgNames Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
bg[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bgNames [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.AccrueAndPayIntGroup Maybe Limit
_ [Char]
accName [Char]
bg PayOrderBy
_ Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
bg Set [Char]
bgNames Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
bg[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bgNames [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayIntGroup Maybe Limit
_ [Char]
accName [Char]
bg PayOrderBy
_ Maybe ExtraSupport
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
bg Set [Char]
bgNames Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
bg[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bgNames [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.AccrueIntGroup [[Char]]
bgs ):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys  Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bgs) Set [Char]
bgNames) = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bgs[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bgNames)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.PayPrinResidual [Char]
accName [[Char]]
bnds):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bnds) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bnds[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.BuyAsset Maybe Limit
_ PricingMethod
_ [Char]
accName Maybe PoolId
_):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.BuyAssetFrom Maybe Limit
_ PricingMethod
_ [Char]
accName Maybe [Char]
mRPoolName Maybe PoolId
mPid):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | PoolId -> Set PoolId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember (PoolId -> Maybe PoolId -> PoolId
forall a. a -> Maybe a -> a
fromMaybe PoolId
PoolConsol Maybe PoolId
mPid) Set PoolId
poolKeys = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg (Maybe PoolId -> [Char]
forall a. Show a => a -> [Char]
show Maybe PoolId
mPid[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set PoolId -> [Char]
forall a. Show a => a -> [Char]
show Set PoolId
poolKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.LiquidatePool PricingMethod
_ [Char]
accName Maybe [PoolId]
mPids):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Maybe [PoolId] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [PoolId]
mPids Bool -> Bool -> Bool
&& Bool -> Bool
not (Set PoolId -> Set PoolId -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList ([PoolId] -> Maybe [PoolId] -> [PoolId]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [PoolId]
mPids)) Set PoolId
poolKeys) = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg (Maybe [PoolId] -> [Char]
forall a. Show a => a -> [Char]
show Maybe [PoolId]
mPids[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set PoolId -> [Char]
forall a. Show a => a -> [Char]
show Set PoolId
poolKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.LiqSupport Maybe Limit
_ [Char]
liqName LiqDrawType
CE.LiqToAcc [[Char]
accName]):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
liqName Set [Char]
liqProviderKeys 
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
liqName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
liqProviderKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.LiqSupport Maybe Limit
_ [Char]
liqName LiqDrawType
CE.LiqToFee [[Char]]
feeNames):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
feeNames) Set [Char]
feeKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
liqName Set [Char]
liqProviderKeys 
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
feeNames[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
feeKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
liqName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
liqProviderKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.LiqSupport Maybe Limit
_ [Char]
liqName LiqDrawType
CE.LiqToBondInt [[Char]]
bndNames):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bndNames) Set [Char]
bndKeys) Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
liqName Set [Char]
liqProviderKeys 
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
bndNames[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
liqName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
liqProviderKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.LiqRepay Maybe Limit
_ LiqRepayType
_ [Char]
accName [Char]
liqName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
liqName Set [Char]
liqProviderKeys 
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
liqName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
liqProviderKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.LiqYield Maybe Limit
_ [Char]
accName [Char]
liqName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
liqName Set [Char]
liqProviderKeys 
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
accName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
liqName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
liqProviderKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.LiqAccrue [[Char]]
liqNames):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
liqNames) Set [Char]
liqProviderKeys)
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
liqNames [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
liqProviderKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.LiqAccrue [[Char]]
liqNames):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool -> Bool
not (Set [Char] -> Set [Char] -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
liqNames) Set [Char]
liqProviderKeys) 
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
liqNames [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
liqProviderKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.SwapAccrue [Char]
rsName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
rsName Set [Char]
rateSwapKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
rsName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
rateSwapKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.SwapReceive [Char]
accName [Char]
rsName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
rsName Set [Char]
rateSwapKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
rsName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
rateSwapKeys [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
accName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.SwapPay [Char]
accName [Char]
rsName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
rsName Set [Char]
rateSwapKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
rsName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
rateSwapKeys [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
accName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.SwapSettle [Char]
accName [Char]
rsName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
rsName Set [Char]
rateSwapKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
rsName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
rateSwapKeys [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
accName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.FundWith Maybe Limit
_ [Char]
accName [Char]
bName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
bName Set [Char]
bndKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
bName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
accName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.WriteOff Maybe Limit
_ [Char]
bName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
bName Set [Char]
bndKeys = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
bName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
bndKeys )]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.CollectRateCap [Char]
accName [Char]
rcName):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
rcName Set [Char]
rcKeys Bool -> Bool -> Bool
|| [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember [Char]
accName Set [Char]
accKeys
    = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as ([ResultComponent]
rs [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ResultComponent
ErrorMsg ([Char]
rcName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
rcKeys [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" Or "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
accName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set [Char] -> [Char]
forall a. Show a => a -> [Char]
show Set [Char]
accKeys)]) Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  | Bool
otherwise = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.ActionWithPre Pre
p [Action]
subActionList):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction ([Action]
subActionList[Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction ((W.ActionWithPre2 Pre
p [Action]
subActionList1 [Action]
subActionList2):[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction ([Action]
subActionList1[Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++[Action]
subActionList2[Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

validateAction (Action
action:[Action]
as) [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys
  = [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
as [ResultComponent]
rs Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rcKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys

extractRequiredRates :: (P.Asset a,IR.UseRate a) => TestDeal a -> Set.Set Types.Index
extractRequiredRates :: forall a. (Asset a, UseRate a) => TestDeal a -> Set Index
extractRequiredRates t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts = Map [Char] Account
accM 
                               ,fees :: forall a. TestDeal a -> Map [Char] Fee
fees = Map [Char] Fee
feeM 
                               ,bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds = Map [Char] Bond
bondM 
                               ,liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider = Maybe (Map [Char] LiqFacility)
mliqProviderM 
                               ,rateSwap :: forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap = Maybe (Map [Char] RateSwap)
mrsM 
                               ,rateCap :: forall a. TestDeal a -> Maybe (Map [Char] RateCap)
rateCap = Maybe (Map [Char] RateCap)
mRcM
                               ,pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pool}
  = [Index] -> Set Index
forall a. Ord a => [a] -> Set a
Set.fromList ([Index] -> Set Index) -> [Index] -> Set Index
forall a b. (a -> b) -> a -> b
$ [Index]
assetIndex [Index] -> [Index] -> [Index]
forall a. [a] -> [a] -> [a]
++ [Index]
accIndex [Index] -> [Index] -> [Index]
forall a. [a] -> [a] -> [a]
++ [Index]
bondIndex [Index] -> [Index] -> [Index]
forall a. [a] -> [a] -> [a]
++ [Index]
liqProviderIndex [Index] -> [Index] -> [Index]
forall a. [a] -> [a] -> [a]
++ [Index]
rsIndex [Index] -> [Index] -> [Index]
forall a. [a] -> [a] -> [a]
++ [Index]
rcIndex
  -- = Set.fromList $ accIndex ++ bondIndex ++ liqProviderIndex ++ rsIndex
    where 
      assetIndex :: [Index]
assetIndex = [Maybe Index] -> [Index]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Index] -> [Index]) -> [Maybe Index] -> [Index]
forall a b. (a -> b) -> a -> b
$ a -> Maybe Index
forall x. UseRate x => x -> Maybe Index
IR.getIndex (a -> Maybe Index) -> [a] -> [Maybe Index]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> [a]
forall a. Asset a => TestDeal a -> [a]
getAllAssetList TestDeal a
t
      
      accIndex :: [Index]
accIndex = [Maybe Index] -> [Index]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Index] -> [Index]) -> [Maybe Index] -> [Index]
forall a b. (a -> b) -> a -> b
$ Account -> Maybe Index
forall x. UseRate x => x -> Maybe Index
IR.getIndex (Account -> Maybe Index) -> [Account] -> [Maybe Index]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] Account -> [Account]
forall k a. Map k a -> [a]
Map.elems Map [Char] Account
accM 
      bondIndex :: [Index]
bondIndex = [[Index]] -> [Index]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Index]] -> [Index]) -> [[Index]] -> [Index]
forall a b. (a -> b) -> a -> b
$ [Maybe [Index]] -> [[Index]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Index]] -> [[Index]]) -> [Maybe [Index]] -> [[Index]]
forall a b. (a -> b) -> a -> b
$ Bond -> Maybe [Index]
forall x. UseRate x => x -> Maybe [Index]
IR.getIndexes (Bond -> Maybe [Index]) -> [Bond] -> [Maybe [Index]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] Bond -> [Bond]
forall k a. Map k a -> [a]
Map.elems Map [Char] Bond
bondM 
      liqProviderIndex :: [Index]
liqProviderIndex = case Maybe (Map [Char] LiqFacility)
mliqProviderM of 
                           Just Map [Char] LiqFacility
liqProviderM -> [[Index]] -> [Index]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Index]] -> [Index]) -> [[Index]] -> [Index]
forall a b. (a -> b) -> a -> b
$ [Maybe [Index]] -> [[Index]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Index]] -> [[Index]]) -> [Maybe [Index]] -> [[Index]]
forall a b. (a -> b) -> a -> b
$ LiqFacility -> Maybe [Index]
forall x. UseRate x => x -> Maybe [Index]
IR.getIndexes (LiqFacility -> Maybe [Index]) -> [LiqFacility] -> [Maybe [Index]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] LiqFacility -> [LiqFacility]
forall k a. Map k a -> [a]
Map.elems Map [Char] LiqFacility
liqProviderM
                           Maybe (Map [Char] LiqFacility)
Nothing -> [] 
      rsIndex :: [Index]
rsIndex = case Maybe (Map [Char] RateSwap)
mrsM of 
                  Just Map [Char] RateSwap
rsM -> [[Index]] -> [Index]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Index]] -> [Index]) -> [[Index]] -> [Index]
forall a b. (a -> b) -> a -> b
$ [Maybe [Index]] -> [[Index]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Index]] -> [[Index]]) -> [Maybe [Index]] -> [[Index]]
forall a b. (a -> b) -> a -> b
$ RateSwap -> Maybe [Index]
forall x. UseRate x => x -> Maybe [Index]
IR.getIndexes (RateSwap -> Maybe [Index]) -> [RateSwap] -> [Maybe [Index]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] RateSwap -> [RateSwap]
forall k a. Map k a -> [a]
Map.elems Map [Char] RateSwap
rsM
                  Maybe (Map [Char] RateSwap)
Nothing -> []
      rcIndex :: [Index]
rcIndex = case Maybe (Map [Char] RateCap)
mRcM of 
                  Just Map [Char] RateCap
rcM -> [[Index]] -> [Index]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Index]] -> [Index]) -> [[Index]] -> [Index]
forall a b. (a -> b) -> a -> b
$ [Maybe [Index]] -> [[Index]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Index]] -> [[Index]]) -> [Maybe [Index]] -> [[Index]]
forall a b. (a -> b) -> a -> b
$ RateCap -> Maybe [Index]
forall x. UseRate x => x -> Maybe [Index]
IR.getIndexes (RateCap -> Maybe [Index]) -> [RateCap] -> [Maybe [Index]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] RateCap -> [RateCap]
forall k a. Map k a -> [a]
Map.elems Map [Char] RateCap
rcM
                  Maybe (Map [Char] RateCap)
Nothing -> []
        
      -- note fee is not tested
validateAggRule :: [W.CollectionRule] -> [PoolId] -> [ResultComponent]
validateAggRule :: [CollectionRule] -> [PoolId] -> [ResultComponent]
validateAggRule [CollectionRule]
rules [PoolId]
validPids =
    [ [Char] -> ResultComponent
ErrorMsg ([Char]
"Pool source "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++PoolSource -> [Char]
forall a. Show a => a -> [Char]
show PoolSource
ps[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" has a weight of "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Rate -> [Char]
forall a. Show a => a -> [Char]
show Rate
r)   | ((PoolId
pid,PoolSource
ps),Rate
r) <- Map (PoolId, PoolSource) Rate -> [((PoolId, PoolSource), Rate)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (PoolId, PoolSource) Rate
oustandingPs ] [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++
    [ [Char] -> ResultComponent
ErrorMsg ([Char]
"Pool Id not found "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++PoolId -> [Char]
forall a. Show a => a -> [Char]
show PoolId
ospid[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" in "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [PoolId] -> [Char]
forall a. Show a => a -> [Char]
show [PoolId]
validPids) | PoolId
ospid <- [PoolId]
osPid ]
  where 
    countWeight :: CollectionRule -> Map (PoolId, PoolSource) Rate
countWeight (W.Collect (Just [PoolId]
pids) PoolSource
ps [Char]
_) =  [((PoolId, PoolSource), Rate)] -> Map (PoolId, PoolSource) Rate
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((PoolId
pid,PoolSource
ps),Rate
1.0) | PoolId
pid <- [PoolId]
pids]
    countWeight (W.Collect Maybe [PoolId]
Nothing PoolSource
ps [Char]
_) =  [((PoolId, PoolSource), Rate)] -> Map (PoolId, PoolSource) Rate
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((PoolId
PoolConsol,PoolSource
ps),Rate
1.0)]
    countWeight (W.CollectByPct (Just [PoolId]
pids) PoolSource
ps [(Rate, [Char])]
lst) = [((PoolId, PoolSource), Rate)] -> Map (PoolId, PoolSource) Rate
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((PoolId
pid,PoolSource
ps), Rate
pct) | PoolId
pid <- [PoolId]
pids, Rate
pct <- (Rate, [Char]) -> Rate
forall a b. (a, b) -> a
fst ((Rate, [Char]) -> Rate) -> [(Rate, [Char])] -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rate, [Char])]
lst]
    countWeight (W.CollectByPct Maybe [PoolId]
Nothing PoolSource
ps [(Rate, [Char])]
lst) = [((PoolId, PoolSource), Rate)] -> Map (PoolId, PoolSource) Rate
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((PoolId
PoolConsol, PoolSource
ps),Rate
pct)| Rate
pct <- (Rate, [Char]) -> Rate
forall a b. (a, b) -> a
fst ((Rate, [Char]) -> Rate) -> [(Rate, [Char])] -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rate, [Char])]
lst]
    
    sumMap :: Map (PoolId, PoolSource) Rate
sumMap = (Map (PoolId, PoolSource) Rate
 -> Map (PoolId, PoolSource) Rate -> Map (PoolId, PoolSource) Rate)
-> [Map (PoolId, PoolSource) Rate] -> Map (PoolId, PoolSource) Rate
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 ((Rate -> Rate -> Rate)
-> Map (PoolId, PoolSource) Rate
-> Map (PoolId, PoolSource) Rate
-> Map (PoolId, PoolSource) Rate
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
(+)) ([Map (PoolId, PoolSource) Rate] -> Map (PoolId, PoolSource) Rate)
-> [Map (PoolId, PoolSource) Rate] -> Map (PoolId, PoolSource) Rate
forall a b. (a -> b) -> a -> b
$ CollectionRule -> Map (PoolId, PoolSource) Rate
countWeight (CollectionRule -> Map (PoolId, PoolSource) Rate)
-> [CollectionRule] -> [Map (PoolId, PoolSource) Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CollectionRule]
rules  
    oustandingPs :: Map (PoolId, PoolSource) Rate
oustandingPs = (Rate -> Bool)
-> Map (PoolId, PoolSource) Rate -> Map (PoolId, PoolSource) Rate
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Rate -> Rate -> Bool
forall a. Ord a => a -> a -> Bool
> Rate
1.0) Map (PoolId, PoolSource) Rate
sumMap

    getPids :: CollectionRule -> [PoolId]
getPids (W.Collect (Just [PoolId]
pids) PoolSource
_ [Char]
_) = [PoolId]
pids  
    getPids (W.Collect Maybe [PoolId]
Nothing PoolSource
ps [Char]
_) = [PoolId
PoolConsol]
    getPids (W.CollectByPct (Just [PoolId]
pids) PoolSource
_ [(Rate, [Char])]
_) = [PoolId]
pids
    getPids (W.CollectByPct Maybe [PoolId]
Nothing PoolSource
_ [(Rate, [Char])]
_ ) = [PoolId
PoolConsol]
    osPid :: [PoolId]
osPid = Set PoolId -> [PoolId]
forall a. Set a -> [a]
Set.elems (Set PoolId -> [PoolId]) -> Set PoolId -> [PoolId]
forall a b. (a -> b) -> a -> b
$ Set PoolId -> Set PoolId -> Set PoolId
forall a. Ord a => Set a -> Set a -> Set a
Set.difference ([PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList ([[PoolId]] -> [PoolId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (CollectionRule -> [PoolId]
getPids (CollectionRule -> [PoolId]) -> [CollectionRule] -> [[PoolId]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CollectionRule]
rules))) ([PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList [PoolId]
validPids)


validateFee :: F.Fee -> [ResultComponent]
-- validateFee (F.Fee fn (F.AnnualRateFee (CurrentBondBalanceOf _) _) _ _ _ _ _ _) = [] 
-- validateFee (F.Fee fn (F.AnnualRateFee (OriginalBondBalanceOf _) _) _ _ _ _ _ _) = [] 
-- validateFee (F.Fee fn (F.AnnualRateFee (CurrentPoolBalance _) _) _ _ _ _ _ _) = [] 
-- validateFee (F.Fee fn (F.AnnualRateFee (OriginalPoolBalance _) _) _ _ _ _ _ _) = [] 
-- validateFee (F.Fee fn (F.AnnualRateFee CurrentBondBalance _) _ _ _ _ _ _) = [] 
-- validateFee (F.Fee fn (F.AnnualRateFee OriginalBondBalance _) _ _ _ _ _ _) = [] 
-- validateFee (F.Fee fn (F.AnnualRateFee ds _) _ _ _ _ _ _ )
--   = [ErrorMsg ("Fee Name "++fn++" has an unsupported base "++show ds)]
validateFee :: Fee -> [ResultComponent]
validateFee Fee
_ = []

--- get required pool id and required revolving pool name
extractRequiredRevolvingPool :: P.Asset a => TestDeal a -> (Set.Set PoolId, Set.Set String)
extractRequiredRevolvingPool :: forall a. Asset a => TestDeal a -> (Set PoolId, Set [Char])
extractRequiredRevolvingPool t :: TestDeal a
t@TestDeal{waterfall :: forall a. TestDeal a -> Map ActionWhen [Action]
waterfall = Map ActionWhen [Action]
waterfallM} = 
  let 
    poolIds :: Set PoolId
poolIds = [PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList ([PoolId] -> Set PoolId) -> [PoolId] -> Set PoolId
forall a b. (a -> b) -> a -> b
$ TestDeal a -> [PoolId]
forall a. Asset a => TestDeal a -> [PoolId]
getPoolIds TestDeal a
t
    extract :: Set PoolId -> Set [Char] -> [Action] -> (Set PoolId, Set [Char])
extract Set PoolId
accPoolIds Set [Char]
accRpoolNames [] = (Set PoolId
accPoolIds,Set [Char]
accRpoolNames)
    extract Set PoolId
accPoolIds Set [Char]
accRpoolNames ((W.BuyAsset Maybe Limit
_ PricingMethod
_ [Char]
_ Maybe PoolId
mPoolId):[Action]
as) = 
      Set PoolId -> Set [Char] -> [Action] -> (Set PoolId, Set [Char])
extract (PoolId -> Set PoolId -> Set PoolId
forall a. Ord a => a -> Set a -> Set a
Set.insert (PoolId -> Maybe PoolId -> PoolId
forall a. a -> Maybe a -> a
fromMaybe PoolId
PoolConsol Maybe PoolId
mPoolId) Set PoolId
accPoolIds) Set [Char]
accRpoolNames [Action]
as
    extract Set PoolId
accPoolIds Set [Char]
accRpoolNames ((W.BuyAssetFrom Maybe Limit
_ PricingMethod
_ [Char]
_ Maybe [Char]
rPoolName Maybe PoolId
mPoolId):[Action]
as) = 
      Set PoolId -> Set [Char] -> [Action] -> (Set PoolId, Set [Char])
extract (PoolId -> Set PoolId -> Set PoolId
forall a. Ord a => a -> Set a -> Set a
Set.insert (PoolId -> Maybe PoolId -> PoolId
forall a. a -> Maybe a -> a
fromMaybe PoolId
PoolConsol Maybe PoolId
mPoolId) Set PoolId
accPoolIds)
              ([Char] -> Set [Char] -> Set [Char]
forall a. Ord a => a -> Set a -> Set a
Set.insert ([Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"Consol" Maybe [Char]
rPoolName) Set [Char]
accRpoolNames)
              [Action]
as
    extract Set PoolId
accPoolIds Set [Char]
accRpoolNames ((W.ActionWithPre Pre
_ [Action]
subActions):[Action]
as) = 
      let 
        (Set PoolId
subAccPoolIds,Set [Char]
subAccRPoolNames) = Set PoolId -> Set [Char] -> [Action] -> (Set PoolId, Set [Char])
extract Set PoolId
accPoolIds Set [Char]
accRpoolNames [Action]
subActions
      in 
        Set PoolId -> Set [Char] -> [Action] -> (Set PoolId, Set [Char])
extract (Set PoolId
accPoolIds Set PoolId -> Set PoolId -> Set PoolId
forall a. Semigroup a => a -> a -> a
<> Set PoolId
subAccPoolIds) (Set [Char]
accRpoolNames Set [Char] -> Set [Char] -> Set [Char]
forall a. Semigroup a => a -> a -> a
<> Set [Char]
subAccRPoolNames) [Action]
as
    extract Set PoolId
accPoolIds Set [Char]
accRpoolNames ((W.ActionWithPre2 Pre
_ [Action]
subActionsA [Action]
subActionsB):[Action]
as) = 
      let 
        (Set PoolId
subAccPoolIdsA,Set [Char]
subAccRPoolNamesA) = Set PoolId -> Set [Char] -> [Action] -> (Set PoolId, Set [Char])
extract Set PoolId
accPoolIds Set [Char]
accRpoolNames [Action]
subActionsA
        (Set PoolId
subAccPoolIdsB,Set [Char]
subAccRPoolNamesB) = Set PoolId -> Set [Char] -> [Action] -> (Set PoolId, Set [Char])
extract Set PoolId
subAccPoolIdsA Set [Char]
subAccRPoolNamesA [Action]
subActionsB
      in 
        Set PoolId -> Set [Char] -> [Action] -> (Set PoolId, Set [Char])
extract Set PoolId
subAccPoolIdsB Set [Char]
subAccRPoolNamesB [Action]
as
    extract Set PoolId
accPoolIds Set [Char]
accRpoolNames (Action
_:[Action]
as) = Set PoolId -> Set [Char] -> [Action] -> (Set PoolId, Set [Char])
extract Set PoolId
accPoolIds Set [Char]
accRpoolNames [Action]
as
    requiredByWaterfall :: [(Set PoolId, Set [Char])]
requiredByWaterfall = Map ActionWhen (Set PoolId, Set [Char])
-> [(Set PoolId, Set [Char])]
forall k a. Map k a -> [a]
Map.elems (Map ActionWhen (Set PoolId, Set [Char])
 -> [(Set PoolId, Set [Char])])
-> Map ActionWhen (Set PoolId, Set [Char])
-> [(Set PoolId, Set [Char])]
forall a b. (a -> b) -> a -> b
$ ([Action] -> (Set PoolId, Set [Char]))
-> Map ActionWhen [Action]
-> Map ActionWhen (Set PoolId, Set [Char])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Set PoolId -> Set [Char] -> [Action] -> (Set PoolId, Set [Char])
extract ([PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList []) ([[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [])) Map ActionWhen [Action]
waterfallM
  in 
    ([Set PoolId] -> Set PoolId
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set PoolId] -> Set PoolId) -> [Set PoolId] -> Set PoolId
forall a b. (a -> b) -> a -> b
$ (Set PoolId, Set [Char]) -> Set PoolId
forall a b. (a, b) -> a
fst ((Set PoolId, Set [Char]) -> Set PoolId)
-> [(Set PoolId, Set [Char])] -> [Set PoolId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Set PoolId, Set [Char])]
requiredByWaterfall, [Set [Char]] -> Set [Char]
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set [Char]] -> Set [Char]) -> [Set [Char]] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ (Set PoolId, Set [Char]) -> Set [Char]
forall a b. (a, b) -> b
snd ((Set PoolId, Set [Char]) -> Set [Char])
-> [(Set PoolId, Set [Char])] -> [Set [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Set PoolId, Set [Char])]
requiredByWaterfall)


validateReq :: (IR.UseRate a,P.Asset a) => TestDeal a -> AP.NonPerfAssumption -> (Bool,[ResultComponent])
validateReq :: forall a.
(UseRate a, Asset a) =>
TestDeal a -> NonPerfAssumption -> (Bool, [ResultComponent])
validateReq t :: TestDeal a
t@TestDeal{accounts :: forall a. TestDeal a -> Map [Char] Account
accounts = Map [Char] Account
accMap, fees :: forall a. TestDeal a -> Map [Char] Fee
fees = Map [Char] Fee
feeMap} 
            assump :: NonPerfAssumption
assump@A.NonPerfAssumption{interest :: NonPerfAssumption -> Maybe [RateAssumption]
A.interest = Maybe [RateAssumption]
intM, issueBondSchedule :: NonPerfAssumption -> Maybe [TsPoint IssueBondEvent]
A.issueBondSchedule = Maybe [TsPoint IssueBondEvent]
mIssuePlan, revolving :: NonPerfAssumption -> Maybe RevolvingAssumption
A.revolving = Maybe RevolvingAssumption
mRevolvingAssump} 
  = let 
      ratesRequired :: Set Index
ratesRequired = TestDeal a -> Set Index
forall a. (Asset a, UseRate a) => TestDeal a -> Set Index
extractRequiredRates TestDeal a
t
      ratesSupplied :: Set Index
ratesSupplied = case Maybe [RateAssumption]
intM of 
                        Maybe [RateAssumption]
Nothing -> Set Index
forall a. Set a
Set.empty
                        Just [RateAssumption]
intLst -> [Index] -> Set Index
forall a. Ord a => [a] -> Set a
Set.fromList ([Index] -> Set Index) -> [Index] -> Set Index
forall a b. (a -> b) -> a -> b
$ [ Index
idx | RateFlat Index
idx IRate
_ <- [RateAssumption]
intLst ] [Index] -> [Index] -> [Index]
forall a. [a] -> [a] -> [a]
++ [ Index
idx | RateCurve Index
idx Ts
_ <- [RateAssumption]
intLst ]
      missingIndex :: Set Index
missingIndex = Set Index -> Set Index -> Set Index
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Index
ratesRequired Set Index
ratesSupplied
      missingIndexError :: [ResultComponent]
missingIndexError = if Set Index -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Index
missingIndex then 
                            []
                          else
                            [[Char] -> ResultComponent
ErrorMsg ([Char]
"Failed to find index "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Set Index -> [Char]
forall a. Show a => a -> [Char]
show Set Index
missingIndex[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"in assumption rates"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set Index -> [Char]
forall a. Show a => a -> [Char]
show Set Index
ratesSupplied)]

      bgNamesInDeal :: Set [Char]
bgNamesInDeal = Map [Char] Bond -> Set [Char]
forall k a. Map k a -> Set k
Map.keysSet (Map [Char] Bond -> Set [Char]) -> Map [Char] Bond -> Set [Char]
forall a b. (a -> b) -> a -> b
$ Getting (Map [Char] Bond) (TestDeal a) (Map [Char] Bond)
-> TestDeal a -> Map [Char] Bond
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map [Char] Bond) (TestDeal a) (Map [Char] Bond)
forall a. Asset a => Lens' (TestDeal a) (Map [Char] Bond)
Lens' (TestDeal a) (Map [Char] Bond)
dealBondGroups TestDeal a
t
      -- fee validation 
      feeErrors :: [ResultComponent]
feeErrors = (Fee -> [ResultComponent]) -> [Fee] -> [ResultComponent]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Fee -> [ResultComponent]
validateFee ([Fee] -> [ResultComponent]) -> [Fee] -> [ResultComponent]
forall a b. (a -> b) -> a -> b
$ Map [Char] Fee -> [Fee]
forall k a. Map k a -> [a]
Map.elems Map [Char] Fee
feeMap
      -- issue plan validation
      issuePlanError :: [ResultComponent]
issuePlanError = case Maybe [TsPoint IssueBondEvent]
mIssuePlan of 
                        Maybe [TsPoint IssueBondEvent]
Nothing -> []
                        Just [TsPoint IssueBondEvent]
issueBndEventlist
                          -> let 
                              bgNamesInAssump :: Set [Char]
bgNamesInAssump = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList ([[Char]] -> Set [Char]) -> [[Char]] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ [ [Char]
bgName | TsPoint Date
d (A.IssueBondEvent Maybe Pre
_ [Char]
bgName [Char]
_ Bond
bnd Maybe BalanceFormula
_ Maybe BalanceFormula
_) <- [TsPoint IssueBondEvent]
issueBndEventlist ]
                              bgNameErrors :: [ResultComponent]
bgNameErrors = [ [Char] -> ResultComponent
ErrorMsg ([Char]
"issueBond:Missing Bond Group Name in Deal:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
missingBgName ) | [Char]
missingBgName <- Set [Char] -> [[Char]]
forall a. Set a -> [a]
Set.elems (Set [Char] -> Set [Char] -> Set [Char]
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set [Char]
bgNamesInAssump Set [Char]
bgNamesInDeal)]

                              newBndNames :: Set [Char]
newBndNames = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList ([[Char]] -> Set [Char]) -> [[Char]] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ [ Bond -> [Char]
L.bndName Bond
bnd | TsPoint Date
d (A.IssueBondEvent Maybe Pre
_ [Char]
_ [Char]
_ Bond
bnd Maybe BalanceFormula
_ Maybe BalanceFormula
_) <- [TsPoint IssueBondEvent]
issueBndEventlist ]
                              existingBndNames :: Set [Char]
existingBndNames = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList ([[Char]] -> Set [Char]) -> [[Char]] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestDeal a -> [Bond]
forall a. TestDeal a -> [Bond]
viewDealAllBonds TestDeal a
t
                              bndNameErrors :: [ResultComponent]
bndNameErrors = [ [Char] -> ResultComponent
ErrorMsg ([Char]
"issueBond:Existing Bond Name in Deal:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
existsBndName ) | [Char]
existsBndName <- Set [Char] -> [[Char]]
forall a. Set a -> [a]
Set.elems (Set [Char] -> Set [Char] -> Set [Char]
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set [Char]
newBndNames Set [Char]
existingBndNames)]

                              acNamesInAssump :: Set [Char]
acNamesInAssump = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList ([[Char]] -> Set [Char]) -> [[Char]] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ [ [Char]
acName | TsPoint Date
d (A.IssueBondEvent Maybe Pre
_ [Char]
_ [Char]
acName Bond
_ Maybe BalanceFormula
_ Maybe BalanceFormula
_) <- [TsPoint IssueBondEvent]
issueBndEventlist ]
                              existingAccNames :: Set [Char]
existingAccNames = Map [Char] Account -> Set [Char]
forall k a. Map k a -> Set k
Map.keysSet Map [Char] Account
accMap
                              accNameErrors :: [ResultComponent]
accNameErrors = [ [Char] -> ResultComponent
ErrorMsg ([Char]
"issueBond:Missing Account Name in Deal:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
missingAccName ) | [Char]
missingAccName <- Set [Char] -> [[Char]]
forall a. Set a -> [a]
Set.elems (Set [Char] -> Set [Char] -> Set [Char]
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set [Char]
acNamesInAssump Set [Char]
existingAccNames)]
                              
                              bndNamesInAssump :: [[Char]]
bndNamesInAssump = [ Bond -> [Char]
L.bndName Bond
bnd | TsPoint Date
d (A.IssueBondEvent Maybe Pre
_ [Char]
bgName [Char]
_ Bond
bnd Maybe BalanceFormula
_ Maybe BalanceFormula
_) <- [TsPoint IssueBondEvent]
issueBndEventlist ]
                              bndUniqNames :: Set [Char]
bndUniqNames = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [[Char]]
bndNamesInAssump
                              dupNamesErrors :: [ResultComponent]
dupNamesErrors = [ [Char] -> ResultComponent
ErrorMsg([Char]
"Duplicate Bond Names in Funding Plan") | Set [Char] -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set [Char]
bndUniqNames Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
bndNamesInAssump]
                             in 
                              [ResultComponent]
bgNameErrors [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
accNameErrors [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
bndNameErrors [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
dupNamesErrors

      -- revolving buy validation
      revolvingBuyError :: [ResultComponent]
revolvingBuyError = let 
                            (Set PoolId
requiredPoolIds, Set [Char]
requiredRPoolNames) =  TestDeal a -> (Set PoolId, Set [Char])
forall a. Asset a => TestDeal a -> (Set PoolId, Set [Char])
extractRequiredRevolvingPool TestDeal a
t
                            a :: Integer
a = Integer
1 
                          in 
                            case Maybe RevolvingAssumption
mRevolvingAssump of 
                              Maybe RevolvingAssumption
Nothing -> []
                              Just (A.AvailableAssets RevolvingPool
_ ApplyAssumptionType
_ ) -> [ [Char] -> ResultComponent
ErrorMsg ([Char]
"BuyAsset: Missing Pool Id in assumption" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PoolId -> [Char]
forall a. Show a => a -> [Char]
show PoolId
x)  | PoolId
x <- Set PoolId -> [PoolId]
forall a. Set a -> [a]
Set.toList (Set PoolId
requiredPoolIds Set PoolId -> Set PoolId -> Set PoolId
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ [PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList (TestDeal a -> [PoolId]
forall a. Asset a => TestDeal a -> [PoolId]
getPoolIds TestDeal a
t))]
                              Just (A.AvailableAssetsBy Map [Char] (RevolvingPool, ApplyAssumptionType)
rMap ) -> [ [Char] -> ResultComponent
ErrorMsg ([Char]
"BuyAsset: Missing Revolving Pool in assumption" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
x)  | [Char]
x <- Set [Char] -> [[Char]]
forall a. Set a -> [a]
Set.toList (Set [Char]
requiredRPoolNames Set [Char] -> Set [Char] -> Set [Char]
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList (Map [Char] (RevolvingPool, ApplyAssumptionType) -> [[Char]]
forall k a. Map k a -> [k]
Map.keys Map [Char] (RevolvingPool, ApplyAssumptionType)
rMap))] -- `debug` ("requiredRPoolNames 0> "++ show requiredRPoolNames)


      ([ResultComponent]
dealWarnings,[ResultComponent]
dealErrors) = TestDeal a -> ([ResultComponent], [ResultComponent])
forall a.
Asset a =>
TestDeal a -> ([ResultComponent], [ResultComponent])
validatePreRun TestDeal a
t 
      finalErrors :: [ResultComponent]
finalErrors = [ResultComponent]
missingIndexError [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
dealErrors [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
issuePlanError [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
feeErrors [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
revolvingBuyError
      finalWarnings :: [ResultComponent]
finalWarnings = [ResultComponent]
dealWarnings
    in 
      ([ResultComponent] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ResultComponent]
finalErrors,[ResultComponent]
finalErrors[ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++[ResultComponent]
finalWarnings)

validatePreRun :: P.Asset a => TestDeal a -> ([ResultComponent],[ResultComponent])
validatePreRun :: forall a.
Asset a =>
TestDeal a -> ([ResultComponent], [ResultComponent])
validatePreRun t :: TestDeal a
t@TestDeal{waterfall :: forall a. TestDeal a -> Map ActionWhen [Action]
waterfall=Map ActionWhen [Action]
waterfallM
                      ,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts =Map [Char] Account
accM 
                      ,fees :: forall a. TestDeal a -> Map [Char] Fee
fees = Map [Char] Fee
feeM 
                      ,bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds = Map [Char] Bond
bondM 
                      ,collects :: forall a. TestDeal a -> [CollectionRule]
collects = [CollectionRule]
aggRule 
                      ,liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider = Maybe (Map [Char] LiqFacility)
liqProviderM 
                      ,rateSwap :: forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap = Maybe (Map [Char] RateSwap)
rsM 
                      ,rateCap :: forall a. TestDeal a -> Maybe (Map [Char] RateCap)
rateCap = Maybe (Map [Char] RateCap)
rcM 
                      ,triggers :: forall a. TestDeal a -> Maybe (Map DealCycle (Map [Char] Trigger))
triggers = Maybe (Map DealCycle (Map [Char] Trigger))
triggerM
                      ,ledgers :: forall a. TestDeal a -> Maybe (Map [Char] Ledger)
ledgers = Maybe (Map [Char] Ledger)
ledgerM
                      ,pool :: forall a. TestDeal a -> PoolType a
pool = PoolType a
pool 
                      ,dates :: forall a. TestDeal a -> DateDesp
dates = DateDesp
dates
                      ,status :: forall a. TestDeal a -> DealStatus
status = DealStatus
status} 
  = let 
      accKeys :: Set [Char]
accKeys = Map [Char] Account -> Set [Char]
forall k a. Map k a -> Set k
Map.keysSet Map [Char] Account
accM
      bndKeys :: Set [Char]
bndKeys = Map [Char] Bond -> Set [Char]
forall k a. Map k a -> Set k
Map.keysSet Map [Char] Bond
bondM 
      bgNames :: Set [Char]
bgNames = Map [Char] Bond -> Set [Char]
forall k a. Map k a -> Set k
Map.keysSet (Map [Char] Bond -> Set [Char]) -> Map [Char] Bond -> Set [Char]
forall a b. (a -> b) -> a -> b
$ Getting (Map [Char] Bond) (TestDeal a) (Map [Char] Bond)
-> TestDeal a -> Map [Char] Bond
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map [Char] Bond) (TestDeal a) (Map [Char] Bond)
forall a. Asset a => Lens' (TestDeal a) (Map [Char] Bond)
Lens' (TestDeal a) (Map [Char] Bond)
dealBondGroups TestDeal a
t
      feeKeys :: Set [Char]
feeKeys = Map [Char] Fee -> Set [Char]
forall k a. Map k a -> Set k
Map.keysSet Map [Char] Fee
feeM
      waterfallKeys :: Set ActionWhen
waterfallKeys = Map ActionWhen [Action] -> Set ActionWhen
forall k a. Map k a -> Set k
Map.keysSet Map ActionWhen [Action]
waterfallM
      liqProviderKeys :: Set [Char]
liqProviderKeys = Set [Char]
-> (Map [Char] LiqFacility -> Set [Char])
-> Maybe (Map [Char] LiqFacility)
-> Set [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set [Char]
forall a. Set a
Set.empty Map [Char] LiqFacility -> Set [Char]
forall k a. Map k a -> Set k
Map.keysSet Maybe (Map [Char] LiqFacility)
liqProviderM
      rateSwapKeys :: Set [Char]
rateSwapKeys = Set [Char]
-> (Map [Char] RateSwap -> Set [Char])
-> Maybe (Map [Char] RateSwap)
-> Set [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set [Char]
forall a. Set a
Set.empty Map [Char] RateSwap -> Set [Char]
forall k a. Map k a -> Set k
Map.keysSet Maybe (Map [Char] RateSwap)
rsM
      rateCapKeys :: Set [Char]
rateCapKeys = Set [Char]
-> (Map [Char] RateCap -> Set [Char])
-> Maybe (Map [Char] RateCap)
-> Set [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set [Char]
forall a. Set a
Set.empty Map [Char] RateCap -> Set [Char]
forall k a. Map k a -> Set k
Map.keysSet Maybe (Map [Char] RateCap)
rcM
      ledgerKeys :: Set [Char]
ledgerKeys = Set [Char]
-> (Map [Char] Ledger -> Set [Char])
-> Maybe (Map [Char] Ledger)
-> Set [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set [Char]
forall a. Set a
Set.empty Map [Char] Ledger -> Set [Char]
forall k a. Map k a -> Set k
Map.keysSet Maybe (Map [Char] Ledger)
ledgerM
      triggerKeys :: Set DealCycle
triggerKeys = Set DealCycle
-> (Map DealCycle (Map [Char] Trigger) -> Set DealCycle)
-> Maybe (Map DealCycle (Map [Char] Trigger))
-> Set DealCycle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set DealCycle
forall a. Set a
Set.empty Map DealCycle (Map [Char] Trigger) -> Set DealCycle
forall k a. Map k a -> Set k
Map.keysSet Maybe (Map DealCycle (Map [Char] Trigger))
triggerM
      poolKeys :: Set PoolId
poolKeys = [PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList ([PoolId] -> Set PoolId) -> [PoolId] -> Set PoolId
forall a b. (a -> b) -> a -> b
$ TestDeal a -> [PoolId]
forall a. Asset a => TestDeal a -> [PoolId]
getPoolIds TestDeal a
t
      rPoolKeys :: Set [Char]
rPoolKeys = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [] -- $ maybe Set.empty (Set.fromList . Map.keys) pool
      poolIds :: [PoolId]
poolIds = TestDeal a -> [PoolId]
forall a. Asset a => TestDeal a -> [PoolId]
getPoolIds TestDeal a
t 
      -- date check

      -- issuance balance check 
      issuanceBalCheck :: DateDesp -> [ResultComponent]
issuanceBalCheck CurrentDates {} = let 
                                           stats :: [Map CutoffFields Balance]
stats = Map PoolId (Map CutoffFields Balance) -> [Map CutoffFields Balance]
forall k a. Map k a -> [a]
Map.elems (Map PoolId (Map CutoffFields Balance)
 -> [Map CutoffFields Balance])
-> Map PoolId (Map CutoffFields Balance)
-> [Map CutoffFields Balance]
forall a b. (a -> b) -> a -> b
$ TestDeal a
-> Maybe [PoolId] -> Map PoolId (Map CutoffFields Balance)
forall a.
Asset a =>
TestDeal a
-> Maybe [PoolId] -> Map PoolId (Map CutoffFields Balance)
getIssuanceStats TestDeal a
t Maybe [PoolId]
forall a. Maybe a
Nothing
                                           lookupResult :: [Maybe Balance]
lookupResult = CutoffFields -> Map CutoffFields Balance -> Maybe Balance
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CutoffFields
IssuanceBalance (Map CutoffFields Balance -> Maybe Balance)
-> [Map CutoffFields Balance] -> [Maybe Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Map CutoffFields Balance]
stats
                                         in
                                           if (Maybe Balance -> Bool) -> [Maybe Balance] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe Balance -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe Balance]
lookupResult then
                                             [[Char] -> ResultComponent
ErrorMsg [Char]
"Issuance balance not found for a Ongoing Deal"]
                                           else
                                             []
      issuanceBalCheck DateDesp
_ = []

      -- val on deal status and deal dates

      -- collection rule check
      aggRuleResult :: [ResultComponent]
aggRuleResult = if TestDeal a -> Bool
forall a. SPV a => a -> Bool
isResec TestDeal a
t then 
                        []
                      else
                        [CollectionRule] -> [PoolId] -> [ResultComponent]
validateAggRule [CollectionRule]
aggRule [PoolId]
poolIds 
      -- TODO : collectCash shouldn't overlap with others

      -- waterfall key not exists test error
      errors :: [[ResultComponent]]
errors = (\[Action]
x -> [Action]
-> [ResultComponent]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set [Char]
-> Set PoolId
-> [ResultComponent]
validateAction [Action]
x [] Set [Char]
accKeys Set [Char]
bndKeys Set [Char]
bgNames Set [Char]
feeKeys Set [Char]
liqProviderKeys Set [Char]
rateSwapKeys Set [Char]
rateCapKeys Set [Char]
ledgerKeys Set [Char]
rPoolKeys Set PoolId
poolKeys) ([Action] -> [ResultComponent])
-> [[Action]] -> [[ResultComponent]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map ActionWhen [Action] -> [[Action]]
forall k a. Map k a -> [a]
Map.elems Map ActionWhen [Action]
waterfallM 

      -- waterfall action coverage check 

      -- run result scan

      allErrors :: [ResultComponent]
allErrors = ([[ResultComponent]] -> [ResultComponent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ResultComponent]]
errors) [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ DateDesp -> [ResultComponent]
issuanceBalCheck DateDesp
dates [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
aggRuleResult 
      -- check issuance balance 
      
      w1 :: [ResultComponent]
w1 = if (Bool -> Bool
not (TestDeal a -> Bool
forall a. TestDeal a -> Bool
isPreClosing TestDeal a
t)) Bool -> Bool -> Bool
&& ([Map CutoffFields Balance] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Map PoolId (Map CutoffFields Balance) -> [Map CutoffFields Balance]
forall k a. Map k a -> [a]
Map.elems (TestDeal a
-> Maybe [PoolId] -> Map PoolId (Map CutoffFields Balance)
forall a.
Asset a =>
TestDeal a
-> Maybe [PoolId] -> Map PoolId (Map CutoffFields Balance)
getIssuanceStats TestDeal a
t Maybe [PoolId]
forall a. Maybe a
Nothing))) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
             [[Char] -> ResultComponent
WarningMsg [Char]
"Deal passes PreClosing status, but not cumulative defaults/delinq at cutoff date?"]
           else 
             []
      warnings :: [ResultComponent]
warnings = [ResultComponent]
w1
    in 
      ([ResultComponent]
warnings,[ResultComponent]
allErrors) -- Valiation Pass

-- validate deal object after run
validateRun :: TestDeal a -> [ResultComponent]
validateRun :: forall a. TestDeal a -> [ResultComponent]
validateRun t :: TestDeal a
t@TestDeal{waterfall :: forall a. TestDeal a -> Map ActionWhen [Action]
waterfall=Map ActionWhen [Action]
waterfallM
                      ,accounts :: forall a. TestDeal a -> Map [Char] Account
accounts =Map [Char] Account
accM 
                      ,fees :: forall a. TestDeal a -> Map [Char] Fee
fees = Map [Char] Fee
feeM 
                      ,bonds :: forall a. TestDeal a -> Map [Char] Bond
bonds = Map [Char] Bond
bondM 
                      ,collects :: forall a. TestDeal a -> [CollectionRule]
collects = [CollectionRule]
aggRule 
                      ,liqProvider :: forall a. TestDeal a -> Maybe (Map [Char] LiqFacility)
liqProvider = Maybe (Map [Char] LiqFacility)
liqProviderM 
                      ,rateSwap :: forall a. TestDeal a -> Maybe (Map [Char] RateSwap)
rateSwap = Maybe (Map [Char] RateSwap)
rsM 
                      ,triggers :: forall a. TestDeal a -> Maybe (Map DealCycle (Map [Char] Trigger))
triggers = Maybe (Map DealCycle (Map [Char] Trigger))
triggerM
                      ,ledgers :: forall a. TestDeal a -> Maybe (Map [Char] Ledger)
ledgers = Maybe (Map [Char] Ledger)
ledgerM} 
  = let 
      bndList :: [Bond]
bndList = TestDeal a -> [Bond]
forall a. TestDeal a -> [Bond]
viewDealAllBonds TestDeal a
t
      -- oustanding liability
      --- bond
      bondWarnings :: [ResultComponent]
bondWarnings = [ [Char] -> ResultComponent
WarningMsg ([Char]
"Bond "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
bn[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is not paid off")  | [Char]
bn <- Bond -> [Char]
L.bndName (Bond -> [Char]) -> [Bond] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bond -> Bool) -> [Bond] -> [Bond]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Bond -> Bool) -> Bond -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bond -> Bool
forall lb. Liable lb => lb -> Bool
isPaidOff) [Bond]
bndList ]
      --- fee
      feeWarnings :: [ResultComponent]
feeWarnings = [ [Char] -> ResultComponent
WarningMsg ([Char]
"Fee "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
fn[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is not paid off")  | [Char]
fn <- Map [Char] [Char] -> [[Char]]
forall k a. Map k a -> [a]
Map.elems ((Fee -> [Char]) -> Map [Char] Fee -> Map [Char] [Char]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Fee -> [Char]
F.feeName (Map [Char] Fee -> Map [Char] [Char])
-> Map [Char] Fee -> Map [Char] [Char]
forall a b. (a -> b) -> a -> b
$ (Fee -> Bool) -> Map [Char] Fee -> Map [Char] Fee
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (Fee -> Bool) -> Fee -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fee -> Bool
forall lb. Liable lb => lb -> Bool
isPaidOff) Map [Char] Fee
feeM) ]
      --- liquidity provider 
      liqWarnings :: [ResultComponent]
liqWarnings = case Maybe (Map [Char] LiqFacility)
liqProviderM of 
                      Maybe (Map [Char] LiqFacility)
Nothing -> []
                      Just Map [Char] LiqFacility
liqM -> [ [Char] -> ResultComponent
WarningMsg ([Char]
"LiquidityProvider "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
bn[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is not paid off")  | [Char]
bn <- Map [Char] [Char] -> [[Char]]
forall k a. Map k a -> [a]
Map.elems ((LiqFacility -> [Char])
-> Map [Char] LiqFacility -> Map [Char] [Char]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map LiqFacility -> [Char]
CE.liqName (Map [Char] LiqFacility -> Map [Char] [Char])
-> Map [Char] LiqFacility -> Map [Char] [Char]
forall a b. (a -> b) -> a -> b
$ (LiqFacility -> Bool)
-> Map [Char] LiqFacility -> Map [Char] LiqFacility
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (LiqFacility -> Bool) -> LiqFacility -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiqFacility -> Bool
forall lb. Liable lb => lb -> Bool
isPaidOff)  Map [Char] LiqFacility
liqM) ]
      --- rate swap
      rsWarnings :: [ResultComponent]
rsWarnings = case Maybe (Map [Char] RateSwap)
rsM of 
                     Maybe (Map [Char] RateSwap)
Nothing -> []
                     Just Map [Char] RateSwap
rsM -> []   -- TODO [ WarningMsg ("LiquidityProvider "++bn++ " is not paid off")  | bn <- Map.elems (Map.map CE.liqName $ Map.filter (not . isPaidOff)  rsM) ]

      -- oustanding assets
      --- account
      accWarnings :: [ResultComponent]
accWarnings = [ [Char] -> ResultComponent
WarningMsg ([Char]
"Account "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
an[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" has cash to be distributed")  | [Char]
an <- Map [Char] [Char] -> [[Char]]
forall k a. Map k a -> [a]
Map.elems ((Account -> [Char]) -> Map [Char] Account -> Map [Char] [Char]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Account -> [Char]
A.accName (Map [Char] Account -> Map [Char] [Char])
-> Map [Char] Account -> Map [Char] [Char]
forall a b. (a -> b) -> a -> b
$ (Account -> Bool) -> Map [Char] Account -> Map [Char] Account
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\Account
x -> Account -> Balance
A.accBalance Account
x Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
> Balance
0) Map [Char] Account
accM)]
      --- uncollected pool cash

      -- run result scan
    in 
      [ResultComponent]
bondWarnings [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
feeWarnings [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
accWarnings [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
liqWarnings [ResultComponent] -> [ResultComponent] -> [ResultComponent]
forall a. [a] -> [a] -> [a]
++ [ResultComponent]
rsWarnings