101 lines
2.8 KiB
Haskell
101 lines
2.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module WooCommerce where
|
|
|
|
import qualified BLAKE3 as BLK
|
|
import Data.Aeson
|
|
import qualified Data.Bson as B
|
|
import qualified Data.ByteArray as BA
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Base64 as B64
|
|
import qualified Data.ByteString.Char8 as C
|
|
import Data.Maybe
|
|
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
|
|
import Owner
|
|
|
|
-- | 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
|
|
Just
|
|
(WooToken
|
|
i
|
|
o
|
|
t
|
|
(E.decodeUtf8With lenientDecode . B64.decodeLenient . C.pack <$> u))
|
|
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
|
|
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"
|
|
|
|
generateWooToken :: Owner -> Action IO ()
|
|
generateWooToken o =
|
|
case o_id o of
|
|
Just ownerid -> do
|
|
let tokenHash =
|
|
BLK.hash
|
|
[ BA.pack . BS.unpack . C.pack . T.unpack $ oname o <> oaddress o :: BA.Bytes
|
|
]
|
|
let wooToken =
|
|
val $
|
|
WooToken
|
|
Nothing
|
|
ownerid
|
|
(T.pack . show $ (tokenHash :: BLK.Digest BLK.DEFAULT_DIGEST_LEN))
|
|
Nothing
|
|
case wooToken of
|
|
Doc wT -> insert_ "wootokens" wT
|
|
_ -> error "Couldn't create the WooCommerce token"
|
|
Nothing -> error "Bad owner id"
|