diff --git a/src/Order.hs b/src/Order.hs index 0a43ff9..4c60669 100644 --- a/src/Order.hs +++ b/src/Order.hs @@ -30,10 +30,13 @@ data ZGoOrder = ZGoOrder , qexternalInvoice :: T.Text , qshortCode :: T.Text , qtoken :: T.Text + , qtax :: Double + , qvat :: Double + , qtip :: Double } deriving (Eq, Show, Generic) instance ToJSON ZGoOrder where - toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC tk) = + toJSON (ZGoOrder i a s ts c cur p t tZ l paid eI sC tk qT qV tip) = case i of Just oid -> object @@ -51,6 +54,9 @@ instance ToJSON ZGoOrder where , "externalInvoice" .= eI , "shortCode" .= sC , "token" .= tk + , "taxAmount" .= qT + , "vatAmount" .= qV + , "tipAmount" .= tip ] Nothing -> object @@ -68,6 +74,9 @@ instance ToJSON ZGoOrder where , "externalInvoice" .= eI , "shortCode" .= sC , "token" .= tk + , "taxAmount" .= qT + , "vatAmount" .= qV + , "tipAmount" .= tip ] instance FromJSON ZGoOrder where @@ -87,6 +96,9 @@ instance FromJSON ZGoOrder where eI <- obj .: "externalInvoice" sC <- obj .: "shortCode" tk <- obj .: "token" + qT <- obj .: "taxAmount" + qV <- obj .: "vatAmount" + tip <- obj .: "tipAmount" pure $ ZGoOrder (if not (null i) @@ -105,9 +117,12 @@ instance FromJSON ZGoOrder where eI sC tk + qT + qV + tip instance Val ZGoOrder where - val (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk) = + val (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk qT qV tip) = if isJust i then Doc [ "_id" =: i @@ -124,6 +139,9 @@ instance Val ZGoOrder where , "externalInvoice" =: eI , "shortCode" =: sC , "token" =: tk + , "taxAmount" =: qT + , "vatAmount" =: qV + , "tipAmount" =: tip ] else Doc [ "address" =: a @@ -139,6 +157,9 @@ instance Val ZGoOrder where , "externalInvoice" =: eI , "shortCode" =: sC , "token" =: tk + , "taxAmount" =: qT + , "vatAmount" =: qV + , "tipAmount" =: tip ] cast' (Doc d) = do i <- B.lookup "_id" d @@ -155,7 +176,10 @@ instance Val ZGoOrder where 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) + qT <- B.lookup "taxAmount" d + qV <- B.lookup "vatAmount" d + tip <- B.lookup "tipAmount" d + Just (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk qT qV tip) cast' _ = Nothing -- Type to represent an order line item @@ -237,15 +261,18 @@ updateOrderTotals o = (qexternalInvoice o) (qshortCode o) (qtoken o) + (qtax o) + (qvat o) + (qtip o) where newTotal :: ZGoOrder -> Double - newTotal x = foldr tallyItems 0 (qlines x) + newTotal x = foldr tallyItems 0 (qlines x) + qtax o + qvat o + qtip o 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 +setOrderToken token (ZGoOrder i a s ts c cur p t tZ l pd eI sC tk qT qV tip) = + ZGoOrder i a s ts c cur p t tZ l pd eI sC token qT qV tip findOrder :: T.Text -> Action IO (Maybe Document) findOrder s = findOne (select ["session" =: s, "closed" =: False] "orders") diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index c0f7ce0..68c883b 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -761,6 +761,9 @@ routes pipe config = do (xr_shortCode invReq) (T.pack tk) + 0 + 0 + 0 _ <- liftAndCatchIO $ run $ @@ -1040,6 +1043,9 @@ routes pipe config = do [T.pack sUrl, "-", ordId, "-", orderKey]) "" (T.pack tk) + 0 + 0 + 0 newId <- liftAndCatchIO $ run (insertWooOrder newOrder) status ok200 Web.Scotty.json diff --git a/test/Spec.hs b/test/Spec.hs index 094fb54..35d60cf 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -325,6 +325,9 @@ main = do "" "" "testToken4321" + 0 + 0 + 0 req <- testPostJson "/api/order" $ A.object ["payload" A..= A.toJSON testOrder] @@ -352,6 +355,9 @@ main = do "" "" "testToken4321" + 0 + 0 + 0 req <- testPostJson "/api/order" $ A.object ["payload" A..= A.toJSON testOrder] @@ -379,6 +385,9 @@ main = do "" "" "testToken4321" + 0 + 0 + 0 req <- testPostJson "/api/order" $ A.object ["payload" A..= A.toJSON testOrder] @@ -851,6 +860,9 @@ main = do "" "" "testToken1234" + 0 + 0 + 0 let ordTest = val myOrder case ordTest of Doc oT -> access p master "test" (insert_ "orders" oT) @@ -1368,6 +1380,9 @@ startAPI config = do "" "" "testToken1234" + 0 + 0 + 0 let ordTest = val myOrder case ordTest of Doc oT -> access pipe master "test" (insert_ "orders" oT) @@ -1433,7 +1448,10 @@ instance Arbitrary ZGoOrder where pd <- arbitrary eI <- arbitrary sc <- arbitrary - ZGoOrder i a s ts c cur p t tZ l pd eI sc <$> arbitrary + tk <- arbitrary + qT <- arbitrary + qV <- arbitrary + ZGoOrder i a s ts c cur p t tZ l pd eI sc tk qT qV <$> arbitrary instance Arbitrary LineItem where arbitrary = do