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

39
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 Just x -> "grant_type=refresh_token&refresh_token=" <> t_refresh x
Nothing -> Nothing ->
"grant_type=authorization_code&code=" <> "grant_type=authorization_code&code=" <>
code <> "&redirect_uri=http://localhost:4200/test" code <> "&redirect_uri=http://localhost:4200/xeroauth"
let req = let req =
setRequestBodyLBS (BL.fromStrict (encodeUtf8 pars)) $ setRequestBodyLBS (BL.fromStrict (encodeUtf8 pars)) $
addRequestHeader hContentType "application/x-www-form-urlencoded" $ addRequestHeader hContentType "application/x-www-form-urlencoded" $
@ -368,19 +368,13 @@ setTenant a t =
getXeroInvoice :: Pipe -> T.Text -> T.Text -> T.Text -> IO (Maybe XeroInvoice) getXeroInvoice :: Pipe -> T.Text -> T.Text -> T.Text -> IO (Maybe XeroInvoice)
getXeroInvoice pipe dbName inv address = do getXeroInvoice pipe dbName inv address = do
token <- access pipe master dbName $ findToken address token <- access pipe master dbName $ findToken address
case token of let xToken = cast' . Doc =<< token
Nothing -> return Nothing
Just t -> do
let xToken = cast' (Doc t)
case xToken of case xToken of
Nothing -> return Nothing Nothing -> return Nothing
Just xT -> do Just xT -> do
let aToken = t_access xT let aToken = t_access xT
o <- access pipe master dbName $ findOwner address o <- access pipe master dbName $ findOwner address
case o of let ownerData = cast' . Doc =<< o
Nothing -> return Nothing
Just ow -> do
let ownerData = cast' (Doc ow)
case ownerData of case ownerData of
Nothing -> return Nothing Nothing -> return Nothing
Just oD -> do Just oD -> do
@ -391,8 +385,7 @@ getXeroInvoice pipe dbName inv address = do
setRequestSecure True $ setRequestSecure True $
setRequestBearerAuth (encodeUtf8 aToken) $ setRequestBearerAuth (encodeUtf8 aToken) $
setRequestPort 443 $ setRequestPort 443 $
setRequestPath setRequestPath ("/api.xro/2.0/Invoices/" <> encodeUtf8 inv) $
("/api.xro/2.0/Invoices/" <> encodeUtf8 inv) $
setRequestHost "api.xero.com" $ setRequestHost "api.xero.com" $
setRequestMethod "GET" defaultRequest setRequestMethod "GET" defaultRequest
res <- httpJSON req res <- httpJSON req
@ -401,11 +394,31 @@ getXeroInvoice pipe dbName inv address = do
200 -> do 200 -> do
invData <- invData <-
try try
(evaluate $ (evaluate $ getResponseBody (res :: Response XeroInvResponse)) :: IO (Either JSONException XeroInvResponse)
getResponseBody (res :: Response XeroInvResponse)) :: IO (Either JSONException XeroInvResponse)
case invData of case invData of
Left ex -> do Left ex -> do
putStrLn "Failed to parse JSON from Xero" putStrLn "Failed to parse JSON from Xero"
return Nothing return Nothing
Right iData -> return $ Just (head $ xir_invs iData) Right iData -> return $ Just (head $ xir_invs iData)
_ -> return Nothing _ -> 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"