/
Backend.hs
544 lines (521 loc) · 22.6 KB
/
Backend.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Backend where
import Control.Concurrent
import Control.Exception
import Control.Monad.Identity
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader
import Data.Aeson.Lens
import qualified Data.Aeson as Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Dependent.Sum
import Data.Int (Int32)
import qualified Data.Map as Map
import Data.Maybe
import Data.Pool
import Data.Proxy
import Data.Scientific (coefficient)
import Data.Semigroup (First(..))
import Data.Text (Text)
import Data.Time.Clock
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import Data.Vessel
import Database.Beam (MonadBeam)
import Database.Beam.Backend.SQL.BeamExtensions
import Database.Beam.Postgres
import Database.Beam.Query
import Database.Beam.Schema.Tables (primaryKey)
import qualified Database.PostgreSQL.Simple as Pg
import Gargoyle.PostgreSQL.Connect
import Obelisk.Backend
import Obelisk.Route
import Rhyolite.Backend.App
import Rhyolite.Backend.DB
import Rhyolite.Backend.DB.Serializable
import Rhyolite.Backend.Listen
import Rhyolite.Concurrent
import Safe (lastMay)
import Statistics.Regression
import Backend.Notification
import Backend.Schema
import Common.Api
import Common.Route
import Common.Schema
import Common.Plutus.Contracts.Uniswap.Types
import Network.HTTP.Client hiding (Proxy)
import qualified Network.WebSockets as WS
import Control.Lens
backend :: Backend BackendRoute FrontendRoute
backend = Backend
{ _backend_run = \serve -> do
httpManager <- newManager defaultManagerSettings
withDb "db" $ \pool -> do
withResource pool runMigrations
stopSyncUniswapUsers <- worker (1000 * 1000 * 5) $ syncUniswapUsers httpManager pool
stopSyncPooledTokens <- worker (1000 * 1000 * 5) $ syncPooledTokens httpManager pool
(handleListen, finalizeServeDb) <- serveDbOverWebsockets
pool
(requestHandler httpManager pool)
(\(nm :: DbNotification Notification) q ->
fmap (fromMaybe emptyV) $ mapDecomposedV (notifyHandler nm) q)
(QueryHandler $ \q -> fmap (fromMaybe emptyV) $ mapDecomposedV (queryHandler pool) q)
vesselFromWire
vesselPipeline -- (tracePipeline "==> " . vesselPipeline)
flip finally (stopSyncPooledTokens >> stopSyncUniswapUsers >> finalizeServeDb) $ serve $ \case
BackendRoute_Listen :/ () -> handleListen
_ -> return ()
, _backend_routeEncoder = fullRouteEncoder
}
-- | Handle requests / commands, a standard part of Obelisk apps.
requestHandler :: Manager -> Pool Pg.Connection -> RequestHandler Api IO
requestHandler httpManager pool = RequestHandler $ \case
Api_Swap contractId coinA coinB amountA amountB ->
executeSwap httpManager pool (T.unpack $ unContractInstanceId contractId) (coinA, amountA) (coinB, amountB)
Api_Stake contractId coinA coinB amountA amountB ->
executeStake httpManager (T.unpack $ unContractInstanceId contractId) (coinA, amountA) (coinB, amountB)
Api_RedeemLiquidity contractId coinA coinB amount ->
executeRemove httpManager (T.unpack $ unContractInstanceId contractId) coinA coinB amount
Api_CallFunds cid -> callFunds httpManager cid
Api_CallPools cid -> callPools httpManager cid
Api_EstimateTransactionFee action -> estimateTransactionFee pool action
notifyHandler :: DbNotification Notification -> DexV Proxy -> IO (DexV Identity)
notifyHandler dbNotification _ = case _dbNotification_message dbNotification of
Notification_Contract :=> Identity contract -> do
return $ singletonV Q_ContractList $ IdentityV $ Identity $
Map.singleton (_contract_walletId contract) $ First $ Just $ _contract_id contract
Notification_Pool :=> Identity pool -> do
return $ singletonV Q_Pools $ IdentityV $ Identity $
Map.singleton (_pool_liquiditySymbol pool) $ First $ Just pool
queryHandler :: Pool Pg.Connection -> DexV Proxy -> IO (DexV Identity)
queryHandler pool v = buildV v $ \case
-- Handle View to see list of available wallet contracts
Q_ContractList -> \_ -> runNoLoggingT $ runDb (Identity pool) $ runBeamSerializable $ do
contracts <- runSelectReturningList $ select $ all_ (_db_contracts db)
return $ IdentityV $ Identity $ Map.fromList $
fmap (\c -> (_contract_walletId c, First $ Just $ _contract_id c)) contracts
Q_PooledTokens -> \_ -> runNoLoggingT $ runDb (Identity pool) $ runBeamSerializable $ do
pooledTokens <- runSelectReturningList $ select $ all_ (_db_pooledTokens db)
return $ IdentityV $ Identity $ First $ Just $ pooledTokens
Q_Pools -> \_ -> runNoLoggingT $ runDb (Identity pool) $ runBeamSerializable $ do
pools <- runSelectReturningList $ select $ all_ (_db_pools db)
return $ IdentityV $ Identity $ Map.fromList $ flip fmap pools $ \p ->
(_pool_liquiditySymbol p, First $ Just p)
-- | Query for active instances from the PAB and upsert new UniswapUser instance ids.
syncUniswapUsers :: Manager -> Pool Pg.Connection -> IO ()
syncUniswapUsers httpManager pool = do
initReq <- parseRequest "http://localhost:8080/api/new/contract/instances"
let req = initReq { method = "GET" }
resp <- httpLbs req httpManager
let val = Aeson.eitherDecode (responseBody resp) :: Either String [Aeson.Value]
case val of
Left err -> do
putStrLn $ "getWallets: failed to decode response body: " ++ err
Right objs -> do
let walletContracts = flip mapMaybe objs $ \obj -> do
contractInstanceId <- obj ^? key "cicContract". key "unContractInstanceId" . _String
walletId <- obj ^? key "cicWallet". key "getWallet" . _Integer
definition <- obj ^? key "cicDefintion". key "tag" . _String
guard $ definition == "UniswapUser"
return $ Contract contractInstanceId (fromIntegral walletId)
print $ "Wallet Ids persisted: " ++ show walletContracts -- DEBUG: Logging incoming wallets/contract ids
-- Persist participating wallet addresses to Postgresql
runNoLoggingT $ runDb (Identity pool) $ do
rows <- runBeamSerializable $ runInsertReturningList $ insertOnConflict
(_db_contracts db)
(insertValues walletContracts)
(conflictingFields primaryKey)
onConflictUpdateAll
mapM_ (notify NotificationType_Insert Notification_Contract) rows
syncPooledTokens :: Manager -> Pool Pg.Connection -> IO ()
syncPooledTokens httpManager pool = do
-- use admin wallet id to populate db with current pool tokens available
mAdminWallet <- runNoLoggingT $ runDb (Identity pool) $ runBeamSerializable $
-- SELECT _contract_id FROM _db_contracts WHERE _contract_walletId =1;
runSelectReturningOne $
select $
filter_ (\ct -> _contract_walletId ct ==. val_ 1) $
all_ (_db_contracts db)
wid <- case mAdminWallet of
Nothing -> fail "getPooledTokens: Admin user wallet not found"
Just wid -> return wid
-- In order to retreive list of pooled tokens, a request must be made to the pools endpoint first and then the response
-- can be found be found in instances within the observable state key
let contractInstanceId = T.unpack $ _contract_id wid
prString = "http://localhost:8080/api/new/contract/instance/" <> contractInstanceId <> "/endpoint/pools"
print $ "prString: " ++ prString -- DEBUG
poolReq <- parseRequest prString
let reqBody = "[]"
pReq = poolReq
{ method = "POST"
, requestHeaders = ("Content-Type","application/json"):(requestHeaders poolReq)
, requestBody = RequestBodyLBS reqBody
}
_ <- httpLbs pReq httpManager
-- This delay is necessary to give the chain 1 second to process the previous request and update the observable state
threadDelay 1000000
initReq <- do
let req =
"http://localhost:8080/api/new/contract/instance/" <>
contractInstanceId <>
"/status"
putStrLn req
parseRequest $ req
let req = initReq { method = "GET" }
resp <- httpLbs req httpManager
let val = Aeson.eitherDecode (responseBody resp) :: Either String Aeson.Value
case val of
Left err -> do
print $ "getPooledTokens: failed to decode response body: " <> err
return ()
Right obj -> do
-- aeson-lens happened here in order to get currency symbols and token names from json
let tokenInfo :: Maybe [((Aeson.Value, Int32), (Aeson.Value, Int32), (Aeson.Value, Int32))]
tokenInfo = obj ^? key "cicCurrentState". key "observableState" . key "Right" . key "contents" . _Value . _JSON
-- currencySymbols = tokenInfo ^.. traverse . key "unAssetClass" . values . key "unCurrencySymbol" . _String
-- tokenNames = tokenInfo ^.. traverse . key "unAssetClass" . values . key "unTokenName" . _String
pooledTokens :: [PooledToken]
pooledTokens = []
pools :: [LPool]
pools = flip mapMaybe (fromMaybe mempty tokenInfo) $ \((tokenA, amountA), (tokenB, amountB), (lp, amountLp)) -> do
let curSymbol = key "unAssetClass" . nth 0 . key "unCurrencySymbol" . _String
tokenASymbol <- tokenA ^? curSymbol
tokenBSymbol <- tokenB ^? curSymbol
lpSymbol <- lp ^? key "unTokenName" . _String
return $ Pool
{ _pool_tokenASymbol = tokenASymbol
, _pool_tokenBSymbol = tokenBSymbol
, _pool_tokenAAmount = amountA
, _pool_tokenBAmount = amountB
, _pool_liquiditySymbol = lpSymbol
, _pool_liquidityAmount = amountLp
}
putStrLn $ "Pools: " <> show pools
print $ "Pool tokens persisted: " ++ show pooledTokens -- DEBUG: Logging incoming pooled tokens
-- Persist current state of pool tokens to Postgresql
runNoLoggingT $ runDb (Identity pool) $ do
rows <- runBeamSerializable $ do
runInsert $ insertOnConflict (_db_pooledTokens db) (insertValues pooledTokens)
(conflictingFields primaryKey)
onConflictDoNothing
runInsertReturningList $ insertOnConflict (_db_pools db) (insertValues pools)
(conflictingFields primaryKey)
onConflictDoNothing -- FIXME
mapM_ (notify NotificationType_Insert Notification_Pool) rows
return ()
-- This function's is modeled after the following curl that submits a request to perform a swap against PAB.
{-
curl \
-H "Content-Type: application/json" \
--request POST \
--data '{
"spAmountA": 112,
"spAmountB": 0,
"spCoinB": {
"unAssetClass": [
{
"unCurrencySymbol": "7c7d03e6ac521856b75b00f96d3b91de57a82a82f2ef9e544048b13c3583487e"
},
{
"unTokenName": "A"
}
]
},
"spCoinA": {
"unAssetClass": [
{
"unCurrencySymbol": ""
},
{
"unTokenName": ""
}
]
}
}' \
http://localhost:8080/api/new/contract/instance/36951109-aacc-4504-89cc-6002cde36e04/endpoint/swap
-}
executeSwap :: Manager
-> Pool Pg.Connection
-> String
-> (Coin AssetClass , Amount Integer)
-> (Coin AssetClass, Amount Integer)
-> IO (Either String Aeson.Value)
executeSwap httpManager pool contractId (coinA, amountA) (coinB, amountB) = do
let requestUrl = "http://localhost:8080/api/new/contract/instance/" ++ contractId ++ "/endpoint/swap"
reqBody = SwapParams {
spCoinA = coinA
, spCoinB = coinB
, spAmountA = amountA
, spAmountB = amountB
}
initReq <- parseRequest requestUrl
let req = initReq
{ method = "POST"
, requestHeaders = ("Content-Type","application/json"):(requestHeaders initReq)
, requestBody = RequestBodyLBS $ Aeson.encode reqBody
}
-- The response to this request does not return anything but an empty list.
-- A useful response must be fetched from "observableState"
print ("executeSwap: sending request to pab..." :: String)
startTime <- getCurrentTime
_ <- httpLbs req httpManager
print ("executeSwap: request sent." :: String)
-- MVar that will hold response to swap request sent
eitherObState <- newEmptyMVar
-- Use websocket connection to fetch observable state response
(eitherObState', endTime) <- WS.runClient "127.0.0.1" 8080 ("/ws/" ++ contractId) $ \conn -> do
-- Allow enough time to pass for observable state to be updated (10 secs)
let processData = do
incomingData :: ByteString <- WS.receiveData conn
let val :: Either String Aeson.Value = Aeson.eitherDecode' $ BS.fromStrict incomingData
case val of
Left err -> putMVar eitherObState $ Left err
Right obj -> do
let swapTag = obj ^. key "contents" . key "Right" . key "tag" . _String
txFeeDetails = obj ^. key "contents" . key "Right"
. key "contents" . nth 0 . key "txFee" . key "getValue" . nth 0 . nth 1 . nth 0 . _Array
aesArr = obj ^. key "contents" . key "Right"
. key "contents" . _Array
scrSize = fromMaybe (Aeson.Number 0) $ lastMay $ V.toList aesArr
if swapTag == "Swapped" then putMVar eitherObState $ Right $ (Aeson.Array txFeeDetails, scrSize) else processData
fid <- forkIO processData
flip onException (killThread fid) $ do
-- retreive observable state response from result of forked thread
eitherObState' <- takeMVar eitherObState
WS.sendClose conn ("executeSwap: closing backend websocket connection..." :: Text)
endTime <- getCurrentTime
return (eitherObState', endTime)
case eitherObState' of
Left err -> return $ Left err
Right (txFeeDetails, Aeson.Number scrSize) -> case txFeeDetails of
Aeson.Array xs -> case V.toList xs of
_:(Aeson.Number txFee):_ -> do
let contractAction = "Swap"
processingTime :: Int32 = fromIntegral $ fromEnum $ diffUTCTime endTime startTime
txFee' :: Int32 = (fromIntegral $ coefficient txFee)
-- persist transaction fee and details to postgres for use in regression when estimating transaction fees later
runNoLoggingT $ runDb (Identity pool) $ runBeamSerializable $ do
runInsert $
insertOnConflict (_db_txFeeDataSet db) (insertExpressions
[TxFeeDataSet default_ (val_ txFee') (val_ contractAction) (val_ processingTime) (val_ $ fromIntegral $ coefficient scrSize)])
(conflictingFields _txFeeDataSet_id)
onConflictDoNothing
return $ Right txFeeDetails
_ -> return $ Left "Error unexpected data type in txFeeDetails"
_ -> return $ Left "Error parsing txFeeDetails as a JSON Array"
Right (_txFeeDetails, _) -> return $ Left "Unexpected script size data type"
{-
curl \
-H "Content-Type: application/json" \
--request POST \
--data '{
"apAmountA": 4500,
"apAmountB": 9000,
"apCoinB": {
"unAssetClass": [
{
"unCurrencySymbol": "7c7d03e6ac521856b75b00f96d3b91de57a82a82f2ef9e544048b13c3583487e"
},
{
"unTokenName": "A"
}
]
},
"apCoinA": {
"unAssetClass": [
{
"unCurrencySymbol": ""
},
{
"unTokenName": ""
}
]
}
}' \
http://localhost:8080/api/new/contract/instance/3b0bafe2-14f4-4d34-a4d8-633afb8e52eb/endpoint/add
-}
executeStake
:: Manager
-> String
-> (Coin AssetClass , Amount Integer)
-> (Coin AssetClass, Amount Integer)
-> IO (Either String Aeson.Value)
executeStake httpManager contractId (coinA, amountA) (coinB, amountB) = do
let requestUrl = "http://localhost:8080/api/new/contract/instance/" ++ contractId ++ "/endpoint/add"
reqBody = AddParams {
apCoinA = coinA
, apCoinB = coinB
, apAmountA = amountA
, apAmountB = amountB
}
initReq <- parseRequest requestUrl
let req = initReq
{ method = "POST"
, requestHeaders = ("Content-Type","application/json"):(requestHeaders initReq)
, requestBody = RequestBodyLBS $ Aeson.encode reqBody
}
-- The response to this request does not return anything but an empty list.
-- A useful response must be fetched from "observableState"
print $ ("executeStake: sending request to pab..." :: String)
_ <- httpLbs req httpManager
print $ ("executeStake: request sent." :: String)
(either (\a -> return $ Left a) (\a -> return $ Right $ fst a)) =<< fetchObservableStateFees httpManager contractId
{-
curl \
-H "Content-Type: application/json" \
--request POST \
--data '{
"rpDiff": 2461,
"rpCoinB": {
"unAssetClass": [
{
"unCurrencySymbol": "7c7d03e6ac521856b75b00f96d3b91de57a82a82f2ef9e544048b13c3583487e"
},
{
"unTokenName": "A"
}
]
},
"rpCoinA": {
"unAssetClass": [
{
"unCurrencySymbol": ""
},
{
"unTokenName": ""
}
]
}
}'\
http://localhost:8080/api/new/contract/instance/9079d01a-342b-4d4d-88b5-7525ff1118d6/endpoint/remove
-}
executeRemove
:: Manager
-> String
-> Coin AssetClass
-> Coin AssetClass
-> Amount Integer
-> IO (Either String Aeson.Value)
executeRemove httpManager contractId coinA coinB amount = do
let requestUrl = "http://localhost:8080/api/new/contract/instance/" ++ contractId ++ "/endpoint/remove"
reqBody = RemoveParams {
rpCoinA = coinA
, rpCoinB = coinB
, rpDiff = amount
}
initReq <- parseRequest requestUrl
let req = initReq
{ method = "POST"
, requestHeaders = ("Content-Type","application/json"):(requestHeaders initReq)
, requestBody = RequestBodyLBS $ Aeson.encode reqBody
}
-- The response to this request does not return anything but an empty list.
-- A useful response must be fetched from "observableState"
print $ ("executeRemove: sending request to pab..." :: String)
_ <- httpLbs req httpManager
print $ ("executeRemove: request sent." :: String)
(either (\a -> return $ Left a) (\a -> return $ Right $ fst a)) =<< fetchObservableStateFees httpManager contractId
-- | Grabs transaction fees from `observaleState` field from the contract
-- instance status endpoint.
fetchObservableStateFees
:: Manager
-> String
-> IO (Either String (Aeson.Value, Aeson.Value)) -- (TransactionFees, ScriptSize)
fetchObservableStateFees httpManager contractId = do
let requestUrl = "http://localhost:8080/api/new/contract/instance/" ++ contractId ++ "/status"
initReq <- parseRequest requestUrl
resp <- httpLbs initReq httpManager
let val = Aeson.eitherDecode (responseBody resp) :: Either String Aeson.Value
case val of
Left err -> do
return $ Left err
Right obj -> do
-- Note: If there is a need to filter the observable state by tag. "tag" can be found in the result of "contents" lens
let txFeeDetails = obj ^. key "cicCurrentState" . key "observableState" . key "Right"
. key "contents" . nth 0 . key "txFee" . key "getValue" . nth 0 . nth 1 . nth 0 . _Array
aesArr = obj ^. key "cicCurrentState" . key "observableState" . key "Right"
. key "contents" . _Array
scrSize = fromMaybe (Aeson.Number 0) $ lastMay $ V.toList aesArr
print $ "fetchObservableStateFees: the value of txFeeDetails is: " ++ (show txFeeDetails)
return $ Right $ (Aeson.Array txFeeDetails, scrSize)
-- | Grabs `observableState` field from the contract instance status endpoint.
-- This is used to see smart contract's response to latest request processed.
callFunds
:: Manager
-> ContractInstanceId Text
-> IO ()
callFunds httpManager contractId = do
let requestUrl = "http://localhost:8080/api/new/contract/instance/" <> (unContractInstanceId contractId) <> "/endpoint/funds"
reqBody = "[]"
initReq <- parseRequest $ T.unpack requestUrl
let req = initReq
{ method = "POST"
, requestHeaders = ("Content-Type","application/json"):(requestHeaders initReq)
, requestBody = RequestBodyLBS reqBody
}
_ <- httpLbs req httpManager
return ()
-- | Grabs `observableState` field from the contract instance status endpoint.
-- This is used to see smart contract's response to latest request processed.
callPools
:: Manager
-> ContractInstanceId Text
-> IO ()
callPools httpManager contractId = do
let requestUrl = "http://localhost:8080/api/new/contract/instance/" <> (unContractInstanceId contractId) <> "/endpoint/pools"
reqBody = "[]"
initReq <- parseRequest $ T.unpack requestUrl
let req = initReq
{ method = "POST"
, requestHeaders = ("Content-Type","application/json"):(requestHeaders initReq)
, requestBody = RequestBodyLBS reqBody
}
_ <- httpLbs req httpManager
return ()
estimateTransactionFee
:: MonadIO m
=> Pool Pg.Connection
-> SmartContractAction
-> m Integer
estimateTransactionFee pool action = case action of
SmartContractAction_Swap -> do
-- Perform Multiple regression on data set to estimate transaction fee
(regressionResults, _preds, _res) <- runNoLoggingT $ runDb (Identity pool) $ runBeamSerializable $ do
-- Query for all swaps that have occurred in order to construct a data set
previousTxDataSet <- runSelectReturningList
$ select
$ filter_ (\a -> _txFeeDataSet_smartContractAction a ==. (val_ "Swap"))
$ all_ (_db_txFeeDataSet db)
txFees :: [Double] <- forM previousTxDataSet $ \txData -> return $ fromIntegral $ _txFeeDataSet_txFee txData
let responder = U.fromList txFees
scriptSizes <- forM previousTxDataSet $ \txData -> return $ fromIntegral $ _txFeeDataSet_scriptSize txData
let preds :: U.Vector Double = U.fromList scriptSizes
predictors = fmap (\_ -> preds) ([0] :: [Integer])
if (predictors == [] || responder == U.empty || length(predictors) < 2)
then return (Nothing, predictors, responder)
else return $ (Just $ olsRegress predictors responder, predictors, responder)
case regressionResults of
Nothing -> return 10
Just (leastSquaresVector, _goodnessOfFit) -> do
-- This is the y-intercept, for now it will always come out to the correct answer
return $ round $ last $ U.toList leastSquaresVector
-- | Run a 'MonadBeam' action inside a 'Serializable' transaction. This ensures only safe
-- actions happen inside the 'Serializable'
runBeamSerializable
:: (forall m
. ( MonadBeam Postgres m
, MonadBeamInsertReturning Postgres m
, MonadBeamUpdateReturning Postgres m
, MonadBeamDeleteReturning Postgres m
)
=> m a)
-> Serializable a
runBeamSerializable action = unsafeMkSerializable $ liftIO . flip runBeamPostgres action =<< ask