{-# LANGUAGE OverloadedStrings #-} 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 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 = 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"