Vergara_Tech/zgo-backend
Vergara_Tech
/
zgo-backend
2
1
Fork 0
Code Issues Pull Requests Packages Projects Releases 4 Wiki Activity

Add tax calculations

This commit is contained in:
Rene Vergara 2023-10-25 16:16:42 -05:00
parent a20271db6d
commit 9bd94843b4
Signed by: pitmutt
GPG Key ID: 65122AD495A7F5B2
2 changed files with 73 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Order.hs
View File

@ -210,9 +210,9 @@ instance Val LineItem where
cast' _ = Nothing cast' _ = Nothing
-- Database actions -- Database actions
upsertOrder :: ZGoOrder -> Action IO () upsertOrder :: ZGoOrder -> Double -> Double -> Action IO ()
upsertOrder o = do upsertOrder o taxRate vatRate = do
let order = val $ updateOrderTotals o let order = val $ updateOrderTotals o taxRate vatRate
case order of case order of
Doc d -> Doc d ->
if isJust (q_id o) if isJust (q_id o)
@ -222,14 +222,14 @@ upsertOrder o = do
insertWooOrder :: ZGoOrder -> Action IO Database.MongoDB.Value insertWooOrder :: ZGoOrder -> Action IO Database.MongoDB.Value
insertWooOrder o = do insertWooOrder o = do
let order = val $ updateOrderTotals o let order = val $ updateOrderTotals o 0 0
case order of case order of
Doc d -> insert "orders" d Doc d -> insert "orders" d
_ -> fail "Couldn't parse order" _ -> fail "Couldn't parse order"
upsertXeroOrder :: ZGoOrder -> Action IO () upsertXeroOrder :: ZGoOrder -> Action IO ()
upsertXeroOrder o = do upsertXeroOrder o = do
let order = val $ updateOrderTotals o let order = val $ updateOrderTotals o 0 0
case order of case order of
Doc d -> Doc d ->
upsert upsert
@ -242,8 +242,8 @@ upsertXeroOrder o = do
_ -> return () _ -> return ()
-- | Function to update order totals from items -- | Function to update order totals from items
updateOrderTotals :: ZGoOrder -> ZGoOrder updateOrderTotals :: ZGoOrder -> Double -> Double -> ZGoOrder
updateOrderTotals o = updateOrderTotals o taxRate vatRate =
ZGoOrder ZGoOrder
(q_id o) (q_id o)
(qaddress o) (qaddress o)
@ -252,9 +252,9 @@ updateOrderTotals o =
(qclosed o) (qclosed o)
(qcurrency o) (qcurrency o)
(qprice o) (qprice o)
(newTotal o) (newTotal o taxRate vatRate)
(if qprice o /= 0 (if qprice o /= 0
then roundZec (newTotal o / qprice o) then roundZec (newTotal o taxRate vatRate / qprice o)
else 0) else 0)
(qlines o) (qlines o)
(qpaid o) (qpaid o)
@ -265,8 +265,13 @@ updateOrderTotals o =
(qvat o) (qvat o)
(qtip o) (qtip o)
where where
newTotal :: ZGoOrder -> Double updateTax :: ZGoOrder -> Double -> Double
newTotal x = foldr tallyItems 0 (qlines x) + qtax o + qvat o + qtip o 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 :: LineItem -> Double -> Double
tallyItems y z = (lqty y * lcost y) + z tallyItems y z = (lqty y * lcost y) + z
@ -306,3 +311,6 @@ markOrderPaid (i, a) = do
-- | Helper function to round to 8 decimal places -- | Helper function to round to 8 decimal places
roundZec :: Double -> Double roundZec :: Double -> Double
roundZec n = fromInteger (round $ n * (10 ^ 8)) / (10.0 ^^ 8) roundZec n = fromInteger (round $ n * (10 ^ 8)) / (10.0 ^^ 8)
roundFiat :: Double -> Double
roundFiat n = fromInteger (round $ n * (10 ^ 2)) / (10.0 ^^ 2)

99
src/ZGoBackend.hs
View File

@ -768,7 +768,7 @@ routes pipe config = do
_ <- _ <-
liftAndCatchIO $ liftAndCatchIO $
run $ run $
upsertOrder newOrder upsertOrder newOrder 0 0
finalOrder <- finalOrder <-
liftAndCatchIO $ liftAndCatchIO $
run $ run $
@ -1437,27 +1437,22 @@ routes pipe config = do
case cast' . Doc =<< user of case cast' . Doc =<< user of
Nothing -> status unauthorized401 Nothing -> status unauthorized401
Just u -> do Just u -> do
dbOrder <- owner <- liftAndCatchIO $ run $ findOwner (uaddress u)
liftAndCatchIO $ run (findOrderById $ maybe "0" show (q_id q)) case cast' . Doc =<< owner of
case cast' . Doc =<< dbOrder of Nothing -> status badRequest400
Nothing -> do Just o -> do
if uaddress u == qaddress q let taxRate =
then do if otax o
if qtoken q == "" then otaxValue o
then do else 0
t <- liftIO generateToken let vatRate =
_ <- if ovat o
liftAndCatchIO $ then ovatValue o
run (upsertOrder $ setOrderToken (T.pack t) q) else 0
status created201 dbOrder <-
else do liftAndCatchIO $ run (findOrderById $ maybe "0" show (q_id q))
_ <- case cast' . Doc =<< dbOrder of
liftAndCatchIO $ access pipe master dbName (upsertOrder q) Nothing -> do
status created201
else status forbidden403
Just dbO -> do
if qaddress q == qaddress dbO && qsession q == qsession dbO
then do
if uaddress u == qaddress q if uaddress u == qaddress q
then do then do
if qtoken q == "" if qtoken q == ""
@ -1465,15 +1460,49 @@ routes pipe config = do
t <- liftIO generateToken t <- liftIO generateToken
_ <- _ <-
liftAndCatchIO $ liftAndCatchIO $
run (upsertOrder $ setOrderToken (T.pack t) q) run
(upsertOrder
(setOrderToken (T.pack t) q)
taxRate
vatRate)
status created201 status created201
else do else do
_ <- _ <-
liftAndCatchIO $ liftAndCatchIO $
access pipe master dbName (upsertOrder q) access
pipe
master
dbName
(upsertOrder q taxRate vatRate)
status created201 status created201
else status forbidden403 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 --Delete order
Web.Scotty.delete "/api/order/:id" $ do Web.Scotty.delete "/api/order/:id" $ do
oId <- param "id" oId <- param "id"
@ -1538,26 +1567,6 @@ routes pipe config = do
Just tP -> do Just tP -> do
status ok200 status ok200
Web.Scotty.json $ toJSON (tP :: LangComponent) 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-} {-post "/api/setlang" $ do-}
{-langComp <- jsonData-} {-langComp <- jsonData-}
{-_ <--} {-_ <--}