Rebuild `invdata` endpoint for Xero invoices
This commit is contained in:
parent
aa3794b504
commit
f29c5ecb03
GPG Key ID:
65122AD495A7F5B2
20
src/Xero.hs
20
src/Xero.hs
|
|
@ -171,6 +171,26 @@ instance FromJSON XeroTenant where
|
|||
--u <- obj .: "updatedDateUtc"
|
||||
pure $ XeroTenant i aei tI tT tN
|
||||
|
||||
data XeroInvoiceRequest =
|
||||
XeroInvoiceRequest
|
||||
{ xr_owner :: T.Text
|
||||
, xr_invNo :: T.Text
|
||||
, xr_amount :: Double
|
||||
, xr_currency :: T.Text
|
||||
, xr_shortCode :: T.Text
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance FromJSON XeroInvoiceRequest where
|
||||
parseJSON =
|
||||
withObject "XeroInvoiceRequest" $ \obj -> do
|
||||
o <- obj .: "ownerId"
|
||||
i <- obj .: "invoice"
|
||||
a <- obj .: "amount"
|
||||
c <- obj .: "currency"
|
||||
s <- obj .: "shortcode"
|
||||
pure $ XeroInvoiceRequest (read o) i a c s
|
||||
|
||||
data XeroInvoice =
|
||||
XeroInvoice
|
||||
{ xi_id :: Maybe ObjectId
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ import qualified Data.UUID as U
|
|||
import qualified Data.Vector as V
|
||||
import Data.Vector.Internal.Check (doChecks)
|
||||
import Data.Word
|
||||
import Database.MongoDB
|
||||
import Database.MongoDB hiding (Order)
|
||||
import Debug.Trace
|
||||
import GHC.Generics
|
||||
import Item
|
||||
|
|
@ -644,30 +644,158 @@ routes pipe config = do
|
|||
then status ok200
|
||||
else status noContent204
|
||||
get "/invdata" $ do
|
||||
inv <- param "inv"
|
||||
oAddress <- param "address"
|
||||
invReq <- jsonData
|
||||
xeroConfig <- liftAndCatchIO $ run findXero
|
||||
case cast' . Doc =<< xeroConfig of
|
||||
Nothing -> do
|
||||
status noContent204
|
||||
text "Xero App credentials not available"
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "reportType" .= (1 :: Integer)
|
||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
||||
])
|
||||
Just c -> do
|
||||
res <-
|
||||
liftAndCatchIO $
|
||||
requestXeroToken pipe (c_dbName config) c "none" oAddress
|
||||
if res
|
||||
then do
|
||||
resInv <-
|
||||
o <- liftAndCatchIO $ run $ findOwnerById $ xr_owner invReq
|
||||
case cast' . Doc =<< o of
|
||||
Nothing -> do
|
||||
status noContent204
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "reportType" .= (2 :: Integer)
|
||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
||||
])
|
||||
Just o' -> do
|
||||
res <-
|
||||
liftAndCatchIO $
|
||||
getXeroInvoice pipe (c_dbName config) inv oAddress
|
||||
case resInv of
|
||||
Nothing -> do
|
||||
requestXeroToken pipe (c_dbName config) c "none" $ oaddress o'
|
||||
if res
|
||||
then do
|
||||
resInv <-
|
||||
liftAndCatchIO $
|
||||
getXeroInvoice pipe (c_dbName config) (xr_invNo invReq) $
|
||||
oaddress o'
|
||||
case resInv of
|
||||
Nothing -> do
|
||||
status noContent204
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "reportType" .= (2 :: Integer)
|
||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
||||
])
|
||||
Just xI -> do
|
||||
if xi_type xI == "ACCREC"
|
||||
then if xi_status xI == "AUTHORISED"
|
||||
then if xi_currency xI == ocurrency o'
|
||||
then if xi_total xI == xr_amount invReq
|
||||
then do
|
||||
now <- liftIO getCurrentTime
|
||||
tk <- liftIO generateToken
|
||||
pr <-
|
||||
liftAndCatchIO $
|
||||
run
|
||||
(findPrice $
|
||||
T.unpack . ocurrency $ o')
|
||||
case cast' . Doc =<< pr of
|
||||
Nothing -> do
|
||||
status noContent204
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "reportType" .=
|
||||
(7 :: Integer)
|
||||
, "order" .=
|
||||
(Nothing :: Maybe ZGoOrder)
|
||||
])
|
||||
Just cp -> do
|
||||
let newOrder =
|
||||
ZGoOrder
|
||||
Nothing
|
||||
(oaddress o')
|
||||
("Xero-" <>
|
||||
T.pack
|
||||
(show $ o_id o'))
|
||||
now
|
||||
True
|
||||
(ocurrency o')
|
||||
cp
|
||||
(xi_total xI)
|
||||
(xi_total xI / cp)
|
||||
[ LineItem
|
||||
1
|
||||
("Invoice from " <>
|
||||
oname o' <>
|
||||
" [" <>
|
||||
xi_number xI <>
|
||||
"]")
|
||||
(xi_total xI)
|
||||
]
|
||||
False
|
||||
(xi_number xI)
|
||||
(xi_shortcode xI)
|
||||
(T.pack tk)
|
||||
_ <-
|
||||
liftAndCatchIO $
|
||||
run $ upsertOrder newOrder
|
||||
finalOrder <-
|
||||
liftAndCatchIO $
|
||||
run $
|
||||
findXeroOrder
|
||||
(oaddress o')
|
||||
(xi_number xI)
|
||||
(xi_shortcode xI)
|
||||
case cast' . Doc =<< finalOrder of
|
||||
Nothing -> do
|
||||
status
|
||||
internalServerError500
|
||||
text
|
||||
"Unable to save order to DB"
|
||||
Just fO -> do
|
||||
status ok200
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "reportType" .=
|
||||
(0 :: Integer)
|
||||
, "order" .=
|
||||
toJSON
|
||||
(fO :: ZGoOrder)
|
||||
])
|
||||
else do
|
||||
status noContent204
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "reportType" .=
|
||||
(8 :: Integer)
|
||||
, "order" .=
|
||||
(Nothing :: Maybe ZGoOrder)
|
||||
])
|
||||
else do
|
||||
status noContent204
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "reportType" .= (7 :: Integer)
|
||||
, "order" .=
|
||||
(Nothing :: Maybe ZGoOrder)
|
||||
])
|
||||
else do
|
||||
status noContent204
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "reportType" .= (6 :: Integer)
|
||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
||||
])
|
||||
else do
|
||||
status noContent204
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "reportType" .= (5 :: Integer)
|
||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
||||
])
|
||||
else do
|
||||
status noContent204
|
||||
text "Xero invoice not found"
|
||||
Just xI -> do
|
||||
status ok200
|
||||
Web.Scotty.json (object ["invdata" .= toJSON xI])
|
||||
else status noContent204
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "reportType" .= (1 :: Integer)
|
||||
, "order" .= (Nothing :: Maybe ZGoOrder)
|
||||
])
|
||||
-- Get the xeroaccount code
|
||||
get "/api/xeroaccount" $ do
|
||||
session <- param "session"
|
||||
|
|
|
|||
Loading…
Reference in New Issue