120 lines
3.2 KiB
Haskell
120 lines
3.2 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 FromJSON WooToken where
|
|
parseJSON =
|
|
withObject "WooToken" $ \obj -> do
|
|
i <- obj .:? "_id"
|
|
o <- obj .: "ownerid"
|
|
t <- obj .: "token"
|
|
u <- obj .: "siteurl"
|
|
pure $ WooToken (read <$> i) (read o) t u
|
|
|
|
instance ToJSON WooToken where
|
|
toJSON (WooToken i o t u) =
|
|
case i of
|
|
Just oid ->
|
|
object
|
|
["_id" .= show oid, "ownerid" .= show o, "token" .= t, "siteurl" .= u]
|
|
Nothing ->
|
|
object
|
|
[ "_id" .= ("" :: String)
|
|
, "ownerid" .= show o
|
|
, "token" .= t
|
|
, "siteurl" .= u
|
|
]
|
|
|
|
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 :: Maybe ObjectId -> Action IO (Maybe Document)
|
|
findWooToken oid =
|
|
case oid of
|
|
Nothing -> return Nothing
|
|
Just o -> findOne (select ["owner" =: o] "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
|
|
let req =
|
|
setRequestPath "/wp-json/wc/v3/zgocallback" $
|
|
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 do
|
|
print $ getResponseStatus res
|
|
error "Failed to report payment to WooCommerce"
|
|
|
|
generateWooToken :: Owner -> String -> Action IO ()
|
|
generateWooToken o s =
|
|
case o_id o of
|
|
Just ownerid -> do
|
|
let wooToken = val $ WooToken Nothing ownerid (T.pack s) Nothing
|
|
case wooToken of
|
|
Doc wT -> insert_ "wootokens" wT
|
|
_ -> error "Couldn't create the WooCommerce token"
|
|
Nothing -> error "Bad owner id"
|