module Web.Ebay
(
searchWithVerb
, simpleSearchWithVerb
, defaultEbayConfig
, Search (..)
, SearchRequest (..)
, SearchResponse (..)
, SearchResult (..)
, SearchItem (..)
, SellingStatus (..)
, SortOrder (..)
, FindVerb (..)
, EbayConfig (..)
, SellingState (..)
, ItemFilter (..)
, Condition (..)
, ListingInfo (..)
, OutputSelector (..)
, ProductId (..)
, GalleryInfo (..)
, AffiliateInfo(..)
) where
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Control.Applicative (pure, (<$>), (<*>))
import Control.Monad (mzero)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson (ToJSON(..),FromJSON (..), (.:), (.=), (.:?), object, Value(..))
import Data.Aeson.Types (Parser)
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import Network.HTTP.Client as HTTP
import Network.HTTP.Types as HTTP (Header)
data EbayConfig = EbayConfig
{
ebDomain :: !Text
, ebUri :: !Text
, ebHttps :: !Bool
, ebSiteId :: !Text
, ebResponseEncoding :: !Encoding
, ebRequestEncoding :: !Encoding
, ebAppId :: !Text
, ebVersion :: !Text
, ebService :: !Text
, ebDocUrl :: !Text
, ebDebug :: !Bool
} deriving Show
data Encoding = XmlEncoding
| JsonEncoding
deriving Show
data SearchRequest = SearchRequest
{ verb :: !FindVerb
, payload :: Search
} deriving Show
instance ToJSON SearchRequest where
toJSON SearchRequest{..} = object [ "jsonns.xsi" .= (xsi :: Text)
, "jsonns.xs" .= (xs :: Text)
, "jsonns.tns" .= (nstns :: Text)
, tns .= payload
]
where tns = "tns." <> findVerbToOperation verb True
xsi = "http://www.w3.org/2001/XMLSchema-instance"
xs = "http://www.w3.org/2001/XMLSchema"
nstns = "http://www.ebay.com/marketplace/search/v1/services"
newtype ItemFilter = ItemFilter (Text, Text) deriving Show
instance ToJSON ItemFilter where
toJSON (ItemFilter (name, val)) =
object [ "name" .= name
, "value" .= val
]
data OutputSelector = AspectHistogram
| CategoryHistogram
| ConditionHistogram
| GalleryInfoOutput
| PictureURLLarge
| PictureURLSuperSize
| SellerInfo
| StoreInfo
| UnitPriceInfo
deriving (Generic, Read, Show)
instance ToJSON OutputSelector where
toJSON = A.genericToJSON A.defaultOptions
instance FromJSON OutputSelector
data ProductId = EAN Integer | ISBN Integer | UPC Integer | ReferenceId String deriving Show
productIdToParams :: ProductId -> (String, String)
productIdToParams (EAN ean) = ("EAN", show ean)
productIdToParams (ISBN isbn) = ("ISBN", show isbn)
productIdToParams (UPC upc) = ("UPC", show upc)
productIdToParams (ReferenceId referenceId) = ("ReferenceID", referenceId)
instance ToJSON ProductId where
toJSON productId = object ["@type" .= idType, "__value__" .= id']
where (idType, id') = productIdToParams productId
data Search = Search
{ searchKeywords :: !Text
, searchOutputSelector :: Maybe OutputSelector
, searchSortOrder :: Maybe SortOrder
, searchItemFilter :: ![ItemFilter]
, searchAffiliateInfo :: Maybe AffiliateInfo
, searchProductId :: Maybe ProductId
} deriving Show
instance ToJSON Search where
toJSON Search{..} = object $ [ "keywords" .= searchKeywords
] ++ order searchSortOrder
++ ifilter searchItemFilter
++ oselector searchOutputSelector
++ affiliate searchAffiliateInfo
++ productId searchProductId
where order (Just so) = ["sortOrder" .= so]
order Nothing = []
ifilter [] = []
ifilter sif = [ "itemFilter" .= sif ]
oselector Nothing = []
oselector (Just os) = [ "outputSelector" .= os ]
affiliate Nothing = []
affiliate (Just a) = [ "affiliate" .= a ]
productId Nothing = []
productId (Just a) = [ "productId" .= a ]
data AffiliateInfo = AffiliateInfo
{ networkId :: !Int
, trackingId :: !Int
, customId :: !(Maybe Int)
} deriving (Eq, Read, Show)
instance ToJSON AffiliateInfo where
toJSON AffiliateInfo{..} =
object [ "trackingId" .= trackingId
, "networkId" .= networkId
, "customId" .= customId
]
data SortOrder = EndTimeSoonest
| BestMatch
| BidCountFewest
| BidCountMost
| CountryAscending
| CountryDescending
| CurrentPriceHighest
| DistanceNearest
| PricePlusShipingHighest
| PricePlusShippingLowest
| StartTimeNewest
deriving (Show, Generic)
instance ToJSON SortOrder where
toJSON = A.genericToJSON A.defaultOptions
infixl 5 .:>, .:?>
(.:>) :: FromJSON a => A.Object -> Text -> Parser a
(.:>) obj key = head <$> obj .: key
(.:?>) :: FromJSON a => A.Object -> Text -> Parser (Maybe a)
(.:?>) obj key = do
ma <- obj .:? key
return $ head <$> ma
data SearchResponse = SearchResponse FindVerb SearchResult
deriving Show
parseHead :: FromJSON a => [a] -> Maybe a
parseHead (x:_) = Just x
parseHead _ = Nothing
instance FromJSON SearchResponse where
parseJSON (Object o) = case HM.keys o of
("findCompletedItemsResponse":_) -> do
mobj <- o .: "findCompletedItemsResponse"
case parseHead mobj of
Nothing -> mzero
Just obj -> SearchResponse
<$> pure FindCompletedItems
<*> parseJSON obj
("findItemsByKeywordsResponse":_) -> do
mobj <- o .: "findItemsByKeywordsResponse"
case parseHead mobj of
Nothing -> mzero
Just obj -> SearchResponse
<$> pure FindItemsByKeywords
<*> parseJSON obj
("findItemsAdvancedResponse":_) -> do
mobj <- o .: "findItemsAdvancedResponse"
case parseHead mobj of
Nothing -> mzero
Just obj -> SearchResponse
<$> pure FindItemsAdvanced
<*> parseJSON obj
("errorMessage":_) -> error $ "An error occurred: " ++ show o
_ -> mzero
parseJSON _ = mzero
data SearchResult = SearchResult
{ searchResultCount :: Text
, searchResultItems :: [SearchItem]
} deriving Show
instance FromJSON SearchResult where
parseJSON (Object o) = do
sr <- o .:> "searchResult"
SearchResult <$> sr .: "@count"
<*> sr .: "item"
parseJSON _ = mzero
data SearchItem = SearchItem
{ searchItemId :: !Text
, searchItemTitle :: !Text
, searchItemSubtitle :: !(Maybe Text)
, searchItemTopRatedListing :: !Bool
, searchItemViewItemUrl :: !Text
, searchItemGalleryUrl :: !(Maybe Text)
, searchItemGalleryPlusPictureUrl :: !(Maybe Text)
, searchItemPictureLargeUrl :: !(Maybe Text)
, searchItemCondition :: Condition
, searchItemSellingStatus :: SellingStatus
, searchItemListingInfo :: Maybe ListingInfo
} deriving Show
data GalleryInfo = GalleryInfo
{ galleryInfoUrls :: ![Text]
} deriving Show
instance FromJSON SearchItem where
parseJSON (Object o) =
SearchItem
<$> o .:> "itemId"
<*> o .:> "title"
<*> o .:?> "subtitle"
<*> (o .:> "topRatedListing"
>>= return . truetxt)
<*> o .:> "viewItemURL"
<*> o .:?> "galleryURL"
<*> o .:?> "galleryPlusPictureURL"
<*> o .:?> "pictureURLLarge"
<*> o .:> "condition"
<*> o .:> "sellingStatus"
<*> o .:?> "listingInfo"
where truetxt btxt = btxt == ("True" :: Text) || btxt == "False"
parseJSON _ = mzero
data ListingType = Auction
| AdFormat
| AuctionWithBIN
| Classified
| FixedPrice
| StoreInventory
deriving (Generic, Read, Show)
instance FromJSON ListingType
data ListingInfo = ListingInfo
{ listingInfoBestOfferEnabled :: !Bool
, listingInfoBuyItNowAvailable :: !Bool
, listingInfoBuyItNowPrice :: !(Maybe Text)
, listingInfoConvertedBuyItNowPrice :: !(Maybe Text)
, listingInfoEndTime :: !UTCTime
, listingInfoGift :: !Bool
, listingInfoType :: ListingType
, listingInfoStartTime :: !UTCTime
} deriving Show
instance FromJSON ListingInfo where
parseJSON (Object o) =
ListingInfo
<$> (o .:> "bestOfferEnabled"
>>= return . (== ("true" :: Text)))
<*> (o .:> "buyItNowAvailable"
>>= return . (== ("true" :: Text)))
<*> (o .:?> "buyItNowPrice" >>= \mbin ->
case mbin of
Nothing -> return Nothing
Just bin -> bin .: "__value__")
<*> (o .:?> "convertedBuyItNowPrice" >>= \mcbin ->
case mcbin of
Nothing -> return Nothing
Just cbin -> cbin .: "__value__")
<*> o .:> "endTime"
<*> (o .:> "gift"
>>= return . (== ("true" :: Text)))
<*> o .:> "listingType"
<*> o .:> "startTime"
parseJSON _ = mzero
data SellingStatus = SellingStatus
{ sellingStatusConvertedCurrentPrice :: !Double
, sellingStatusCurrentPrice :: !Double
, sellingStatusBidCount :: !(Maybe Text)
, sellingStatusState :: SellingState
} deriving Show
instance FromJSON SellingStatus where
parseJSON (Object o) = SellingStatus
<$> (o .:> "convertedCurrentPrice"
>>= (.: "__value__")
>>= return . read . T.unpack)
<*> (o .:> "currentPrice"
>>= (.: "__value__")
>>= return . read . T.unpack)
<*> o .:?> "bidCount"
<*> o .:> "sellingState"
parseJSON _ = mzero
data SellingState = Active
| Canceled
| Ended
| EndedWithSales
| EndedWithoutSales
deriving (Eq, Generic, Show)
instance FromJSON SellingState
data Condition = Condition Text Text deriving Show
instance FromJSON Condition where
parseJSON (Object o) = Condition
<$> o .:> "conditionId"
<*> o .:> "conditionDisplayName"
parseJSON _ = mzero
data FindVerb = FindCompletedItems
| FindItemsAdvanced
| FindItemsByImage
| FindItemsByKeywords
| FindItemsByProduct
| FindItemsIneBayStores
| GetHistograms
| GetSearchKeywordsRecommendation
| GetVersion
deriving Show
simpleSearchWithVerb :: EbayConfig
-> SearchRequest
-> IO (Maybe SearchResponse)
simpleSearchWithVerb cfg (SearchRequest fv s) = do
man <- newManager defaultManagerSettings
searchWithVerb cfg fv s man
searchWithVerb :: MonadIO m
=> EbayConfig
-> FindVerb
-> Search
-> Manager
-> m (Maybe SearchResponse)
searchWithVerb ecfg cmd search manager = do
initreq <- liftIO $ HTTP.parseUrl (eburl ecfg)
let req = initreq
{ method = "POST"
, requestHeaders = requestHeaders initreq
++ requestHeadersFromConfig cmd ecfg
, requestBody = encodeRequestBody esr
}
res' <- liftIO $ HTTP.httpLbs req manager
return $ decodeResponseBody res'
where
proto = if ebHttps ecfg then "https://" else "http://"
eburl EbayConfig{..} = T.unpack $ proto <> ebDomain <> ebUri
esr = SearchRequest cmd search
encodeRequestBody = RequestBodyBS . L.toStrict . A.encode
decodeResponseBody :: Response L.ByteString -> Maybe SearchResponse
decodeResponseBody = A.decode . responseBody
defaultEbayConfig :: EbayConfig
defaultEbayConfig = EbayConfig
{ ebDomain = "svcs.ebay.com"
, ebUri = "/services/search/FindingService/v1"
, ebSiteId = "EBAY-US"
, ebResponseEncoding = JsonEncoding
, ebRequestEncoding = JsonEncoding
, ebAppId = ""
, ebVersion = "1.12.0"
, ebService = "FindingService"
, ebDocUrl = docurl
, ebDebug = False
, ebHttps = False
}
where
docurl = "http://developer.ebay.com/DevZone/finding/CallRef/index.html"
requestHeadersFromConfig :: FindVerb -> EbayConfig -> [HTTP.Header]
requestHeadersFromConfig fb EbayConfig{..} =
[ ("Content-Type", "application/json")
, ("X-EBAY-SOA-SERVICE-NAME", utf8 ebService)
, ("X-EBAY-SOA-SERVICE-VERSION", utf8 ebVersion)
, ("X-EBAY-SOA-SECURITY-APPNAME", utf8 ebAppId)
, ("X-EBAY-SOA-GLOBAL-ID", utf8 ebSiteId)
, ("X-EBAY-SOA-OPERATION-NAME", encodedFindVerb)
, ("X-EBAY-SOA-REQUEST-DATA-FORMAT", dataFormatEncode ebRequestEncoding)
, ("X-EBAY-SOA-RESPONSE-DATA-FORMAT", dataFormatEncode ebResponseEncoding)
]
where
utf8 = T.encodeUtf8
dataFormatEncode JsonEncoding = utf8 "JSON"
dataFormatEncode XmlEncoding = utf8 "XML"
encodedFindVerb = T.encodeUtf8 $ findVerbToOperation fb False
findVerbToOperation :: FindVerb -> Bool -> Text
findVerbToOperation fb tns = op <> req
where
op = case fb of
FindItemsByKeywords -> "findItemsByKeywords"
FindCompletedItems -> "findCompletedItems"
FindItemsAdvanced -> "findItemsAdvanced"
FindItemsByImage -> "findItemsByImage"
FindItemsByProduct -> "findItemsByProduct"
FindItemsIneBayStores -> "findItemsIneBayStores"
GetHistograms -> "getHistograms"
GetSearchKeywordsRecommendation -> "getSearchKeywordsRecommendation"
GetVersion -> "getVersion"
req = if tns then "Request" else ""