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") <*>
((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"
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"
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"
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"
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"
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"
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"
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\""