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"