Correct redirect URI

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
+    Just xT -> do
-      let xToken = cast' (Doc t)
+      let aToken = t_access xT
-      case xToken of
+      o <- access pipe master dbName $ findOwner address
+      let ownerData = cast' . Doc =<< o
+      case ownerData of
         Nothing -> return Nothing
-        Just xT -> do
+        Just oD -> do
-          let aToken = t_access xT
+          let tenant = ocrmToken oD
-          o <- access pipe master dbName $ findOwner address
+          let req =
-          case o of
+                addRequestHeader "Accept" "application/json" $
-            Nothing -> return Nothing
+                addRequestHeader "Xero-tenant-id" (encodeUtf8 tenant) $
-            Just ow -> do
+                setRequestSecure True $
-              let ownerData = cast' (Doc ow)
+                setRequestBearerAuth (encodeUtf8 aToken) $
-              case ownerData of
+                setRequestPort 443 $
-                Nothing -> return Nothing
+                setRequestPath ("/api.xro/2.0/Invoices/" <> encodeUtf8 inv) $
-                Just oD -> do
+                setRequestHost "api.xero.com" $
-                  let tenant = ocrmToken oD
+                setRequestMethod "GET" defaultRequest
-                  let req =
+          res <- httpJSON req
-                        addRequestHeader "Accept" "application/json" $
+          let sCode = getResponseStatusCode res
-                        addRequestHeader "Xero-tenant-id" (encodeUtf8 tenant) $
+          case sCode of
-                        setRequestSecure True $
+            200 -> do
-                        setRequestBearerAuth (encodeUtf8 aToken) $
+              invData <-
-                        setRequestPort 443 $
+                try
-                        setRequestPath
+                  (evaluate $ getResponseBody (res :: Response XeroInvResponse)) :: IO (Either JSONException XeroInvResponse)
-                          ("/api.xro/2.0/Invoices/" <> encodeUtf8 inv) $
+              case invData of
-                        setRequestHost "api.xero.com" $
+                Left ex -> do
-                        setRequestMethod "GET" defaultRequest
+                  putStrLn "Failed to parse JSON from Xero"
-                  res <- httpJSON req
+                  return Nothing
-                  let sCode = getResponseStatusCode res
+                Right iData -> return $ Just (head $ xir_invs iData)
-                  case sCode of
+            _ -> return Nothing
-                    200 -> do
+
-                      invData <-
+payXeroInvoice :: Pipe -> T.Text -> T.Text -> T.Text -> Double -> IO ()
-                        try
+payXeroInvoice pipe dbName inv address amt = do
-                          (evaluate $
+  token <- access pipe master dbName $ findToken address
-                           getResponseBody (res :: Response XeroInvResponse)) :: IO (Either JSONException XeroInvResponse)
+  let aToken = t_access <$> (token >>= cast' . Doc)
-                      case invData of
+  o <- access pipe master dbName $ findOwner address
-                        Left ex -> do
+  let tenant = ocrmToken <$> (o >>= cast' . Doc)
-                          putStrLn "Failed to parse JSON from Xero"
+  if isJust aToken && isJust tenant
-                          return Nothing
+    then do
-                        Right iData -> return $ Just (head $ xir_invs iData)
+      let req =
-                    _ -> return Nothing
+            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"