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

Implement payment record to Xero

Browse source
This commit is contained in:
Rene Vergara 2022-09-08 14:05:42 -05:00
parent e475a4e471
commit 53b9d6ab52
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
1 changed files with 11 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
src/Xero.hs
View file

@ -406,17 +406,26 @@ payXeroInvoice :: Pipe -> T.Text -> T.Text -> T.Text -> Double -> IO ()
payXeroInvoice pipe dbName inv address amt = do payXeroInvoice pipe dbName inv address amt = do
token <- access pipe master dbName $ findToken address token <- access pipe master dbName $ findToken address
let aToken = t_access <$> (token >>= cast' . Doc) let aToken = t_access <$> (token >>= cast' . Doc)
let aCode = t_code <$> (token >>= cast' . Doc)
o <- access pipe master dbName $ findOwner address o <- access pipe master dbName $ findOwner address
let tenant = ocrmToken <$> (o >>= cast' . Doc) let tenant = ocrmToken <$> (o >>= cast' . Doc)
if isJust aToken && isJust tenant today <- getCurrentTime
if isJust aToken && isJust tenant && isJust aCode
then do then do
let req = let req =
setRequestBodyJSON
(object
[ "Invoice" .= object ["InvoiceNumber" .= inv]
, "Account" .= object ["Code" .= fromMaybe "" aCode]
, "Date" .= utctDay today
, "Amount" .= amt
]) $
addRequestHeader "Accept" "application/json" $ addRequestHeader "Accept" "application/json" $
addRequestHeader "Xero-tenant-id" (encodeUtf8 $ fromMaybe "" tenant) $ addRequestHeader "Xero-tenant-id" (encodeUtf8 $ fromMaybe "" tenant) $
setRequestSecure True $ setRequestSecure True $
setRequestBearerAuth (encodeUtf8 (fromMaybe "" aToken)) $ setRequestBearerAuth (encodeUtf8 (fromMaybe "" aToken)) $
setRequestPort 443 $ setRequestPort 443 $
setRequestPath "/api.xero/2.0/Payments" $ setRequestPath "/api.xro/2.0/Payments" $
setRequestHost "api.xero.com" $ setRequestHost "api.xero.com" $
setRequestMethod "PUT" defaultRequest setRequestMethod "PUT" defaultRequest
res <- httpJSON req res <- httpJSON req