Add tax calculations

src/Order.hs

@@ -210,9 +210,9 @@ instance Val LineItem where
   cast' _ = Nothing
 
 -- 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
     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 :: ZGoOrder -> Double -> Double -> ZGoOrder
-updateOrderTotals o =
+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
+    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 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)

src/ZGoBackend.hs

@@ -768,7 +768,7 @@ routes pipe config = do
                                                      _ <-
                                                        liftAndCatchIO $
                                                        run $
-                                                       upsertOrder newOrder
+                                                       upsertOrder newOrder 0 0
                                                      finalOrder <-
                                                        liftAndCatchIO $
                                                        run $
@@ -1437,6 +1437,18 @@ routes pipe config = do
     case cast' . Doc =<< user of
       Nothing -> status unauthorized401
       Just u -> 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
@@ -1448,11 +1460,20 @@ 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)
+                          liftAndCatchIO $
+                          access
+                            pipe
+                            master
+                            dbName
+                            (upsertOrder q taxRate vatRate)
                         status created201
                   else status forbidden403
               Just dbO -> do
@@ -1465,12 +1486,20 @@ 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
@@ -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-}
     {-_ <--}