shopify-0: Network/Shopify/Orders.hs
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, DeriveDataTypeable #-}
module Network.Shopify.Orders (
Order(..), Address(..), LineItem(..), OrderShipping(..), ShopifyProperty(..), OrderFulfillmentStatus(..), OrderFulfillment(..), DiscountCode(..), TaxLine(..)
, OrderQuery(..), OrderStatus(..), FinancialStatus(..), FulfillmentStatus(..)
, TransactionFailed
, fulfillOrder, captureOrder
, queryOrder, queryOrders
) where
import Data.Int
import Data.Fixed
import Data.Maybe
import Data.Time.Clock
import Control.Monad
import Control.Applicative
import qualified Data.Text as T
import Data.Aeson ((.:), (.:?), (.=))
import qualified Data.Aeson as JS
import qualified Data.Aeson.Types as JS
import qualified Data.ByteString as BS
import Network.HTTP.Types (renderQuery)
import Network.HTTP.Types.QueryLike (toQueryValue)
import qualified Control.Exception as E
import qualified Data.Map as Map
import Data.Typeable
import Network.Shopify.Types
import Network.Shopify.Connection
data OrderQuery =
OQCreatedBefore UTCTime
| OQCreatedAfter UTCTime
| OQFinancialStatus FinancialStatus
| OQFulfillmentStatus FulfillmentStatus
| OQGreaterThen OrderID
| OQStatus OrderStatus
| OQUpdatedBefore UTCTime
| OQUpdatedAfter UTCTime
deriving (Show)
isStatusQuery :: OrderQuery -> Bool
isStatusQuery (OQStatus _) = True
isStatusQuery _ = False
encodeOrderQuery :: OrderQuery -> (BS.ByteString, Maybe BS.ByteString)
encodeOrderQuery (OQCreatedBefore t) = ("created_at_max", dateToQuery t)
encodeOrderQuery (OQCreatedAfter t) = ("created_at_min", dateToQuery t)
encodeOrderQuery (OQFinancialStatus fs) = ("financial_status", toQueryValue $ financialStatusToQuery fs)
encodeOrderQuery (OQFulfillmentStatus fs) = ("fulfillment_status", toQueryValue $ fulfillmentStatusToQuery fs)
encodeOrderQuery (OQGreaterThen oid) = ("since_id", toQueryValue $ show oid)
encodeOrderQuery (OQStatus sts) = ("status", orderStatusToQuery sts)
encodeOrderQuery (OQUpdatedBefore t) = ("updated_at_max", dateToQuery t)
encodeOrderQuery (OQUpdatedAfter t) = ("updated_at_min", dateToQuery t)
financialStatusToQuery :: FinancialStatus -> T.Text
financialStatusToQuery FinancialStatusNull = "abandoned"
financialStatusToQuery FinancialStatusPending = "pending"
financialStatusToQuery FinancialStatusAuthorized = "authorized"
financialStatusToQuery FinancialStatusPaid = "paid"
financialStatusToQuery FinancialStatusPartiallyPaid = "partially_paid"
financialStatusToQuery FinancialStatusVoided = "voided"
financialStatusToQuery FinancialStatusPartialRefund = "partially_refunded"
financialStatusToQuery FinancialStatusRefunded = "refunded"
fulfillmentStatusToQuery :: FulfillmentStatus -> T.Text
fulfillmentStatusToQuery FulfillmentStatusNil = "unshipped"
fulfillmentStatusToQuery FulfillmentStatusPartial = "partial"
fulfillmentStatusToQuery FulfillmentStatusFulfilled = "shipped"
orderStatusToQuery :: OrderStatus -> Maybe BS.ByteString
orderStatusToQuery OrderOpen = Just "open"
orderStatusToQuery OrderClosed = Just "closed"
orderStatusToQuery OrderCancelled = Just "cancelled"
queryOrder :: OrderID -> Shopify Order
queryOrder oid = do
pw <- shopifyGet ("/admin/orders/"++show oid++".json") (const "") ()
case Map.lookup ("order"::T.Text) pw of
Just p -> return p
Nothing -> error "order not pressent"
queryOrders :: [OrderQuery] -> Shopify [Order]
queryOrders q =
getBlock 1 []
where
baseQuery = ("limit", Just "250"):(if any isStatusQuery q
then []
else [("status", Just "any")])++map encodeOrderQuery q
genQuery i qry= renderQuery False (("page", toQueryValue (show i)):qry)
getBlock :: Int -> [Order] -> Shopify [Order]
getBlock i ops = do
psw <- shopifyGet "/admin/orders.json" (genQuery i) baseQuery
ps <- case Map.lookup ("orders"::T.Text) psw of
Just ps -> return ps
Nothing -> error "orders not pressent"
if length ps < 250
then return ((reverse ps) ++ ops)
else getBlock (i+1) ((reverse ps) ++ ops)
data OrderStatus =
OrderOpen
| OrderClosed
| OrderCancelled
deriving (Show)
type TrackingNumber = T.Text
fulfillOrder :: Order -> Maybe TrackingNumber -> Shopify ()
fulfillOrder order mTracking = do
(_::JS.Value) <- shopifySet ("/admin/orders/"++(show . metaId . oMeta) order++"/fulfillments.json") False $
JS.object
[ ("fulfillment", JS.object $ catMaybes
[ fmap ((,) "tracking_number" . JS.toJSON) mTracking
, Just ("notify_customer" .= True) ] ) ]
return ()
data Transaction =
TransactionCapture {
tcFailed :: Bool
}
deriving (Show)
instance JS.FromJSON Transaction where
parseJSON (JS.Object v) = do
(k::String) <- v .: "kind"
case k of
"capture" ->
TransactionCapture <$>
((v .: "status") >>= return . (==) ("failure"::T.Text))
_ -> fail "Unknown transaction type"
parseJSON _ = fail "Transaction must be an object"
transactionFailed :: Transaction -> Bool
transactionFailed (TransactionCapture {tcFailed=f}) = f
data TransactionFailed =
TransactionFailed
deriving (Show, Typeable)
instance E.Exception TransactionFailed
captureOrder :: Order -> Shopify ()
captureOrder order = do
ts <- shopifySet ("/admin/orders/"++(show . metaId . oMeta) order++"/transactions.json") False $
JS.object
[ ("transaction", JS.object $ catMaybes
[ Just ("kind", "capture") ] ) ]
case fmap transactionFailed . Map.lookup ("transaction"::T.Text) $ ts of
Just False -> return ()
_ -> E.throw TransactionFailed
data Order =
Order {
oMeta :: ShopifyMeta
, oEmail :: T.Text
, oNumber :: Int64
, oOrderNum :: Int64
, oOrderName :: T.Text
, oToken :: T.Text
, oNote :: Maybe T.Text
, oAcceptsMarketing :: Bool
, oReferrer :: Maybe T.Text
, oBillingAddress :: Address
, oShippingAddress :: Address
, oShippings :: [OrderShipping]
, oProperties :: [ShopifyProperty]
, oItems :: [LineItem]
, oTaxesIncluded :: Bool
, oTaxLines :: [TaxLine]
, oTotalTax :: Centi
, oDiscounts :: [DiscountCode]
, oTotalDiscounts :: Centi
, oTotalLineItemsPrice :: Centi
, oSubtotal :: Centi
, oCurrency :: T.Text
, oTotalPrice :: Centi
, oTotalPriceUSD :: Centi
, oGrams :: Int
, oFinancialStatus :: FinancialStatus
, oFulfillmentStatus :: OrderFulfillmentStatus
, oFulfillments :: [OrderFulfillment]
, oClosedAt :: Maybe UTCTime
, oCancelledAt :: Maybe UTCTime
, oCancelReason :: Maybe T.Text
}
deriving (Show)
emptyTxtToNothing :: T.Text -> Maybe T.Text
emptyTxtToNothing "" = Nothing
emptyTxtToNothing o = Just o
instance JS.FromJSON Order where
parseJSON (o@(JS.Object v)) =
Order <$>
JS.parseJSON o <*>
(v .: "email" <|> fail "email") <*>
(v .: "number" <|> fail "number") <*>
(v .: "order_number" <|> fail "order number") <*>
(v .: "name" <|> fail "name") <*>
(v .: "token" <|> fail "token") <*>
((v .:? "note" >>= return . join . fmap emptyTxtToNothing) <|> fail "note") <*>
(v .: "buyer_accepts_marketing" <|> fail "accepts marketing") <*>
((v .:? "referring_site" >>= return . join . fmap emptyTxtToNothing) <|> fail "ref site") <*>
(v .: "billing_address" <|> fail "billing addr") <*>
(v .: "shipping_address" <|> v .: "billing_address") <*>
(v .: "shipping_lines" <|> fail "shipping lines") <*>
(v .: "note_attributes" <|> fail "note attrib") <*>
(v .: "line_items" <|> fail "line item") <*>
(v .: "taxes_included" <|> fail "taxes inc.") <*>
(v .: "tax_lines" <|> fail "tax lines") <*>
((v .: "total_tax" >>= return . read) <|> fail "total tax") <*>
(v .: "discount_codes" <|> fail "discount codes") <*>
((v .: "total_discounts" >>= return . read) <|> fail "total discounts") <*>
((v .: "total_line_items_price" >>= return . read) <|> fail "total line items price") <*>
((v .: "subtotal_price" >>= return . read) <|> fail "subtotal") <*>
(v .: "currency" <|> fail "currency") <*>
((v .: "total_price" >>= return . read) <|> fail "total price") <*>
((v .: "total_price_usd" >>= return . read) <|> fail "total price USD") <*>
(v .: "total_weight" <|> fail "mass") <*>
(v .: "financial_status") <*>
(v .: "fulfillment_status" <|> fail "fulfillment status") <*>
(v .: "fulfillments") <*> -- <|> fail "fulfillments") <*>
((v .:? "closed_at" >>= return . fmap actualTime) <|> fail "closed_at") <*>
((v .:? "cancelled_at" >>= return . fmap actualTime) <|> fail "cancelled_at") <*>
(v .: "cancel_reason")
parseJSON _ = fail "Order not an object"
{-
-"buyer_accepts_marketing": false,
-"cancel_reason": null,
-"cancelled_at": null,
-"cart_token": "68778783ad298f1c80c3bafcddeea02f",
-"closed_at": null,
- "id": 450789469,
-"created_at": "2008-01-10T11:00:00-05:00",
-"updated_at": "2008-01-10T11:00:00-05:00",
-"currency": "USD",
-"email": "bob.norman@hostmail.com",
-"financial_status": "authorized",
-"fulfillment_status": null,
"gateway": "authorize_net",
-"landing_site": "http://www.example.com?source=abc",
-"name": "#1001",
-"note": null,
-"number": 1,
-"referring_site": "http://www.otherexample.com",
-"subtotal_price": "398.00",
-"taxes_included": false,
-"token": "b1946ac92492d2347c6235b4d2611184",
-"total_discounts": "0.00",
-"total_line_items_price": "398.00",
-"total_price": "409.94",
-"total_price_usd": "409.94",
-"total_tax": "11.94",
-"total_weight": 0,
"browser_ip": null,
"landing_site_ref": "abc",
-"order_number": 1001,
-"discount_codes": [DiscountCode],
-"note_attributes": [ ShopifyProperty ],
"processing_method": "direct",
-"line_items": [ LineItem ]
-"shipping_lines": [OrderShipping],
-"tax_lines": [ TaxLine ],
"payment_details": {
"avs_result_code": null,
"credit_card_bin": null,
"cvv_result_code": null,
"credit_card_number": "XXXX-XXXX-XXXX-4242",
"credit_card_company": "Visa"
},
-"billing_address": Address
-"shipping_address": Address
-"fulfillments": [ Fulfillment ],
"client_details": {
"accept_language": null,
"browser_ip": "0.0.0.0",
"session_hash": null,
"user_agent": null
},
"customer": Customer
-}
{- Address
-"address1": "Chestnut Street 92",
-"address2": "",
-"city": "Louisville",
-"company": null,
-"country": "United States",
-"first_name": "Bob",
-"last_name": "Norman",
-"latitude": "45.41634",
-"longitude": "-75.6868",
-"phone": "555-625-1199",
-"province": "Kentucky",
-"zip": "40202",
-"name": "Bob Norman",
-"country_code": "US",
-"province_code": "KY"
-}
data Address =
Address {
aFirstName :: T.Text
, aLastName :: T.Text
, aName :: T.Text
, aCompany :: Maybe T.Text
, aStreet1 :: T.Text
, aStreet2 :: Maybe T.Text
, aCity :: T.Text
, aProvince :: T.Text
, aProvinceCode :: T.Text
, aZip :: Maybe T.Text
, aCountry :: T.Text
, aCountryCode :: T.Text
, aPhone :: Maybe T.Text
, aLatLong :: Maybe (Double, Double)
}
deriving (Show)
instance JS.FromJSON Address where
parseJSON (JS.Object v) =
Address <$>
(v .: "first_name" <|> return "" <|> fail "first name") <*>
(v .: "last_name" <|> return "" <|> fail "last name") <*>
(v .: "name" <|> fail "name") <*>
(v .: "company" <|> fail "company") <*>
(v .: "address1" <|> fail "address1") <*>
((v .: "address2" >>= return . join . fmap emptyTxtToNothing) <|> fail "address2") <*>
(v .: "city" <|> fail "city") <*>
((v .:? "province" >>= return . fromMaybe "") <|> fail "province") <*>
((v .:? "province_code" >>= return . fromMaybe "") <|> fail "province code") <*>
(v .: "zip" <|> fail "zip") <*>
(v .: "country" <|> fail "country") <*>
(v .: "country_code" <|> fail "country code") <*>
(v .: "phone" <|> fail "phone") <*>
((do { latStr <- v .: "latitude"; lonStr <- v .: "longitude"; return $ Just (read latStr, read lonStr) }) <|>
pure Nothing)
parseJSON _ = fail "Address not an object"
{-
-"code": "TENOFF",
-"amount": "10.00"
-}
data DiscountCode =
DiscountCode {
dcCode :: T.Text
, dcAmount :: Centi
}
deriving (Show)
instance JS.FromJSON DiscountCode where
parseJSON (JS.Object v) =
DiscountCode <$>
v .: "code" <*>
((v .: "amount") >>= return . read)
parseJSON _ = fail "DiscountCode must be an object"
{-
"code": "Free Shipping",
"price": "0.00",
"source": "shopify",
"title": "Free Shipping"
-}
data OrderShipping =
OrderShipping {
osCode :: T.Text
, osPrice :: Centi
, osSource :: T.Text
, osTitle :: T.Text
}
deriving (Show)
instance JS.FromJSON OrderShipping where
parseJSON (JS.Object v) =
OrderShipping <$>
v .: "code" <*>
((v .: "price") >>= return . read) <*>
v .: "source" <*>
v .: "title"
parseJSON _ = fail "OrderShipping must be an object"
{-
-"name": "Custom Engraving",
-"value": "Happy Birthday"
-}
data ShopifyProperty =
ShopifyProperty {
spName :: T.Text
, spValue :: T.Text
}
deriving (Show)
instance JS.FromJSON ShopifyProperty where
parseJSON (JS.Object v) =
ShopifyProperty <$>
v .: "name" <*>
v .: "value"
parseJSON _ = fail "ShopifyProperty not an object"
{-
"price": "11.94",
"rate": 0.06,
"title": "State Tax"
-}
data TaxLine =
TaxLine {
tlTitle :: T.Text
, tlRate :: Double
, tlPRice :: Centi
}
deriving (Show)
instance JS.FromJSON TaxLine where
parseJSON (JS.Object v) =
TaxLine <$>
v .: "title" <*>
v .: "rate" <*>
(v .: "price" >>= return . read)
parseJSON _ = fail "TaxLine not an object"
{- LineItem
"fulfillment_service": "manual",
"fulfillment_status": null,
- "grams": 200,
-"id": 466157049,
-"price": "199.00",
"product_id": 632910392,
-"quantity": 1,
-"requires_shipping": true,
-"sku": "IPOD2008GREEN",
-"title": "IPod Nano - 8gb",
"variant_id": 39072856,
"variant_title": "green",
"vendor": null,
-"name": "IPod Nano - 8gb - green",
"variant_inventory_management": "shopify",
-"properties": [ ShopifyProperties ]
-}
data LineItem =
LineItem {
liId :: LineItemID
, liGrams :: Int
, liPrice :: Centi
, liSku :: T.Text
, liQuantity :: Int
, liTitle :: T.Text
, liName :: T.Text
, liShips :: Bool
, liProperties :: [ShopifyProperty]
}
deriving (Show)
instance JS.FromJSON LineItem where
parseJSON (JS.Object v) =
LineItem <$>
v .: "id" <*>
v .: "grams" <*>
(v .: "price" >>= return . read) <*>
v .: "sku" <*>
v .: "quantity" <*>
v .: "title" <*>
v .: "name" <*>
v .: "requires_shipping" <*>
v .: "properties"
parseJSON _ = fail "LineItem must be an object"
data FinancialStatus =
FinancialStatusNull
| FinancialStatusPending
| FinancialStatusAuthorized
| FinancialStatusPaid
| FinancialStatusPartiallyPaid
| FinancialStatusVoided
| FinancialStatusPartialRefund
| FinancialStatusRefunded
deriving (Show)
instance JS.FromJSON FinancialStatus where
parseJSON (JS.Null) = return FinancialStatusNull
parseJSON (JS.String "null") = return FinancialStatusNull
parseJSON (JS.String "pending") = return FinancialStatusPending
parseJSON (JS.String "authorized") = return FinancialStatusAuthorized
parseJSON (JS.String "paid") = return FinancialStatusPaid
parseJSON (JS.String "partially_paid") = return FinancialStatusPartiallyPaid
parseJSON (JS.String "voided") = return FinancialStatusVoided
parseJSON (JS.String "partially_refunded") = return FinancialStatusPartialRefund
parseJSON (JS.String "refunded") = return FinancialStatusRefunded
parseJSON (JS.String s) = fail ("unknown FinancialStatus: "++T.unpack s)
parseJSON _ = fail "unknown FinancialStatus"
data FulfillmentStatus =
FulfillmentStatusNil
| FulfillmentStatusPartial
| FulfillmentStatusFulfilled
deriving (Show)
data OrderFulfillmentStatus =
OrderFulfillmentStatusNil
| OrderFulfillmentStatusPartial
| OrderFulfillmentStatusFulfilled
| OrderFulfillmentStatusRestocked
deriving (Show)
instance JS.FromJSON OrderFulfillmentStatus where
parseJSON (JS.Null) = return OrderFulfillmentStatusNil
parseJSON (JS.String "nil") = return OrderFulfillmentStatusNil
parseJSON (JS.String "partial") = return OrderFulfillmentStatusPartial
parseJSON (JS.String "fulfilled") = return OrderFulfillmentStatusFulfilled
parseJSON (JS.String "success") = return OrderFulfillmentStatusFulfilled
parseJSON (JS.String "restocked") = return OrderFulfillmentStatusRestocked
parseJSON _ = fail "unknown OrderFulfillmentStatus"
{- Fulfillment
-"created_at": "2012-10-30T16:09:40-04:00",
-"id": 255858046,
"order_id": 450789469,
"service": "manual",
"status": "failure",
"tracking_company": null,
-"tracking_number": "1Z2345",
-"tracking_url": "http://www.google.com/search?q=1Z2345",
-"updated_at": "2012-10-30T16:09:40-04:00",
"receipt": {
"testcase": true,
"authorization": "123456"
},
-"line_items": [ LineItem ]
-}
data OrderFulfillment =
OrderFulfillment {
fMeta :: ShopifyMeta
, fStatus :: OrderFulfillmentStatus
, fLineItems :: [LineItem]
, fTrackingUrl :: Maybe T.Text
, fTrackingNumber :: Maybe T.Text
, fService :: FulfillmentService
}
deriving (Show)
instance JS.FromJSON OrderFulfillment where
parseJSON (o@(JS.Object v)) =
OrderFulfillment <$>
JS.parseJSON o <*>
(v .: "status" <|> fail "fulfillment status") <*>
(v .: "line_items" <|> fail "fulfillment line items") <*>
(v .: "tracking_url" <|> fail "fulfillment tracking url") <*>
((v .: "tracking_number") <|> ((v .: "tracking_number"::JS.Parser (Maybe Int)) >>= return . Just . T.pack . show) <|> fail "fulfillment tracking number") <*>
(v .: "service" <|> fail "fulfillment service")
parseJSON _ = fail "ShopifyProperty not an object"
data FulfillmentService =
ManualFulfillment
deriving (Show)
instance JS.FromJSON FulfillmentService where
parseJSON (JS.String "manual") = return ManualFulfillment
parseJSON _ = fail "FulfillmentService only currently knows the string \"manual\""
{- Customer
"accepts_marketing": false,
"id": 207119551,
"created_at": "2012-10-30T16:09:40-04:00",
"updated_at": "2012-10-30T16:09:40-04:00",
"email": "bob.norman@hostmail.com",
"first_name": "Bob",
"last_name": "Norman",
"last_order_id": null,
"note": null,
"orders_count": 0,
"state": null,
"total_spent": "0.00",
"tags": "",
"last_order_name": null
-}