mateamt/src/Model/Amount.hs

{-# LANGUAGE OverloadedStrings #-}
module Model.Amount where

import Data.Time.Clock (getCurrentTime)
import Data.Time (UTCTime)

import Data.Profunctor.Product (p5)

import qualified Database.PostgreSQL.Simple as PGS

import Control.Arrow ((<<<))

import Control.Monad.IO.Class (liftIO)

import Opaleye as O
import Opaleye.Constant as C

-- internal imports

import Types

initAmount :: PGS.Query
initAmount = mconcat
  [ "CREATE TABLE IF NOT EXISTS \"amount\" ("
  , "amount_product_id BIGINT      NOT NULL REFERENCES \"product\"(\"product_id\") ON DELETE CASCADE,"
  , "amount_timestamp  TIMESTAMPTZ NOT NULL,"
  , "amount_amount     INTEGER     NOT NULL,"
  , "amount_price      INTEGER     NOT NULL,"
  , "amount_verified   BOOLEAN     NOT NULL,"
  , "PRIMARY KEY (amount_product_id, amount_timestamp)"
  , ")"
  ]

amountTable :: Table
  ( Field SqlInt4
  , Field SqlTimestamptz
  , Field SqlInt4
  , Field SqlInt4
  , Field SqlBool
  )
  ( Field SqlInt4
  , Field SqlTimestamptz
  , Field SqlInt4
  , Field SqlInt4
  , Field SqlBool
  )
amountTable = table "amount" (
  p5
    ( tableField "amount_product_id"
    , tableField "amount_timestamp"
    , tableField "amount_amount"
    , tableField "amount_price"
    , tableField "amount_verified"
    )
  )

insertNewEmptyAmount
  :: Int           -- | the associated product id
  -> UTCTime       -- | current time
  -> ProductSubmit -- | submitted product data
  -> PGS.Connection
  -> MateHandler Int
insertNewEmptyAmount bevid now (ProductSubmit _ price _ _ _ _ _ _ _) conn =
  fmap head $ liftIO $ runInsert_ conn $ Insert
    { iTable = amountTable
    , iRows  =
      [
      ( C.constant bevid
      , C.constant now
      , C.constant (0 :: Int)
      , C.constant price
      , C.constant False
      )
      ]
    , iReturning = rReturning (\(id_, _, _, _, _) -> id_)
    , iOnConflict = Nothing
    }

getLatestPriceByProductId
  :: Int             -- The associated Product ID
  -> PGS.Connection
  -> MateHandler Int -- The price in cents
getLatestPriceByProductId pid conn = do
  amounts <- liftIO $ runSelect conn $
    orderBy (desc (\(_, ts, _, _, _) -> ts))
      (keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<< queryTable amountTable)
    :: MateHandler
      [ ( Int
        , UTCTime
        , Int
        , Int
        , Bool
        )
      ]
  head <$> mapM
    (\(_, _, _, price, _) -> return price)
    amounts

getLatestTotalPrice
  :: PurchaseDetail  -- The associated PurchaseDetail
  -> PGS.Connection
  -> MateHandler Int -- The price in cents
getLatestTotalPrice (PurchaseDetail pid amount) conn = do
  amounts <- liftIO $ runSelect conn $
    orderBy (desc (\(_, ts, _, _, _) -> ts)) $
      keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<<
        queryTable amountTable
    :: MateHandler
      [ ( Int
        , UTCTime
        , Int
        , Int
        , Bool
        )
      ]
  (amount *) <$> head <$> mapM
    (\(_, _, _, price, _) -> return price)
    amounts

checkProductAvailability
  :: PurchaseDetail
  -> PGS.Connection
  -> MateHandler (Maybe Int) -- | Returns maybe missing amount
checkProductAvailability (PurchaseDetail pid amount) conn = do
  realamount <- (\(_, _, ramount, _, _) -> ramount) <$> head <$>
    (liftIO $ runSelect conn $
      orderBy (desc (\(_, ts, _, _, _) -> ts)) $
        keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<<
          queryTable amountTable
      :: MateHandler
        [ ( Int
          , UTCTime
          , Int
          , Int
          , Bool
          )
        ]
    )
  if realamount < amount
  then return (Just $ amount - realamount)
  else return Nothing

manualProductAmountUpdate
  :: AmountUpdate
  -> UTCTime      -- Current time
  -> Int          -- Old BeveragePrice
  -> PGS.Connection
  -> MateHandler Int
manualProductAmountUpdate (AmountUpdate pid amount) now oldprice conn =
  fmap head $ liftIO $ runInsert_ conn $ Insert
    { iTable = amountTable
    , iRows  =
      [
      ( C.constant pid
      , C.constant now
      , C.constant amount
      , C.constant oldprice
      , C.constant True
      )
      ]
    , iReturning = rReturning (\(id_, _, _, _, _) -> id_)
    , iOnConflict = Nothing
    }

postBuyProductAmountUpdate
  :: PurchaseDetail
  -> PGS.Connection
  -> MateHandler Int
postBuyProductAmountUpdate (PurchaseDetail pid pdamount) conn = do
  now <- liftIO $ getCurrentTime
  (amount, oldprice) <- (\(_, _, am, op, _) -> (am, op)) <$> head <$> (
    liftIO $ runSelect conn $
      orderBy (desc (\(_, ts, _, _, _) -> ts)) $
        keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<<
          queryTable amountTable
      :: MateHandler
        [ ( Int
          , UTCTime
          , Int
          , Int
          , Bool
          )
        ]
    )
  liftIO $ head <$> runInsert_ conn (Insert
    { iTable = amountTable
    , iRows  =
      [
      ( C.constant pid
      , C.constant now
      , C.constant (amount - pdamount)
      , C.constant oldprice
      , C.constant False
      )
      ]
    , iReturning = rReturning (\(id_, _, _, _, _) -> id_)
    , iOnConflict = Nothing
    }
    )