96 lines
2.2 KiB
Haskell
96 lines
2.2 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
|
|
module Payment where
|
|
|
|
import Data.Aeson
|
|
import qualified Data.Bson as B
|
|
import qualified Data.Text as T
|
|
import Data.Time.Clock
|
|
import Data.Typeable
|
|
import Database.MongoDB
|
|
import GHC.Generics
|
|
import ZGoTx
|
|
|
|
data Payment =
|
|
Payment
|
|
{ p_id :: Maybe ObjectId
|
|
, pdelta :: Integer
|
|
, pdone :: Bool
|
|
, paddress :: T.Text
|
|
, psession :: T.Text
|
|
, pblocktime :: Integer
|
|
, pamount :: Double
|
|
, ptxid :: T.Text
|
|
, pmemo :: T.Text
|
|
}
|
|
deriving (Eq, Show, Generic)
|
|
|
|
instance Val Payment where
|
|
cast' (Doc d) = do
|
|
i <- B.lookup "_id" d
|
|
delta <- B.lookup "delta" d
|
|
done <- B.lookup "done" d
|
|
a <- B.lookup "address" d
|
|
s <- B.lookup "session" d
|
|
bt <- B.lookup "blocktime" d
|
|
amt <- B.lookup "amount" d
|
|
t <- B.lookup "txid" d
|
|
m <- B.lookup "memo" d
|
|
Just (Payment i delta done a s bt amt t m)
|
|
cast' _ = Nothing
|
|
val (Payment i delta done a s bt amt t m) =
|
|
case i of
|
|
Just oid ->
|
|
Doc
|
|
[ "_id" =: oid
|
|
, "delta" =: delta
|
|
, "done" =: done
|
|
, "address" =: a
|
|
, "session" =: s
|
|
, "blocktime" =: bt
|
|
, "amount" =: amt
|
|
, "txid" =: t
|
|
, "memo" =: m
|
|
]
|
|
Nothing ->
|
|
Doc
|
|
[ "delta" =: delta
|
|
, "done" =: done
|
|
, "address" =: a
|
|
, "session" =: s
|
|
, "blocktime" =: bt
|
|
, "amount" =: amt
|
|
, "txid" =: t
|
|
, "memo" =: m
|
|
]
|
|
|
|
upsertPayment :: ZGoTx -> Action IO ()
|
|
upsertPayment p = do
|
|
let delta = sessionCalc $ amount p
|
|
let payTx =
|
|
Payment
|
|
Nothing
|
|
delta
|
|
False
|
|
(address p)
|
|
(session p)
|
|
(blocktime p)
|
|
(amount p)
|
|
(txid p)
|
|
(memo p)
|
|
let payment = val payTx
|
|
case payment of
|
|
Doc d -> upsert (select ["txid" =: txid p] "payments") d
|
|
_ -> return ()
|
|
|
|
sessionCalc :: Double -> Integer
|
|
sessionCalc zec
|
|
| zec >= hiPay = 2419200 -- 1 month in seconds
|
|
| zec >= medPay = 604800 -- 1 week in seconds
|
|
| zec >= lowPay = 86400 -- 1 day in seconds
|
|
| otherwise = 0
|
|
where
|
|
(lowPay, medPay, hiPay) = (0.005, 0.025, 0.1)
|