zgo-backend/src/Payment.hs

{-# 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)