Skip to content

Commit 7c41c51

Browse files
functorafunctora
committed
wip
1 parent 8f00b93 commit 7c41c51

File tree

21 files changed

+498
-827
lines changed

21 files changed

+498
-827
lines changed

‎prv‎

Submodule prv updated from 86c1bfd to 7032004

‎pub/bfx/src/Bfx.hs‎

Lines changed: 80 additions & 90 deletions
Original file line numberDiff line numberDiff line change
@@ -65,23 +65,22 @@ symbolsDetails =
6565
Generic.pub @'SymbolsDetails [] ()
6666

6767
marketAveragePrice ::
68-
forall (act :: BuyOrSell) m.
68+
forall (bos :: BuyOrSell) m.
6969
( MonadUnliftIO m,
7070
MonadThrow m,
71-
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| act)),
72-
Typeable act
71+
SingI bos
7372
) =>
74-
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| act) ->
73+
MoneyAmount ->
7574
CurrencyPair ->
76-
m (Money (Tags 'Unsigned |+| 'QuotePerBase |+| act))
77-
marketAveragePrice amt sym =
75+
m QuotePerBase
76+
marketAveragePrice baseAmt sym =
7877
Generic.pub
7978
@'MarketAveragePrice
80-
[ SomeQueryParam "amount" amt,
79+
[ SomeQueryParam "amount" (demote @bos, Base, baseAmt),
8180
SomeQueryParam "symbol" sym
8281
]
8382
MarketAveragePrice.Request
84-
{ MarketAveragePrice.amount = amt,
83+
{ MarketAveragePrice.baseAmount = baseAmt,
8584
MarketAveragePrice.symbol = sym
8685
}
8786

@@ -119,9 +118,9 @@ spendableExchangeBalance ::
119118
) =>
120119
Env ->
121120
CurrencyCode ->
122-
m (Money (Tags 'Unsigned |+| 'MoneyAmount))
121+
m MoneyAmount
123122
spendableExchangeBalance env cc =
124-
maybe (Tagged 0) Wallets.availableBalance
123+
maybe (MoneyAmount 0) Wallets.availableBalance
125124
. Map.lookup Wallets.Exchange
126125
. Map.findWithDefault mempty cc
127126
<$> wallets env
@@ -215,8 +214,8 @@ verifyOrder env id0 req = do
215214
orderClientId =
216215
SubmitOrder.clientId opts
217216
<|> orderClientId remOrd,
218-
orderAmount =
219-
SubmitOrder.amount req,
217+
orderBaseAmount =
218+
SubmitOrder.baseAmount req,
220219
orderSymbol =
221220
SubmitOrder.symbol req,
222221
orderRate =
@@ -239,21 +238,21 @@ submitOrder ::
239238
forall (bos :: BuyOrSell) m.
240239
( MonadUnliftIO m,
241240
MonadThrow m,
242-
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos)),
243-
ToRequestParam (Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos)),
241+
-- ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos)),
242+
-- ToRequestParam (Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos)),
244243
Typeable bos,
245244
SingI bos
246245
) =>
247246
Env ->
248-
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos) ->
247+
MoneyAmount ->
249248
CurrencyPair ->
250-
Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos) ->
249+
QuotePerBase ->
251250
SubmitOrder.Options bos ->
252251
m (Order bos 'Remote)
253-
submitOrder env amt sym rate opts = do
252+
submitOrder env baseAmt sym rate opts = do
254253
let req =
255254
SubmitOrder.Request
256-
{ SubmitOrder.amount = amt,
255+
{ SubmitOrder.baseAmount = baseAmt,
257256
SubmitOrder.symbol = sym,
258257
SubmitOrder.rate = rate,
259258
SubmitOrder.options = opts
@@ -265,20 +264,22 @@ submitOrderMaker ::
265264
forall (bos :: BuyOrSell) m.
266265
( MonadUnliftIO m,
267266
MonadThrow m,
268-
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos)),
269-
ToRequestParam (Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos)),
270-
MoneyTags (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos),
271-
MoneyTags (Tags 'Unsigned |+| 'QuotePerBase |+| bos),
272-
HasTag bos (Tags 'Unsigned |+| 'QuotePerBase |+| bos)
267+
Typeable bos,
268+
SingI bos
269+
-- ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos)),
270+
-- ToRequestParam (Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos)),
271+
-- MoneyTags (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos),
272+
-- MoneyTags (Tags 'Unsigned |+| 'QuotePerBase |+| bos),
273+
-- HasTag bos (Tags 'Unsigned |+| 'QuotePerBase |+| bos)
273274
) =>
274275
Env ->
275-
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos) ->
276+
MoneyAmount ->
276277
CurrencyPair ->
277-
Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos) ->
278+
QuotePerBase ->
278279
SubmitOrder.Options bos ->
279280
m (Order bos 'Remote)
280-
submitOrderMaker env amt sym rate0 opts0 =
281-
submitOrderMakerRec @bos env amt sym 0 rate0 opts
281+
submitOrderMaker env baseAmt sym rate0 opts0 =
282+
submitOrderMakerRec @bos env baseAmt sym 0 rate0 opts
282283
where
283284
opts =
284285
opts0
@@ -290,30 +291,32 @@ submitOrderMakerRec ::
290291
forall (bos :: BuyOrSell) m.
291292
( MonadUnliftIO m,
292293
MonadThrow m,
293-
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos)),
294-
ToRequestParam (Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos)),
295-
MoneyTags (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos),
296-
MoneyTags (Tags 'Unsigned |+| 'QuotePerBase |+| bos),
297-
HasTag bos (Tags 'Unsigned |+| 'QuotePerBase |+| bos)
294+
Typeable bos,
295+
SingI bos
296+
-- ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos)),
297+
-- ToRequestParam (Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos)),
298+
-- MoneyTags (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos),
299+
-- MoneyTags (Tags 'Unsigned |+| 'QuotePerBase |+| bos),
300+
-- HasTag bos (Tags 'Unsigned |+| 'QuotePerBase |+| bos)
298301
) =>
299302
Env ->
300-
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos) ->
303+
MoneyAmount ->
301304
CurrencyPair ->
302305
Int ->
303-
Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos) ->
306+
QuotePerBase ->
304307
SubmitOrder.Options bos ->
305308
m (Order bos 'Remote)
306-
submitOrderMakerRec env amt sym attempt rate opts = do
307-
order :: Order bos 'Remote <- submitOrder @bos env amt sym rate opts
309+
submitOrderMakerRec env baseAmt sym attempt rate opts = do
310+
order :: Order bos 'Remote <- submitOrder @bos env baseAmt sym rate opts
308311
if orderStatus order /= PostOnlyCancelled
309312
then pure order
310313
else do
311314
when (attempt >= 10)
312315
. throw
313316
. ErrorOrderState
314317
$ SomeOrder (sing :: Sing bos) order
315-
newRate <- Math.tweakMakerRate rate
316-
submitOrderMakerRec env amt sym (attempt + 1) newRate opts
318+
newRate <- Math.tweakMakerRate (demote @bos) rate
319+
submitOrderMakerRec env baseAmt sym (attempt + 1) newRate opts
317320

318321
cancelOrderMulti ::
319322
( MonadUnliftIO m,
@@ -376,9 +379,10 @@ submitCounterOrder ::
376379
) =>
377380
Env ->
378381
OrderId ->
379-
Money (Tags 'Unsigned |+| 'FeeRate |+| 'Base) ->
380-
Money (Tags 'Unsigned |+| 'FeeRate |+| 'Quote) ->
381-
Money (Tags 'Unsigned |+| 'ProfitRate) ->
382+
(MoneyAmount -> QuotePerBase -> Math.CounterArgs) ->
383+
-- Money (Tags 'Unsigned |+| 'FeeRate |+| 'Base) ->
384+
-- Money (Tags 'Unsigned |+| 'FeeRate |+| 'Quote) ->
385+
-- Money (Tags 'Unsigned |+| 'ProfitRate) ->
382386
SubmitOrder.Options 'Sell ->
383387
m (Order 'Sell 'Remote)
384388
submitCounterOrder =
@@ -390,9 +394,7 @@ submitCounterOrderMaker ::
390394
) =>
391395
Env ->
392396
OrderId ->
393-
Money (Tags 'Unsigned |+| 'FeeRate |+| 'Base) ->
394-
Money (Tags 'Unsigned |+| 'FeeRate |+| 'Quote) ->
395-
Money (Tags 'Unsigned |+| 'ProfitRate) ->
397+
(MoneyAmount -> QuotePerBase -> Math.CounterArgs) ->
396398
SubmitOrder.Options 'Sell ->
397399
m (Order 'Sell 'Remote)
398400
submitCounterOrderMaker =
@@ -403,37 +405,33 @@ submitCounterOrder' ::
403405
MonadThrow m
404406
) =>
405407
( Env ->
406-
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| 'Sell) ->
408+
MoneyAmount ->
407409
CurrencyPair ->
408-
Money (Tags 'Unsigned |+| 'QuotePerBase |+| 'Sell) ->
410+
QuotePerBase ->
409411
SubmitOrder.Options 'Sell ->
410412
m (Order 'Sell 'Remote)
411413
) ->
412414
Env ->
413415
OrderId ->
414-
Money (Tags 'Unsigned |+| 'FeeRate |+| 'Base) ->
415-
Money (Tags 'Unsigned |+| 'FeeRate |+| 'Quote) ->
416-
Money (Tags 'Unsigned |+| 'ProfitRate) ->
416+
(MoneyAmount -> QuotePerBase -> Math.CounterArgs) ->
417417
SubmitOrder.Options 'Sell ->
418418
m (Order 'Sell 'Remote)
419-
submitCounterOrder' submit env id0 feeB feeQ prof opts = do
419+
submitCounterOrder' submit env id0 mkCounter opts = do
420420
someRemOrd@(SomeOrder remSing remOrder) <- getOrder env id0
421+
let sym = orderSymbol remOrder
421422
case remSing of
422423
SBuy | orderStatus remOrder == Executed -> do
423-
(_, exitAmt, exitRate) <-
424+
counter <-
424425
Math.newCounterOrder
425-
(tag @'Gross (orderAmount remOrder))
426-
(tag @'Net (orderRate remOrder))
427-
feeB
428-
feeQ
429-
(tag @'Quote . tag @'Buy $ tag @'Net prof)
430-
currentRate <-
431-
marketAveragePrice (unTag @'Net exitAmt)
432-
$ orderSymbol remOrder
426+
. mkCounter (orderBaseAmount remOrder)
427+
$ orderRate remOrder
428+
let exitAmt = Math.counterExitNetBaseLoss counter
429+
let exitRate = Math.counterExitQuotePerBase counter
430+
currentRate <- marketAveragePrice @'Sell exitAmt sym
433431
submit
434432
env
435-
(unTag @'Net exitAmt)
436-
(orderSymbol remOrder)
433+
exitAmt
434+
sym
437435
(max exitRate currentRate)
438436
opts
439437
_ ->
@@ -445,9 +443,9 @@ dumpIntoQuote' ::
445443
MonadThrow m
446444
) =>
447445
( Env ->
448-
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| 'Sell) ->
446+
MoneyAmount ->
449447
CurrencyPair ->
450-
Money (Tags 'Unsigned |+| 'QuotePerBase |+| 'Sell) ->
448+
QuotePerBase ->
451449
SubmitOrder.Options 'Sell ->
452450
m (Order 'Sell 'Remote)
453451
) ->
@@ -457,12 +455,12 @@ dumpIntoQuote' ::
457455
m (Order 'Sell 'Remote)
458456
dumpIntoQuote' submit env sym opts = do
459457
amt <- spendableExchangeBalance env (currencyPairBase sym)
460-
rate <- marketAveragePrice (tag @'Sell $ tag @'Base amt) sym
458+
rate <- marketAveragePrice @'Sell amt sym
461459
catchAny
462-
(submit env (tag @'Sell $ tag @'Base amt) sym rate opts)
460+
(submit env amt sym rate opts)
463461
. const
464462
$ do
465-
newAmt <- Math.tweakMoneyPip (tag @'Sell $ tag @'Base amt)
463+
newAmt <- Math.tweakMoneyPip Sell amt
466464
submit env newAmt sym rate opts
467465

468466
dumpIntoQuote ::
@@ -493,7 +491,7 @@ netWorth ::
493491
) =>
494492
Env ->
495493
CurrencyCode ->
496-
m (Money (Tags 'Unsigned |+| 'MoneyAmount))
494+
m MoneyAmount
497495
netWorth env ccq = do
498496
-- Simplify fees (assume it's alwayus Maker and Crypto2Crypto)
499497
fee <- FeeSummary.makerCrypto2CryptoFee <$> feeSummary env
@@ -502,42 +500,34 @@ netWorth env ccq = do
502500
res <-
503501
foldrM
504502
( \(ccb, bs1) totalAcc -> do
505-
let localAcc :: Money (Tags 'Unsigned |+| 'MoneyAmount) =
503+
let localAcc =
506504
foldr
507505
( \amt acc ->
508-
Wallets.balance amt `addMoney` acc
506+
unMoneyAmount (Wallets.balance amt) + acc
509507
)
510-
(Tagged 0)
508+
0
511509
$ Map.elems bs1
512510
if ccb == ccq
513-
then pure $ totalAcc `addMoney` localAcc
511+
then pure $ totalAcc + localAcc
514512
else do
515513
-- In this case we are dealing with Base
516514
-- money, so we need transform from Quote
517515
sym <- currencyPairCon (from ccb) $ Tagged @'Quote ccq
518-
baseMoney ::
519-
Money (Tags 'Unsigned |+| 'Base |+| 'Sell |+| 'MoneyAmount) <-
520-
fmap (tag @'Base . tag @'Sell) $ roundMoney localAcc
521-
if baseMoney == Tagged 0
516+
baseMoney <- roundMoneyAmount $ MoneyAmount localAcc
517+
if baseMoney == MoneyAmount 0
522518
then pure totalAcc
523519
else do
524-
price :: Money (Tags 'Unsigned |+| 'QuotePerBase |+| 'Sell) <-
525-
marketAveragePrice baseMoney sym
520+
price <-
521+
marketAveragePrice @'Sell baseMoney sym
526522
pure
527-
. addMoney totalAcc
528-
. unTag @'Net
529-
. unTag @'Sell
530-
. unTag @'Quote
531-
$ deductFee
532-
@(Tags 'Unsigned |+| 'FeeRate |+| 'Maker)
533-
fee
534-
( tag @'Gross
535-
$ exchangeMoney @(Tags 'Unsigned |+| 'Sell)
536-
price
537-
baseMoney
523+
$ ( totalAcc
524+
+ ( unMoneyAmount baseMoney
525+
* unQuotePerBase price
526+
* (1 - unFeeRate fee)
527+
)
538528
)
539529
)
540-
(Tagged 0)
530+
0
541531
. filter
542532
( \(cc, _) ->
543533
fromRight
@@ -548,7 +538,7 @@ netWorth env ccq = do
548538
|| (cc == ccq)
549539
)
550540
$ Map.assocs xs0
551-
roundMoney res
541+
roundMoneyAmount $ MoneyAmount res
552542

553543
candlesLast ::
554544
( MonadUnliftIO m,

0 commit comments

Comments
 (0)