From 8e3bdadb08cc9c448e470d98c331075f57b84551 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 7 Sep 2022 17:20:43 -0500
Subject: [PATCH] Correct redirect URI

---
 src/Xero.hs | 93 ++++++++++++++++++++++++++++++-----------------------
 1 file changed, 53 insertions(+), 40 deletions(-)

diff --git a/src/Xero.hs b/src/Xero.hs
index 4d7cbe5..1b5b71b 100644
--- a/src/Xero.hs
+++ b/src/Xero.hs
@@ -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"