zgo-backend/src/WooCommerce.hs

78 lines
2.1 KiB
Haskell
Raw Normal View History

2022-11-14 21:56:30 +00:00
{-# LANGUAGE OverloadedStrings #-}
module WooCommerce where
import Data.Aeson
import qualified Data.Bson as B
import qualified Data.ByteString as BS
2022-11-29 00:35:06 +00:00
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
2022-11-14 21:56:30 +00:00
import Data.Maybe
import qualified Data.Text as T
2022-11-29 00:35:06 +00:00
import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode)
2022-11-14 21:56:30 +00:00
import Database.MongoDB
import Network.HTTP.Simple
import Network.HTTP.Types.Status
2022-11-14 21:56:30 +00:00
-- | Type to represent the WooCommerce token
data WooToken =
WooToken
{ w_id :: Maybe ObjectId
, w_owner :: ObjectId
, w_token :: T.Text
, w_url :: Maybe T.Text
}
deriving (Eq, Show)
instance Val WooToken where
val (WooToken i o t u) =
if isJust i
then Doc ["_id" =: i, "owner" =: o, "token" =: t, "url" =: u]
else Doc ["owner" =: o, "token" =: t, "url" =: u]
cast' (Doc d) = do
i <- B.lookup "_id" d
o <- B.lookup "owner" d
t <- B.lookup "token" d
u <- B.lookup "url" d
2022-11-29 00:35:06 +00:00
Just
(WooToken
i
o
t
(E.decodeUtf8With lenientDecode . B64.decodeLenient . C.pack <$> u))
2022-11-14 21:56:30 +00:00
cast' _ = Nothing
-- Database actions
findWooToken :: ObjectId -> Action IO (Maybe Document)
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
2022-12-06 18:09:35 +00:00
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
2022-12-06 18:09:35 +00:00
print req
res <- httpLBS req
if getResponseStatus res == ok200
then return ()
else error "Failed to report payment to WooCommerce"