zgo-backend/src/Order.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}

module Order where

import Data.Aeson
import qualified Data.Bson as B
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Clock
import Database.MongoDB
import GHC.Generics
import Test.QuickCheck

-- | Type to represent a ZGo order
data ZGoOrder =
  ZGoOrder
    { q_id :: Maybe ObjectId
    , qaddress :: T.Text
    , qsession :: T.Text
    , qtimestamp :: UTCTime
    , qclosed :: Bool
    , qcurrency :: T.Text
    , qprice :: Double
    , qtotal :: Double
    , qtotalZec :: Double
    , qlines :: [LineItem]
    , qpaid :: Bool
    , qexternalInvoice :: T.Text
    , qshortCode :: T.Text
    , qtoken :: T.Text
    }
  deriving (Eq, Show, Generic)

instance ToJSON ZGoOrder where
  toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC tk) =
    case i of
      Just oid ->
        object
          [ "_id" .= show oid
          , "address" .= a
          , "session" .= s
          , "timestamp" .= ts
          , "closed" .= c
          , "currency" .= cur
          , "price" .= p
          , "total" .= t
          , "totalZec" .= tZ
          , "lines" .= l
          , "paid" .= paid
          , "externalInvoice" .= eI
          , "shortCode" .= sC
          , "token" .= tk
          ]
      Nothing ->
        object
          [ "_id" .= ("" :: String)
          , "address" .= a
          , "session" .= s
          , "timestamp" .= ts
          , "closed" .= c
          , "currency" .= cur
          , "price" .= p
          , "total" .= t
          , "totalZec" .= tZ
          , "lines" .= l
          , "paid" .= paid
          , "externalInvoice" .= eI
          , "shortCode" .= sC
          , "token" .= tk
          ]

instance FromJSON ZGoOrder where
  parseJSON =
    withObject "Order" $ \obj -> do
      i <- obj .: "_id"
      a <- obj .: "address"
      s <- obj .: "session"
      ts <- obj .: "timestamp"
      c <- obj .: "closed"
      cur <- obj .: "currency"
      p <- obj .: "price"
      t <- obj .: "total"
      tZ <- obj .: "totalZec"
      l <- obj .: "lines"
      pd <- obj .: "paid"
      eI <- obj .: "externalInvoice"
      sC <- obj .: "shortCode"
      tk <- obj .: "token"
      pure $
        ZGoOrder
          (if not (null i)
             then Just (read i)
             else Nothing)
          a
          s
          ts
          c
          cur
          p
          t
          tZ
          l
          pd
          eI
          sC
          tk

instance Val ZGoOrder where
  val (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) =
    if isJust i
      then Doc
             [ "_id" =: i
             , "address" =: a
             , "session" =: s
             , "timestamp" =: ts
             , "closed" =: c
             , "currency" =: cur
             , "price" =: p
             , "total" =: t
             , "totalZec" =: tZ
             , "lines" =: l
             , "paid" =: pd
             , "externalInvoice" =: eI
             , "shortCode" =: sC
             , "token" =: tk
             ]
      else Doc
             [ "address" =: a
             , "session" =: s
             , "timestamp" =: ts
             , "closed" =: c
             , "currency" =: cur
             , "price" =: p
             , "total" =: t
             , "totalZec" =: tZ
             , "lines" =: l
             , "paid" =: pd
             , "externalInvoice" =: eI
             , "shortCode" =: sC
             , "token" =: tk
             ]
  cast' (Doc d) = do
    i <- B.lookup "_id" d
    a <- B.lookup "address" d
    s <- B.lookup "session" d
    ts <- B.lookup "timestamp" d
    c <- B.lookup "closed" d
    cur <- B.lookup "currency" d
    p <- B.lookup "price" d
    t <- B.lookup "total" d
    tZ <- B.lookup "totalZec" d
    l <- B.lookup "lines" d
    pd <- B.lookup "paid" d
    eI <- B.lookup "externalInvoice" d
    sC <- B.lookup "shortCode" d
    tk <- B.lookup "token" d
    Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk)
  cast' _ = Nothing

-- Type to represent an order line item
data LineItem =
  LineItem
    { lqty :: Double
    , lname :: T.Text
    , lcost :: Double
    }
  deriving (Eq, Show)

instance ToJSON LineItem where
  toJSON (LineItem q n c) = object ["qty" .= q, "name" .= n, "cost" .= c]

instance FromJSON LineItem where
  parseJSON =
    withObject "LineItem" $ \obj -> do
      q <- obj .: "qty"
      n <- obj .: "name"
      c <- obj .: "cost"
      pure $ LineItem q n c

instance Val LineItem where
  val (LineItem q n c) = Doc ["qty" =: q, "name" =: n, "cost" =: c]
  cast' (Doc d) = do
    q <- B.lookup "qty" d
    n <- B.lookup "name" d
    c <- B.lookup "cost" d
    Just (LineItem q n c)
  cast' _ = Nothing

-- Database actions
upsertOrder :: ZGoOrder -> Action IO ()
upsertOrder o = do
  let order = val $ updateOrderTotals o
  case order of
    Doc d -> 
      if isJust (q_id o)
         then upsert (select ["_id" =: q_id o] "orders") d
         else insert_ "orders" d
    _ -> return ()

insertWooOrder :: ZGoOrder -> Action IO Database.MongoDB.Value
insertWooOrder o = do
  let order = val $ updateOrderTotals o
  case order of
    Doc d -> insert "orders" d
    _ -> fail "Couldn't parse order"

upsertXeroOrder :: ZGoOrder -> Action IO ()
upsertXeroOrder o = do
  let order = val $ updateOrderTotals o
  case order of
    Doc d -> upsert (select ["externalInvoice" =: qexternalInvoice o, "shortCode" =: qshortCode o] "orders") d
    _ -> return ()

-- | Function to update order totals from items
updateOrderTotals :: ZGoOrder -> ZGoOrder
updateOrderTotals o =
  ZGoOrder
    (q_id o)
    (qaddress o)
    (qsession o)
    (qtimestamp o)
    (qclosed o)
    (qcurrency o)
    (qprice o)
    (newTotal o)
    (if qprice o /= 0
       then roundZec (newTotal o / qprice o)
       else 0)
    (qlines o)
    (qpaid o)
    (qexternalInvoice o)
    (qshortCode o)
    (qtoken o)
  where
    newTotal :: ZGoOrder -> Double
    newTotal x = foldr tallyItems 0 (qlines x)
    tallyItems :: LineItem -> Double -> Double
    tallyItems y z = (lqty y * lcost y) + z

setOrderToken :: T.Text -> ZGoOrder -> ZGoOrder
setOrderToken token (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) =
  ZGoOrder i a s ts c cur p t tZ l pd eI sC token

findOrder :: T.Text -> Action IO (Maybe Document)
findOrder s = findOne (select ["session" =: s, "closed" =: False] "orders")

findXeroOrder :: T.Text -> T.Text -> T.Text -> Action IO (Maybe Document)
findXeroOrder a i s = findOne (select ["address" =: a, "externalInvoice" =: i, "shortCode" =: s] "orders")

findOrderById :: String -> Action IO (Maybe Document)
findOrderById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "orders")

findAllOrders :: T.Text -> Action IO [Document]
findAllOrders a = rest =<< find (select ["address" =: a] "orders") {sort = ["timestamp" =: (negate 1 :: Int)]}

deleteOrder :: String -> Action IO ()
deleteOrder i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "orders")

markOrderPaid :: (String, Double) -> Action IO ()
markOrderPaid (i, a) = do
  let 
  modify
    (select ["_id" =: (read i :: B.ObjectId), "totalZec" =: a] "orders")
    ["$set" =: ["paid" =: True]]

-- | Helper function to round to 8 decimal places
roundZec :: Double -> Double
roundZec n = fromInteger (round $ n * (10 ^ 8)) / (10.0 ^^ 8)