Compare commits
No commits in common. "9fb2149488323759c4bf84030d3ef38a0e45f082" and "3683567b8106e604f21fb045d603f0ed673effc6" have entirely different histories.
9fb2149488
...
3683567b81
5 changed files with 30 additions and 130 deletions
|
@ -16,8 +16,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
|||
### Changed
|
||||
|
||||
- Refactored code for requesting Xero tokens to make it reusable.
|
||||
- Changed API authentication to allow for endpoints that don't require an `Authorization` header to support the WooCommerce integration
|
||||
- Enhanced the on-chain order confirmation functionality to support WooCommerce integration and future integrations.
|
||||
- Change API authentication to allow for endpoints that don't require an `Authorization` header to support the WooCommerce integration
|
||||
|
||||
## [1.1.1] - 2022-10-08
|
||||
|
||||
|
|
|
@ -4,7 +4,6 @@ module WooCommerce where
|
|||
|
||||
import Data.Aeson
|
||||
import qualified Data.Bson as B
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Char8 as C
|
||||
import Data.Maybe
|
||||
|
@ -12,8 +11,6 @@ import qualified Data.Text as T
|
|||
import qualified Data.Text.Encoding as E
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
import Database.MongoDB
|
||||
import Network.HTTP.Simple
|
||||
import Network.HTTP.Types.Status
|
||||
|
||||
-- | Type to represent the WooCommerce token
|
||||
data WooToken =
|
||||
|
@ -50,28 +47,3 @@ findWooToken oid = findOne (select ["owner" =: oid] "wootokens")
|
|||
addUrl :: WooToken -> T.Text -> Action IO ()
|
||||
addUrl t u =
|
||||
modify (select ["_id" =: w_id t] "wootokens") ["$set" =: ["url" =: u]]
|
||||
|
||||
payWooOrder ::
|
||||
String -- url
|
||||
-> BS.ByteString -- WooCommerce order ID
|
||||
-> BS.ByteString -- ZGo order id
|
||||
-> BS.ByteString -- ZGo token
|
||||
-> BS.ByteString -- Zcash price
|
||||
-> BS.ByteString -- Total ZEC for order
|
||||
-> IO ()
|
||||
payWooOrder u i o t p z = do
|
||||
wooReq <- parseRequest $ u ++ "/wc-api/zpmtcallback"
|
||||
let req =
|
||||
setRequestQueryString
|
||||
[ ("token", Just t)
|
||||
, ("orderid", Just o)
|
||||
, ("wc_orderid", Just i)
|
||||
, ("rate", Just p)
|
||||
, ("totalzec", Just z)
|
||||
]
|
||||
wooReq
|
||||
print req
|
||||
res <- httpLBS req
|
||||
if getResponseStatus res == ok200
|
||||
then return ()
|
||||
else error "Failed to report payment to WooCommerce"
|
||||
|
|
|
@ -438,6 +438,6 @@ payXeroInvoice pipe dbName inv address amt = do
|
|||
setRequestPath "/api.xro/2.0/Payments" $
|
||||
setRequestHost "api.xero.com" $
|
||||
setRequestMethod "PUT" defaultRequest
|
||||
res <- httpJSON req :: IO (Response Object)
|
||||
return ()
|
||||
res <- httpJSON req
|
||||
print (res :: Response Object)
|
||||
else error "Invalid parameters"
|
||||
|
|
|
@ -8,7 +8,6 @@ module ZGoBackend where
|
|||
|
||||
import Config
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Exception (try)
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Aeson
|
||||
|
@ -39,6 +38,7 @@ import Debug.Trace
|
|||
import GHC.Generics
|
||||
import Item
|
||||
import Network.HTTP.Simple
|
||||
import Network.HTTP.Types (created201)
|
||||
import Network.HTTP.Types.Status
|
||||
import Network.Wai (Request, pathInfo)
|
||||
import Network.Wai.Middleware.Cors
|
||||
|
@ -619,21 +619,6 @@ routes pipe config = do
|
|||
c <- param "code"
|
||||
liftAndCatchIO $ run (addAccCode oAdd c)
|
||||
status accepted202
|
||||
-- Get the WooCommerce token
|
||||
get "/api/wootoken" $ do
|
||||
oid <- param "ownerid"
|
||||
res <- liftAndCatchIO $ run (findWooToken (read oid))
|
||||
let t1 = cast' . Doc =<< res
|
||||
case t1 of
|
||||
Nothing -> status noContent204
|
||||
Just t -> do
|
||||
status ok200
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "ownerid" .= show (w_owner t)
|
||||
, "token" .= w_token t
|
||||
, "siteurl" .= w_url t
|
||||
])
|
||||
-- Authenticate the WooCommerce plugin
|
||||
get "/auth" $ do
|
||||
oid <- param "ownerid"
|
||||
|
@ -658,18 +643,6 @@ routes pipe config = do
|
|||
[ "authorized" .= True
|
||||
, "message" .= ("Authorized!" :: String)
|
||||
])
|
||||
else do
|
||||
if (E.decodeUtf8With lenientDecode .
|
||||
B64.decodeLenient . C.pack . T.unpack)
|
||||
siteurl ==
|
||||
fromMaybe "" (w_url c)
|
||||
then do
|
||||
status ok200
|
||||
Web.Scotty.json
|
||||
(object
|
||||
[ "authorized" .= True
|
||||
, "message" .= ("Already authorized." :: String)
|
||||
])
|
||||
else do
|
||||
status accepted202
|
||||
Web.Scotty.json
|
||||
|
@ -694,7 +667,6 @@ routes pipe config = do
|
|||
curr <- param "currency"
|
||||
amount <- param "amount"
|
||||
sUrl <- param "siteurl"
|
||||
orderKey <- param "orderkey"
|
||||
res <- liftAndCatchIO $ run (findWooToken (read oid))
|
||||
let c = cast' . Doc =<< res
|
||||
case c of
|
||||
|
@ -731,9 +703,7 @@ routes pipe config = do
|
|||
ZGoOrder
|
||||
Nothing
|
||||
(oaddress o)
|
||||
(case o_id o of
|
||||
Just o' -> "WC-" <> (T.pack . show $ o')
|
||||
Nothing -> "")
|
||||
("WC-" <> oname o)
|
||||
(parseTimeOrError
|
||||
True
|
||||
defaultTimeLocale
|
||||
|
@ -750,8 +720,7 @@ routes pipe config = do
|
|||
amount
|
||||
]
|
||||
False
|
||||
(T.concat
|
||||
[T.pack sUrl, "-", ordId, "-", orderKey])
|
||||
(T.concat [T.pack sUrl, "-", ordId])
|
||||
""
|
||||
newId <- liftAndCatchIO $ run (insertWooOrder newOrder)
|
||||
status ok200
|
||||
|
@ -1042,10 +1011,8 @@ getZcashPrices = do
|
|||
-- | Function to update the Zcash prices in the ZGo db
|
||||
checkZcashPrices :: Pipe -> T.Text -> IO ()
|
||||
checkZcashPrices p db = do
|
||||
q <- try getZcashPrices
|
||||
case q of
|
||||
Left e -> print (e :: HttpException)
|
||||
Right q1 -> mapM_ (access p master db) (updatePrices (getResponseBody q1))
|
||||
q <- getZcashPrices
|
||||
mapM_ (access p master db) (updatePrices (getResponseBody q))
|
||||
|
||||
-- | Function to search for transactions for an address
|
||||
listTxs ::
|
||||
|
@ -1130,14 +1097,8 @@ scanPayments config pipe = do
|
|||
case xOrder of
|
||||
Nothing -> error "Failed to retrieve order from database"
|
||||
Just xO ->
|
||||
when
|
||||
(not (qpaid xO) &&
|
||||
qexternalInvoice xO /= "" && qtotalZec xO == snd x) $ do
|
||||
let sReg = mkRegex "(.*)-([a-fA-f0-9]{24})"
|
||||
let sResult = matchAllText sReg (T.unpack $ qsession xO)
|
||||
if not (null sResult)
|
||||
then case fst $ head sResult ! 1 of
|
||||
"Xero" -> do
|
||||
unless
|
||||
(qpaid xO && qexternalInvoice xO == "" && qtotalZec xO == snd x) $ do
|
||||
xeroConfig <- access p master dbName findXero
|
||||
let xC = xeroConfig >>= (cast' . Doc)
|
||||
case xC of
|
||||
|
@ -1150,37 +1111,6 @@ scanPayments config pipe = do
|
|||
(qexternalInvoice xO)
|
||||
(qaddress xO)
|
||||
(qtotal xO)
|
||||
"WC" -> do
|
||||
let wOwner = fst $ head sResult ! 2
|
||||
wooT <-
|
||||
access p master dbName $ findWooToken (read wOwner)
|
||||
let wT = wooT >>= (cast' . Doc)
|
||||
case wT of
|
||||
Nothing -> error "Failed to read WooCommerce token"
|
||||
Just wt -> do
|
||||
let iReg = mkRegex "(.*)-(.*)-.*"
|
||||
let iResult =
|
||||
matchAllText
|
||||
iReg
|
||||
(T.unpack $ qexternalInvoice xO)
|
||||
if not (null iResult)
|
||||
then do
|
||||
let wUrl =
|
||||
E.decodeUtf8With lenientDecode .
|
||||
B64.decodeLenient . C.pack $
|
||||
fst $ head iResult ! 1
|
||||
let iNum = fst $ head iResult ! 2
|
||||
payWooOrder
|
||||
(T.unpack wUrl)
|
||||
(C.pack iNum)
|
||||
(C.pack $ maybe "" show (q_id xO))
|
||||
(C.pack . T.unpack $ w_token wt)
|
||||
(C.pack . show $ qprice xO)
|
||||
(C.pack . show $ qtotalZec xO)
|
||||
else error
|
||||
"Couldn't parse externalInvoice for WooCommerce"
|
||||
_ -> putStrLn "Not an integration order"
|
||||
else putStrLn "Not an integration order"
|
||||
|
||||
-- | RPC methods
|
||||
-- | List addresses with viewing keys loaded
|
||||
|
|
|
@ -304,7 +304,6 @@ main = do
|
|||
, ("currency", Just "usd")
|
||||
, ("amount", Just "100.0")
|
||||
, ("date", Just "2022-12-01")
|
||||
, ("orderkey", Just "wc_order_m7qiJ1dNrGDYE")
|
||||
]
|
||||
res <- httpJSON req
|
||||
getResponseStatus (res :: Response A.Value) `shouldBe` ok200
|
||||
|
|
Loading…
Reference in a new issue