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

Correct redirect URI

Browse source
This commit is contained in:
Rene Vergara 2022-09-07 17:20:43 -05:00
parent 18498b6032
commit 8e3bdadb08
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
1 changed files with 53 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

93
src/Xero.hs
View file

@ -298,7 +298,7 @@ requestXeroToken pipe dbName cred code address = do
Just x -> "grant_type=refresh_token&refresh_token=" <> t_refresh x
Nothing ->
"grant_type=authorization_code&code=" <>
code <> "&redirect_uri=http://localhost:4200/test"
code <> "&redirect_uri=http://localhost:4200/xeroauth"
let req =
setRequestBodyLBS (BL.fromStrict (encodeUtf8 pars)) $
addRequestHeader hContentType "application/x-www-form-urlencoded" $
@ -368,44 +368,57 @@ setTenant a t =
getXeroInvoice :: Pipe -> T.Text -> T.Text -> T.Text -> IO (Maybe XeroInvoice)
getXeroInvoice pipe dbName inv address = do
token <- access pipe master dbName $ findToken address
case token of
let xToken = cast' . Doc =<< token
case xToken of
Nothing -> return Nothing
Just t -> do
let xToken = cast' (Doc t)
case xToken of
Just xT -> do
let aToken = t_access xT
o <- access pipe master dbName $ findOwner address
let ownerData = cast' . Doc =<< o
case ownerData of
Nothing -> return Nothing
Just xT -> do
let aToken = t_access xT
o <- access pipe master dbName $ findOwner address
case o of
Nothing -> return Nothing
Just ow -> do
let ownerData = cast' (Doc ow)
case ownerData of
Nothing -> return Nothing
Just oD -> do
let tenant = ocrmToken oD
let req =
addRequestHeader "Accept" "application/json" $
addRequestHeader "Xero-tenant-id" (encodeUtf8 tenant) $
setRequestSecure True $
setRequestBearerAuth (encodeUtf8 aToken) $
setRequestPort 443 $
setRequestPath
("/api.xro/2.0/Invoices/" <> encodeUtf8 inv) $
setRequestHost "api.xero.com" $
setRequestMethod "GET" defaultRequest
res <- httpJSON req
let sCode = getResponseStatusCode res
case sCode of
200 -> do
invData <-
try
(evaluate $
getResponseBody (res :: Response XeroInvResponse)) :: IO (Either JSONException XeroInvResponse)
case invData of
Left ex -> do
putStrLn "Failed to parse JSON from Xero"
return Nothing
Right iData -> return $ Just (head $ xir_invs iData)
_ -> return Nothing
Just oD -> do
let tenant = ocrmToken oD
let req =
addRequestHeader "Accept" "application/json" $
addRequestHeader "Xero-tenant-id" (encodeUtf8 tenant) $
setRequestSecure True $
setRequestBearerAuth (encodeUtf8 aToken) $
setRequestPort 443 $
setRequestPath ("/api.xro/2.0/Invoices/" <> encodeUtf8 inv) $
setRequestHost "api.xero.com" $
setRequestMethod "GET" defaultRequest
res <- httpJSON req
let sCode = getResponseStatusCode res
case sCode of
200 -> do
invData <-
try
(evaluate $ getResponseBody (res :: Response XeroInvResponse)) :: IO (Either JSONException XeroInvResponse)
case invData of
Left ex -> do
putStrLn "Failed to parse JSON from Xero"
return Nothing
Right iData -> return $ Just (head $ xir_invs iData)
_ -> return Nothing
payXeroInvoice :: Pipe -> T.Text -> T.Text -> T.Text -> Double -> IO ()
payXeroInvoice pipe dbName inv address amt = do
token <- access pipe master dbName $ findToken address
let aToken = t_access <$> (token >>= cast' . Doc)
o <- access pipe master dbName $ findOwner address
let tenant = ocrmToken <$> (o >>= cast' . Doc)
if isJust aToken && isJust tenant
then do
let req =
addRequestHeader "Accept" "application/json" $
addRequestHeader "Xero-tenant-id" (encodeUtf8 $ fromMaybe "" tenant) $
setRequestSecure True $
setRequestBearerAuth (encodeUtf8 (fromMaybe "" aToken)) $
setRequestPort 443 $
setRequestPath "/api.xero/2.0/Payments" $
setRequestHost "api.xero.com" $
setRequestMethod "PUT" defaultRequest
res <- httpJSON req
print (res :: Response Object)
else error "Invalid parameters"