41 lines
1 KiB
Haskell
41 lines
1 KiB
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
|
||
|
|
module WooCommerce where
|
||
|
|
|
||
|
|
import Data.Aeson
|
||
|
|
import qualified Data.Bson as B
|
||
|
|
import Data.Maybe
|
||
|
|
import qualified Data.Text as T
|
||
|
|
import Database.MongoDB
|
||
|
|
|
||
|
|
-- | 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 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]]
|