From 9bd94843b4637296ae55ea4adf3163aa2dfc88ef Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 25 Oct 2023 16:16:42 -0500 Subject: [PATCH] Add tax calculations --- src/Order.hs | 30 ++++++++------ src/ZGoBackend.hs | 99 ++++++++++++++++++++++++++--------------------- 2 files changed, 73 insertions(+), 56 deletions(-) diff --git a/src/Order.hs b/src/Order.hs index 4c60669..1f54a40 100644 --- a/src/Order.hs +++ b/src/Order.hs @@ -210,9 +210,9 @@ instance Val LineItem where cast' _ = Nothing -- Database actions -upsertOrder :: ZGoOrder -> Action IO () -upsertOrder o = do - let order = val $ updateOrderTotals o +upsertOrder :: ZGoOrder -> Double -> Double -> Action IO () +upsertOrder o taxRate vatRate = do + let order = val $ updateOrderTotals o taxRate vatRate case order of Doc d -> if isJust (q_id o) @@ -222,14 +222,14 @@ upsertOrder o = do insertWooOrder :: ZGoOrder -> Action IO Database.MongoDB.Value insertWooOrder o = do - let order = val $ updateOrderTotals o + let order = val $ updateOrderTotals o 0 0 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 + let order = val $ updateOrderTotals o 0 0 case order of Doc d -> upsert @@ -242,8 +242,8 @@ upsertXeroOrder o = do _ -> return () -- | Function to update order totals from items -updateOrderTotals :: ZGoOrder -> ZGoOrder -updateOrderTotals o = +updateOrderTotals :: ZGoOrder -> Double -> Double -> ZGoOrder +updateOrderTotals o taxRate vatRate = ZGoOrder (q_id o) (qaddress o) @@ -252,9 +252,9 @@ updateOrderTotals o = (qclosed o) (qcurrency o) (qprice o) - (newTotal o) + (newTotal o taxRate vatRate) (if qprice o /= 0 - then roundZec (newTotal o / qprice o) + then roundZec (newTotal o taxRate vatRate / qprice o) else 0) (qlines o) (qpaid o) @@ -265,8 +265,13 @@ updateOrderTotals o = (qvat o) (qtip o) where - newTotal :: ZGoOrder -> Double - newTotal x = foldr tallyItems 0 (qlines x) + qtax o + qvat o + qtip o + updateTax :: ZGoOrder -> Double -> Double + updateTax x t = roundFiat $ itemsTotal (qlines x) * t / 100.0 + itemsTotal :: [LineItem] -> Double + itemsTotal = foldr tallyItems 0 + newTotal :: ZGoOrder -> Double -> Double -> Double + newTotal x tR vR = + itemsTotal (qlines x) + updateTax x tR + updateTax x vR + qtip x tallyItems :: LineItem -> Double -> Double tallyItems y z = (lqty y * lcost y) + z @@ -306,3 +311,6 @@ markOrderPaid (i, a) = do -- | Helper function to round to 8 decimal places roundZec :: Double -> Double roundZec n = fromInteger (round $ n * (10 ^ 8)) / (10.0 ^^ 8) + +roundFiat :: Double -> Double +roundFiat n = fromInteger (round $ n * (10 ^ 2)) / (10.0 ^^ 2) diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 9f9a9fe..da23781 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -768,7 +768,7 @@ routes pipe config = do _ <- liftAndCatchIO $ run $ - upsertOrder newOrder + upsertOrder newOrder 0 0 finalOrder <- liftAndCatchIO $ run $ @@ -1437,27 +1437,22 @@ routes pipe config = do case cast' . Doc =<< user of Nothing -> status unauthorized401 Just u -> do - dbOrder <- - liftAndCatchIO $ run (findOrderById $ maybe "0" show (q_id q)) - case cast' . Doc =<< dbOrder of - Nothing -> do - if uaddress u == qaddress q - then do - if qtoken q == "" - then do - t <- liftIO generateToken - _ <- - liftAndCatchIO $ - run (upsertOrder $ setOrderToken (T.pack t) q) - status created201 - else do - _ <- - liftAndCatchIO $ access pipe master dbName (upsertOrder q) - status created201 - else status forbidden403 - Just dbO -> do - if qaddress q == qaddress dbO && qsession q == qsession dbO - then do + owner <- liftAndCatchIO $ run $ findOwner (uaddress u) + case cast' . Doc =<< owner of + Nothing -> status badRequest400 + Just o -> do + let taxRate = + if otax o + then otaxValue o + else 0 + let vatRate = + if ovat o + then ovatValue o + else 0 + dbOrder <- + liftAndCatchIO $ run (findOrderById $ maybe "0" show (q_id q)) + case cast' . Doc =<< dbOrder of + Nothing -> do if uaddress u == qaddress q then do if qtoken q == "" @@ -1465,15 +1460,49 @@ routes pipe config = do t <- liftIO generateToken _ <- liftAndCatchIO $ - run (upsertOrder $ setOrderToken (T.pack t) q) + run + (upsertOrder + (setOrderToken (T.pack t) q) + taxRate + vatRate) status created201 else do _ <- liftAndCatchIO $ - access pipe master dbName (upsertOrder q) + access + pipe + master + dbName + (upsertOrder q taxRate vatRate) status created201 else status forbidden403 - else status forbidden403 + Just dbO -> do + if qaddress q == qaddress dbO && qsession q == qsession dbO + then do + if uaddress u == qaddress q + then do + if qtoken q == "" + then do + t <- liftIO generateToken + _ <- + liftAndCatchIO $ + run + (upsertOrder + (setOrderToken (T.pack t) q) + taxRate + vatRate) + status created201 + else do + _ <- + liftAndCatchIO $ + access + pipe + master + dbName + (upsertOrder q taxRate vatRate) + status created201 + else status forbidden403 + else status forbidden403 --Delete order Web.Scotty.delete "/api/order/:id" $ do oId <- param "id" @@ -1538,26 +1567,6 @@ routes pipe config = do Just tP -> do status ok200 Web.Scotty.json $ toJSON (tP :: LangComponent) - where - saveOrder :: Pipe -> T.Text -> User -> ZGoOrder -> ActionM () - saveOrder pipe dbName u q = do - if uaddress u == qaddress q - then do - if qtoken q == "" - then do - t <- liftIO generateToken - _ <- - liftAndCatchIO $ - access - pipe - master - dbName - (upsertOrder $ setOrderToken (T.pack t) q) - status created201 - else do - _ <- liftAndCatchIO $ access pipe master dbName (upsertOrder q) - status created201 - else status forbidden403 {-post "/api/setlang" $ do-} {-langComp <- jsonData-} {-_ <--}