uber (empty) → 0.1.0.0
raw patch · 17 files changed
+1218/−0 lines, 17 filesdep +aesondep +basedep +hspecsetup-changed
Dependencies added: aeson, base, hspec, text, uber, webapi
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Uber.hs +15/−0
- src/Uber/Auth.hs +50/−0
- src/Uber/Client.hs +220/−0
- src/Uber/Contract.hs +190/−0
- src/Uber/Settings.hs +27/−0
- src/Uber/Types/History.hs +45/−0
- src/Uber/Types/Misc.hs +88/−0
- src/Uber/Types/PriceEstimate.hs +37/−0
- src/Uber/Types/Product.hs +57/−0
- src/Uber/Types/Reminder.hs +66/−0
- src/Uber/Types/RideRequest.hs +180/−0
- src/Uber/Types/TimeEstimate.hs +32/−0
- src/Uber/Types/UserInfo.hs +22/−0
- test/Spec.hs +107/−0
- uber.cabal +50/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Uber.hs view
@@ -0,0 +1,15 @@+module Uber+ ( module Uber.Auth+ , module Uber.Client+ , module Uber.Contract+ , module Uber.Settings+ , module WebApi.Contract+ , module WebApi.Client+ ) where++import Uber.Auth+import Uber.Client+import Uber.Contract+import Uber.Settings+import WebApi.Contract+import WebApi.Client
+ src/Uber/Auth.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+module Uber.Auth+ ( Token (..)+ , ServerToken (..)+ , OAuthToken (..)+ ) where++import Data.Monoid ((<>))+import Data.Text+import GHC.Generics (Generic)+import WebApi++data AuthHeader = AuthHeader+ { authorization :: Text+ } deriving Generic++-- | Data type used to store Server Token+newtype ServerToken = ServerToken Text+ deriving Show++-- | Data type used to store OAuth Token+newtype OAuthToken = OAuthToken Text+ deriving Show++-- | Data type used to store either Server or OAuth token+data Token = Server ServerToken+ | OAuth OAuthToken+ deriving Show++class FromToken a where+ fromToken :: a -> Text++instance FromToken ServerToken where+ fromToken (ServerToken x) = "Token " <> x++instance FromToken OAuthToken where+ fromToken (OAuthToken x) = "Bearer " <> x++instance FromToken Token where+ fromToken (Server x) = fromToken x+ fromToken (OAuth x) = fromToken x++instance ToHeader AuthHeader+instance ToHeader ServerToken where+ toHeader = toHeader . AuthHeader . fromToken+instance ToHeader OAuthToken where+ toHeader = toHeader . AuthHeader . fromToken+instance ToHeader Token where+ toHeader = toHeader . AuthHeader . fromToken
+ src/Uber/Client.hs view
@@ -0,0 +1,220 @@+module Uber.Client where++import Data.Text+import Uber.Auth+import Uber.Contract+import Uber.Settings+import Uber.Types.Product+import Uber.Types.PriceEstimate+import Uber.Types.TimeEstimate+import Uber.Types.History+import Uber.Types.UserInfo+import Uber.Types.RideRequest+import Uber.Types.Misc+import Uber.Types.Reminder+import WebApi++-- | Returns information about the Uber products offered at a given location +getProducts :: Settings -> LatLng -> IO (Response GET ProductsR)+getProducts settings ll = do+ client (addV1 $ toClientSettings settings) $+ Request () ll () () (auth settings) () ()++-- | Returns information aboit a specific Uber product+getProductDetails :: Settings -> ProductId -> IO (Response GET ProductDetailsR)+getProductDetails settings (ProductId pid) = do+ client (addV1 $ toClientSettings settings) $+ Request (ProdId $ Field pid) () () () (auth settings) () ()++-- | Returns an estimated price range for each product offered at a given location+getPriceEstimate :: Settings -> PriceEstimateParams -> IO (Response GET PriceEstimateR)+getPriceEstimate settings pp = do+ client (addV1 $ toClientSettings settings) $+ Request () pp () () (auth settings) () ()++-- | Returns ETAs for all products offered at a given location+getTimeEstimate :: Settings -> TimeEstimateParams -> IO (Response GET TimeEstimateR)+getTimeEstimate settings tp = do+ client (addV1 $ toClientSettings settings) $+ Request () tp () () (auth settings) () ()++-- | Returns data about a user’s activity with Uber+getHistory :: Settings -> HistoryParams -> IO (Response GET HistoryR)+getHistory settings hp = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "getHistory: Requires OAuth token"+ client (addV12 $ toClientSettings settings) $+ Request () hp () () tkn () ()++-- | Returns information about the Uber user that has authorized with the application+getUserInfo :: Settings -> IO (Response GET UserInfoR)+getUserInfo settings = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "getUserInfo: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request () () () () tkn () ()++-- | Requests a ride on behalf of an Uber user+requestARide :: Settings -> RideReqParams -> IO (Response POST RequestRideR)+requestARide settings rp = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "requestARide: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request () () () () tkn () rp++-- | Returns the real-time details for an ongoing trip+getCurrentRequest :: Settings -> IO (Response GET CurrentRequestR)+getCurrentRequest settings = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "getCurrentRequest: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request () () () () tkn () ()++-- | Updates an ongoing request’s destination+updateCurrentRequest :: Settings -> RidePatchParams -> IO (Response PATCH CurrentRequestR)+updateCurrentRequest settings rp = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "updateCurrentRequest: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request () () () () tkn () rp++-- | Cancels the user's current trip+cancelCurrentRequest :: Settings -> IO (Response DELETE CurrentRequestR)+cancelCurrentRequest settings = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "cancelCurrentRequest: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request () () () () tkn () ()++-- | Gets a ride's estimates given the desired product, start, and end locations+getRideEstimate :: Settings -> RideReqParams -> IO (Response POST RideEstimateR)+getRideEstimate settings rp = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "getRideEstimate: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request () () () () tkn () rp++type RideId = Text+type PlaceId = Text+type ReminderId = Text++-- | Gets the status of an ongoing or completed trip+getRideStatus :: Settings -> RideId -> IO (Response GET RideR)+getRideStatus settings rid = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "getRideStatus: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request rid () () () tkn () ()++-- | Cancels an ongoing Request on behalf of a rider+cancelRide :: Settings -> RideId -> IO (Response GET RideR)+cancelRide settings rid = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "cancelRide: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request rid () () () tkn () ()++-- | Updates an ongoing request’s destination+updateRide :: Settings -> RideId -> RidePatchParams -> IO (Response PATCH RideR)+updateRide settings rid rp = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "updateRide: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request rid () () () tkn () rp++-- | Gets a map for an accepted Request+getTrackingMap :: Settings -> RideId -> IO (Response GET TrackingMapR)+getTrackingMap settings rid = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "getTrackingMap: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request rid () () () tkn () ()++-- | Gets the receipt information of the completed request+getReceipt :: Settings -> RideId -> IO (Response GET ReceiptR)+getReceipt settings rid = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "getReceipt: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request rid () () () tkn () ()++-- | Retrieves home and work addresses from an Uber user's profile+getAddress :: Settings -> PlaceId -> IO (Response GET PlaceR)+getAddress settings pid = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "getAddress: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request pid () () () tkn () ()++-- | Updates home and work addresses for an Uber user's profile+updateAddress :: Settings -> PlaceId -> Address -> IO (Response PUT PlaceR)+updateAddress settings pid addr = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "updateAddress: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request pid () () () tkn () addr++-- | Retrievs the list of user’s available payment methods+getPaymentMethods :: Settings -> IO (Response GET PaymentMethodR)+getPaymentMethods settings = do+ let tkn = case auth settings of+ OAuth tkn -> tkn+ _ -> error "getPaymentMethods: Requires OAuth token"+ client (addV1 $ toClientSettings settings) $+ Request () () () () tkn () ()++-- | Sets a reminder for a future trip+createReminder :: Settings -> ReminderParams -> IO (Response POST CreateReminderR)+createReminder settings rp = do+ let tkn = case auth settings of+ Server tkn -> tkn+ _ -> error "createReminder: Requires Server token"+ client (addV1 $ toClientSettings settings) $+ Request () () () () tkn () rp++-- | Gets the status of an existing ride reminder+getReminderInfo :: Settings -> ReminderId -> IO (Response GET ReminderR)+getReminderInfo settings rid = do+ let tkn = case auth settings of+ Server tkn -> tkn+ _ -> error "getReminderInfo: Requires Server token"+ client (addV1 $ toClientSettings settings) $+ Request rid () () () tkn () ()++-- | Removes any reminder in the pending state from being sent+deleteReminder :: Settings -> ReminderId -> IO (Response DELETE ReminderR)+deleteReminder settings rid = do+ let tkn = case auth settings of+ Server tkn -> tkn+ _ -> error "deleteReminder: Requires Server token"+ client (addV1 $ toClientSettings settings) $+ Request rid () () () tkn () ()++-- | Updates an existing reminder+updateReminder :: Settings -> ReminderId -> ReminderPatchParams -> IO (Response PATCH ReminderR)+updateReminder settings rid rp = do+ let tkn = case auth settings of+ Server tkn -> tkn+ _ -> error "updateReminder: Requires Server token"+ client (addV1 $ toClientSettings settings) $+ Request rid () () () tkn () rp++addV1 :: ClientSettings -> ClientSettings+addV1 settings = settings { baseUrl = baseUrl settings ++ "/v1" }++addV12 :: ClientSettings -> ClientSettings+addV12 settings = settings { baseUrl = baseUrl settings ++ "/v1.2" }
+ src/Uber/Contract.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+module Uber.Contract where++import WebApi+import Data.Proxy+import Data.Text.Encoding+import Data.Text (Text)+import Uber.Auth+import Uber.Types.Product+import Uber.Types.PriceEstimate+import Uber.Types.TimeEstimate+import Uber.Types.History+import Uber.Types.UserInfo+import Uber.Types.RideRequest+import Uber.Types.Misc+import Uber.Types.Reminder++data UberAPI ++type ProductsR = Static "products"+type ProductDetailsR = "products" :/ Text+type PriceEstimateR = "estimates" :/ "price"+type TimeEstimateR = "estimates" :/ "time"+type HistoryR = Static "history"+type UserInfoR = Static "me"+type RequestRideR = Static "requests"+type CurrentRequestR = "requests" :/ "current"+type RideR = "requests" :/ Text+type RideEstimateR = "requests" :/ "estimate"+type TrackingMapR = "requests" :/ Text :/ "map"+type ReceiptR = "requests" :/ Text :/ "receipts"+type PlaceR = "places" :/ Text+type PaymentMethodR = Static "payment-methods"+type CreateReminderR = Static "reminders"+type ReminderR = "reminders" :/ Text++instance WebApi UberAPI where+ type Apis UberAPI =+ '[ Route '[GET ] ProductsR+ , Route '[GET ] ProductDetailsR+ , Route '[GET ] PriceEstimateR+ , Route '[GET ] TimeEstimateR+ , Route '[GET ] HistoryR+ , Route '[GET ] UserInfoR+ , Route '[POST ] RequestRideR+ , Route '[GET, PATCH, DELETE ] CurrentRequestR+ , Route '[GET, PATCH, DELETE ] RideR+ , Route '[POST ] RideEstimateR+ , Route '[GET ] TrackingMapR+ , Route '[GET ] ReceiptR+ , Route '[GET, PUT ] PlaceR+ , Route '[GET ] PaymentMethodR+ , Route '[POST ] CreateReminderR+ , Route '[GET, PATCH, DELETE ] ReminderR+ ]++instance ApiContract UberAPI GET ProductsR where+ type HeaderIn GET ProductsR = Token+ type QueryParam GET ProductsR = LatLng+ type ApiOut GET ProductsR = Products++instance ApiContract UberAPI GET ProductDetailsR where+ type HeaderIn GET ProductDetailsR = Token+ type PathParam GET ProductDetailsR = ProdId+ type ApiOut GET ProductDetailsR = Product++instance ApiContract UberAPI GET PriceEstimateR where+ type HeaderIn GET PriceEstimateR = Token+ type QueryParam GET PriceEstimateR = PriceEstimateParams+ type ApiOut GET PriceEstimateR = PriceEstimates++instance ApiContract UberAPI GET TimeEstimateR where+ type HeaderIn GET TimeEstimateR = Token+ type QueryParam GET TimeEstimateR = TimeEstimateParams+ type ApiOut GET TimeEstimateR = TimeEstimates++instance ApiContract UberAPI GET HistoryR where+ type HeaderIn GET HistoryR = OAuthToken+ type QueryParam GET HistoryR = HistoryParams+ type ApiOut GET HistoryR = HistoryResp++instance ApiContract UberAPI GET UserInfoR where+ type HeaderIn GET UserInfoR = OAuthToken+ type ApiOut GET UserInfoR = UserInfo++instance ApiContract UberAPI POST RequestRideR where+ type HeaderIn POST RequestRideR = OAuthToken+ type RequestBody POST RequestRideR = '[RideReqParams]+ type ApiOut POST RequestRideR = RideInfo+ type ApiErr POST RequestRideR = ErrorResponse++instance ApiContract UberAPI GET CurrentRequestR where+ type HeaderIn GET CurrentRequestR = OAuthToken+ type ApiOut GET CurrentRequestR = RideInfo++instance ApiContract UberAPI PATCH CurrentRequestR where+ type HeaderIn PATCH CurrentRequestR = OAuthToken+ type RequestBody PATCH CurrentRequestR = '[RidePatchParams]+ type ApiOut PATCH CurrentRequestR = HTMLText+ type ApiErr PATCH CurrentRequestR = HTMLText+ type ContentTypes PATCH CurrentRequestR = '[HTML]++instance ApiContract UberAPI DELETE CurrentRequestR where+ type HeaderIn DELETE CurrentRequestR = OAuthToken+ type ApiOut DELETE CurrentRequestR = HTMLText+ type ApiErr DELETE CurrentRequestR = HTMLText+ type ContentTypes DELETE CurrentRequestR = '[HTML]++instance ApiContract UberAPI POST RideEstimateR where+ type HeaderIn POST RideEstimateR = OAuthToken+ type RequestBody POST RideEstimateR = '[RideReqParams]+ type ApiOut POST RideEstimateR = RideEstimate++instance ApiContract UberAPI GET RideR where+ type HeaderIn GET RideR = OAuthToken+ type PathParam GET RideR = Text+ type ApiOut GET RideR = RideInfo++instance ApiContract UberAPI PATCH RideR where+ type HeaderIn PATCH RideR = OAuthToken+ type PathParam PATCH RideR = Text+ type RequestBody PATCH RideR = '[RidePatchParams]+ type ApiOut PATCH RideR = HTMLText+ type ApiErr PATCH RideR = HTMLText+ type ContentTypes PATCH RideR = '[HTML]++instance ApiContract UberAPI DELETE RideR where+ type HeaderIn DELETE RideR = OAuthToken+ type PathParam DELETE RideR = Text+ type ApiOut DELETE RideR = HTMLText+ type ApiErr DELETE RideR = HTMLText+ type ContentTypes DELETE RideR = '[HTML]++instance ApiContract UberAPI GET TrackingMapR where+ type HeaderIn GET TrackingMapR = OAuthToken+ type PathParam GET TrackingMapR = Text+ type ApiOut GET TrackingMapR = TrackingMap++instance ApiContract UberAPI GET ReceiptR where+ type HeaderIn GET ReceiptR = OAuthToken+ type PathParam GET ReceiptR = Text+ type ApiOut GET ReceiptR = Receipt+ +instance ApiContract UberAPI GET PlaceR where+ type HeaderIn GET PlaceR = OAuthToken+ type PathParam GET PlaceR = Text+ type ApiOut GET PlaceR = Address+ +instance ApiContract UberAPI PUT PlaceR where+ type HeaderIn PUT PlaceR = OAuthToken+ type PathParam PUT PlaceR = Text+ type RequestBody PUT PlaceR = '[Address]+ type ApiOut PUT PlaceR = Address+ +instance ApiContract UberAPI GET PaymentMethodR where+ type HeaderIn GET PaymentMethodR = OAuthToken+ type ApiOut GET PaymentMethodR = PaymentMethods+ +instance ApiContract UberAPI POST CreateReminderR where+ type HeaderIn POST CreateReminderR = ServerToken+ type RequestBody POST CreateReminderR = '[ReminderParams]+ type ApiOut POST CreateReminderR = Reminder++instance ApiContract UberAPI GET ReminderR where+ type HeaderIn GET ReminderR = ServerToken+ type PathParam GET ReminderR = Text+ type ApiOut GET ReminderR = Reminder++instance ApiContract UberAPI PATCH ReminderR where+ type HeaderIn PATCH ReminderR = ServerToken+ type PathParam PATCH ReminderR = Text+ type RequestBody PATCH ReminderR = '[ReminderPatchParams]+ type ApiOut PATCH ReminderR = Reminder++instance ApiContract UberAPI DELETE ReminderR where+ type HeaderIn DELETE ReminderR = ServerToken+ type PathParam DELETE ReminderR = Text+ type ApiOut DELETE ReminderR = HTMLText+ type ApiErr DELETE ReminderR = HTMLText+ type ContentTypes DELETE ReminderR = '[HTML]++instance Decode HTML HTMLText where+ decode _ = (HTMLText <$>) . (decode (Proxy :: Proxy PlainText))++data HTMLText = HTMLText Text deriving Show
+ src/Uber/Settings.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+module Uber.Settings+ ( defSettings+ , sandboxSettings+ , auth+ , Settings+ , toClientSettings+ ) where++import Data.Text (unpack, Text)+import Uber.Auth+import WebApi++data Settings = Settings+ { url :: Text+ , auth :: Token+ , manager :: Manager+ }++sandboxSettings :: Manager -> Settings+sandboxSettings mngr = Settings "https://sandbox-api.uber.com" (Server $ ServerToken "") mngr++defSettings :: Manager -> Settings+defSettings mngr = Settings "https://api.uber.com" (Server (ServerToken "")) mngr++toClientSettings :: Settings -> ClientSettings+toClientSettings (Settings u _ m) = ClientSettings (unpack u) m
+ src/Uber/Types/History.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Uber.Types.History where++import Data.Aeson+import Data.Aeson.Types+import Data.Text (Text)+import GHC.Generics (Generic)+import Uber.Auth+import WebApi++data HistoryParams = HistoryParams+ { offset :: Maybe Int+ , limit :: Maybe Int+ } deriving (Show, Generic)++data HistoryResp = HistoryResp+ { h_offset :: Int+ , h_limit :: Int+ , h_count :: Int+ , h_history :: [History]+ } deriving (Show, Generic)++data History = History+ { request_id :: Text+ , request_time :: Integer+ , product_id :: Text+ , status :: Text+ , distance :: Double+ , start_time :: Integer+ , start_city :: City+ } deriving (Show, Generic)++data City = City+ { display_name :: Text+ , latitude :: Double+ , longitude :: Double+ } deriving (Show, Generic)++instance ToParam HistoryParams 'QueryParam+instance FromJSON History where+instance FromJSON City where+instance FromJSON HistoryResp where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }
+ src/Uber/Types/Misc.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Uber.Types.Misc where++import Data.Aeson+import Data.Aeson.Types+import Data.Text (Text)+import GHC.Generics (Generic)+import Uber.Types.RideRequest (toUnderscores)+import WebApi++data TrackingMap = TrackingMap+ { t_request_id :: Text+ , t_href :: Text+ } deriving (Generic, Show)++data Receipt = Receipt+ { request_id :: Text+ , charges :: [Charge]+ , surge_charge :: Maybe Charge+ , charge_adjustments :: [Charge]+ , normal_fare :: Text+ , subtotal :: Text+ , total_charged :: Text+ , total_owed :: Maybe Double+ , currency_code :: Text+ , duration :: Text+ , distance :: Text+ , distance_label :: Text+ } deriving (Generic, Show)++data Charge = Charge+ { name :: Text+ , amount :: Double+ } deriving (Generic, Show)++data Address = Address+ { address :: Text+ } deriving (Generic, Show)++newtype PaymentMethods = PaymentMethods + { payment_methods :: [PaymentMethod]+ } deriving (Generic, Show)++data PaymentMethod = PaymentMethod+ { p_payment_method_id :: Text+ , p_type :: PaymentType+ , p_description :: Maybe Text+ , p_last_used :: Maybe Text+ } deriving (Generic, Show)++data PaymentType+ = AirtelMoney+ | Alipay+ | ApplePay+ | AmericanExpress+ | BaiduWallet+ | BusinessAccount+ | Cash+ | Discover+ | GoogleWallet+ | Jcb+ | Lianlian+ | Maestro+ | Mastercard+ | Paypal+ | Paytm+ | Ucharge+ | Unionpay+ | Unknown+ | Visa+ | Zaakpay+ deriving (Generic, Show)++instance FromJSON Receipt where+instance FromJSON Charge where+instance FromJSON Address where+instance FromJSON PaymentMethods where+instance ToJSON Address where+instance FromJSON PaymentMethod where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }+instance FromJSON TrackingMap where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }+instance FromJSON PaymentType where+ parseJSON = genericParseJSON defaultOptions { allNullaryToStringTag = True+ , constructorTagModifier = toUnderscores+ }
+ src/Uber/Types/PriceEstimate.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Uber.Types.PriceEstimate where++import Data.Aeson+import Data.Text (Text)+import GHC.Generics (Generic)+import Uber.Auth+import WebApi++data PriceEstimateParams = PriceEstimateParams+ { start_latitude :: Double+ , start_longitude :: Double+ , end_latitude :: Double+ , end_longitude :: Double+ } deriving (Show, Generic)++newtype PriceEstimates = PriceEstimates+ { prices :: [PriceEstimate]+ } deriving (Show, Generic)++data PriceEstimate = PriceEstimate+ { product_id :: Text+ , currency_code :: Text+ , display_name :: Text+ , estimate :: Text+ , low_estimate :: Int+ , high_estimate :: Int+ , surge_multiplier :: Double+ , duration :: Int+ , distance :: Double+ } deriving (Show, Generic)++instance ToParam PriceEstimateParams 'QueryParam+instance FromJSON PriceEstimates+instance FromJSON PriceEstimate
+ src/Uber/Types/Product.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Uber.Types.Product where++import Data.Aeson+import Data.Text (Text)+import GHC.Generics (Generic)+import Uber.Auth+import WebApi++data LatLng = LatLng+ { latitude :: Double+ , longitude :: Double+ } deriving (Show, Generic)++newtype Products = Products { products :: [Product] }+ deriving (Show, Generic)++data Product = Product+ { product_id :: Text+ , short_description :: Maybe Text+ , description :: Text+ , display_name :: Text+ , capacity :: Int+ , image :: Text+ , price_details :: PriceDetails+ } deriving (Show, Generic)++data PriceDetails = PriceDetails+ { base :: Double+ , minimum :: Double+ , cost_per_minute :: Double+ , cost_per_distance :: Double+ , distance_unit :: Text+ , cancellation_fee :: Double+ , currency_code :: Text+ , service_fees :: [AdditionalFee]+ } deriving (Show, Generic)++data AdditionalFee = AdditionalFee+ { name :: Text+ , fee :: Double+ } deriving (Show, Generic)++newtype ProdId = ProdId+ { pid :: Field "product_id" Text+ } deriving (Generic)++data ProductId = ProductId Text++instance ToParam LatLng 'QueryParam+instance ToParam ProdId 'PathParam+instance FromJSON Products+instance FromJSON Product+instance FromJSON PriceDetails+instance FromJSON AdditionalFee
+ src/Uber/Types/Reminder.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Uber.Types.Reminder where++import Data.Aeson+import Data.Aeson.Types+import Data.Char (toLower)+import Data.Text (Text)+import GHC.Generics (Generic)+import WebApi++data ReminderParams = ReminderParams+ { reminder_time :: Integer+ , phone_number :: Text+ , event :: Event+ , trip_branding :: Maybe TripBranding+ } deriving (Generic, Show)++data Event = Event+ { time :: Integer+ , name :: Maybe Text+ , location :: Maybe Text+ , latitude :: Maybe Double+ , longitude :: Maybe Double+ , product_id :: Maybe Text+ } deriving (Generic, Show)++data TripBranding = TripBranding+ { link_text :: Maybe Text+ , partner_deeplink :: Maybe Text+ } deriving (Generic, Show)++data Reminder = Reminder+ { r_event :: Event+ --, r_product_id :: Maybe Text+ , r_reminder_id :: Text+ , r_reminder_time :: Integer+ , r_reminder_status :: ReminderStatus+ , r_trip_branding :: Maybe TripBranding+ } deriving (Generic, Show)++data ReminderStatus = Pending | Sent+ deriving (Generic, Show)++data ReminderPatchParams = ReminderPatchParams+ { p_reminder_time :: Maybe Int+ , p_phone_number :: Maybe Text+ , p_event :: Maybe Event+ --, p_trip_branding :: Maybe TripBranding+ } deriving (Generic, Show)+++instance ToJSON ReminderParams+instance FromJSON Event+instance FromJSON TripBranding+instance ToJSON Event+instance ToJSON TripBranding+instance ToJSON ReminderPatchParams where+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 2 }+instance FromJSON Reminder where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }+instance FromJSON ReminderStatus where+ parseJSON = genericParseJSON defaultOptions { allNullaryToStringTag = True+ , constructorTagModifier = map toLower+ }
+ src/Uber/Types/RideRequest.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Uber.Types.RideRequest where++import Data.Aeson+import Data.Aeson.Types+import Data.Char+import Data.List (intercalate)+import Data.Text (Text)+import GHC.Generics (Generic)+import Uber.Auth+import WebApi++data RideReqParams = RideReqParams+ { product_id :: Maybe Text+ , start_latitude :: Maybe Double+ , start_longitude :: Maybe Double+ , start_nickname :: Maybe Text+ , start_address :: Maybe Text+ , start_place_id :: Maybe Text+ , end_latitude :: Maybe Double+ , end_longitude :: Maybe Double+ , end_nickname :: Maybe Text+ , end_address :: Maybe Text+ , end_place_id :: Maybe Text+ , surge_confirmation_id :: Maybe Text+ , payment_method_id :: Maybe Text+ } deriving (Generic, Show)++defRideReqParams :: RideReqParams+defRideReqParams = RideReqParams Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing ++data RideInfo = RideInfo+ { request_id :: Text+ , status :: Status+ , vehicle :: Maybe Vehicle+ , driver :: Maybe Driver+ , location :: Maybe Location+ , eta :: Maybe Integer+ , surge_multiplier :: Maybe Double+ , pickup :: Maybe Pickup+ , destination ::Maybe Destination+ } deriving (Generic, Show)++data Status = Processing+ | NoDriversAvailable+ | Accepted+ | Arriving+ | InProgress+ | DriverCanceled+ | RiderCanceled+ | Completed+ deriving (Generic, Show)++data Vehicle = Vehicle+ { make :: Text+ , model :: Text+ , license_plate :: Text+ , picture_url :: Text+ } deriving (Generic, Show)++data Driver = Driver+ { d_phone_number :: Text+ , d_rating :: Double+ , d_picture_url :: Text+ , d_name :: Text+ } deriving (Generic, Show)++data Location = Location+ { latitude :: Double+ , longitude :: Double+ , bearing :: Int+ } deriving (Generic, Show)++data Pickup = Pickup+ { p_latitude :: Double+ , p_longitude :: Double+ , p_eta :: Double+ } deriving (Generic, Show)++data Destination = Destination+ { d_latitude :: Double+ , d_longitude :: Double+ , d_eta :: Maybe Double+ } deriving (Generic, Show)++data RidePatchParams = RidePatchParams+ { r_end_latitude :: Maybe Double+ , r_end_longitude :: Maybe Double+ , r_end_address :: Maybe Text+ , r_end_nickname :: Maybe Text+ , r_end_place_id :: Maybe Text+ } deriving (Generic, Show)++data RideEstimate = RideEstimate+ { pickup_estimate :: Int+ , price :: Price+ , trip :: Maybe Trip+ } deriving (Generic, Show)++data Price = Price+ { p_surge_multiplier :: Double+ , p_surge_confirmation_id :: Maybe Text+ , p_surge_confirmation_href :: Maybe Text+ , p_minimum :: Int+ , p_display :: Maybe Text+ , p_low_estimate :: Maybe Int+ , p_high_estimate :: Maybe Int+ , p_currency_code :: Text+ } deriving (Generic, Show)++data Trip = Trip+ { distance_estimate :: Double+ , distance_unit :: Text+ , duration_estimate :: Int+ } deriving (Generic, Show)++data ErrorResponse = ErrorResponse+ { meta :: SurgeError+ , errors :: [UberError]+ } deriving (Generic, Show)++data UberError = UberError+ { u_status :: Int+ , u_code :: Text+ , u_title :: Text+ } deriving (Generic, Show)++data SurgeError = SurgeError+ { surge_confirmation :: SurgeConfirmation+ } deriving (Generic, Show)++data SurgeConfirmation = SurgeConfirmation+ { s_href :: Text+ , s_surge_confirmation_id :: Text+ , s_multiplier :: Double+ , s_expires_at :: Integer+ } deriving (Generic, Show)++instance ToJSON RideReqParams where+instance FromJSON RideInfo where+instance FromJSON Vehicle where+instance FromJSON Location where+instance FromJSON RideEstimate where+instance FromJSON Trip where+instance FromJSON ErrorResponse where+instance FromJSON SurgeError where+instance FromJSON Price where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }+instance FromJSON Driver where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }+instance FromJSON Pickup where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }+instance FromJSON Destination where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }+instance FromJSON SurgeConfirmation where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }+instance FromJSON UberError where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }+instance FromJSON Status where+ parseJSON = genericParseJSON defaultOptions { allNullaryToStringTag = True+ , constructorTagModifier = toUnderscores+ }+instance ToJSON RidePatchParams where+ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 2 }++splitOnUpper :: String -> [String]+splitOnUpper [] = []+splitOnUpper s = let (ys, zs) = fn (lowerHead s) in (ys : splitOnUpper zs)+ where+ fn [] = ([], [])+ fn (x:xs) = if isUpper x+ then ([], toLower x : xs)+ else let (ys, zs) = fn xs in (x:ys, zs)+ lowerHead [] = []+ lowerHead (x:xs) = toLower x : xs++toUnderscores :: String -> String+toUnderscores = map toLower . intercalate "_" . splitOnUpper
+ src/Uber/Types/TimeEstimate.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Uber.Types.TimeEstimate where++import Data.Aeson+import Data.Aeson.Types+import Data.Text (Text)+import GHC.Generics (Generic)+import Uber.Auth+import WebApi++data TimeEstimateParams = TimeEstimateParams+ { start_latitude :: Double+ , start_longitude :: Double+ , product_id :: Maybe Text+ } deriving (Show, Generic)++newtype TimeEstimates = TimeEstimates { times :: [TimeEstimate] }+ deriving (Show, Generic)++data TimeEstimate = TimeEstimate+ { t_product_id :: Text+ , t_display_name :: Text+ , t_estimate :: Int+ } deriving (Show, Generic)++instance ToParam TimeEstimateParams 'QueryParam+instance FromJSON TimeEstimates where+instance FromJSON TimeEstimate where+ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 2 }+
+ src/Uber/Types/UserInfo.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Uber.Types.UserInfo where++import Data.Aeson+import Data.Aeson.Types+import Data.Text (Text)+import GHC.Generics (Generic)+import Uber.Auth+import WebApi++data UserInfo = UserInfo+ { first_name :: Text+ , last_name :: Text+ , email :: Text+ , mobile_verified :: Bool+ , promo_code :: Text+ , uuid :: Text+ } deriving (Generic, Show)++instance FromJSON UserInfo
+ test/Spec.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+import Data.Text as T+import Uber+import Uber.Types.History +import Uber.Types.Misc+import Uber.Types.PriceEstimate+import Uber.Types.Product+import Uber.Types.Reminder +import Uber.Types.RideRequest as RR+import Uber.Types.TimeEstimate+import Uber.Types.UserInfo+import System.Environment (getEnv)+import Test.Hspec++main :: IO ()+main = do+ oauthTkn <- getEnv "UBER_OAUTH_TOKEN"+ serverTkn <- getEnv "UBER_SERVER_TOKEN"+ manager <- newManager tlsManagerSettings+ hspec $ do+ let fakeSettings = (sandboxSettings manager) { auth = OAuth (OAuthToken "FakeToken") }+ settingsWithOAuth = (sandboxSettings manager) { auth = OAuth (OAuthToken $ T.pack oauthTkn) }+ settingsWithServerToken = (sandboxSettings manager) { auth = Server (ServerToken $ T.pack serverTkn) }+ describe "getProducts: Authentication with FakeToken" $ do+ it "should fail" $ do+ resp <- getProducts fakeSettings (LatLng 13.0827 80.2707)+ resp `shouldSatisfy` (not . isSuccess)+ describe "getProducts: Authentication with OAuthToken" $ do+ shouldPass $ getProducts settingsWithOAuth (LatLng 13.0827 80.2707)+ describe "getProducts: Authentication with ServerToken" $ do+ shouldPass $ getProducts settingsWithServerToken (LatLng 13.0827 80.2707)+ describe "getProductDetails:" $ do+ shouldPass $ getProductDetails settingsWithOAuth (ProductId "c58b6622-0be7-4de1-ad60-a9c4d6f4eaa5")+ describe "getPriceEstimate:" $ do+ shouldPass $ getPriceEstimate settingsWithOAuth (PriceEstimateParams 12.9760 80.2212 13.0012 80.2565)+ describe "getTimeEstimate:" $ do+ shouldPass $ getTimeEstimate settingsWithOAuth (TimeEstimateParams 12.9760 80.2212 Nothing)+ describe "getHistory:" $ do+ shouldPass $ getHistory settingsWithOAuth (HistoryParams Nothing Nothing)+ describe "getUserInfo:" $ do+ shouldPass $ getUserInfo settingsWithOAuth+ describe "getCurrentRequest:" $ do+ shouldPass $ getCurrentRequest settingsWithOAuth+ describe "updateCurrentRequest:" $ do+ shouldPass $ updateCurrentRequest settingsWithOAuth $ RidePatchParams (Just 13.0012) (Just 80.2565) Nothing Nothing Nothing+ describe "cancelCurrentRequest:" $ do+ shouldPass $ cancelCurrentRequest settingsWithOAuth+ describe "getRideEstimate:" $ do+ shouldPass $ getRideEstimate settingsWithOAuth (defRideReqParams+ { RR.start_latitude = Just 12.9760 + , RR.start_longitude = Just 80.2212+ })+ describe "requestARide:" $ do+ it "should pass" $ do+ resp <- requestARide settingsWithOAuth (defRideReqParams+ { RR.start_latitude = Just 12.9760 + , RR.start_longitude = Just 80.2212+ })+ case resp of+ Success _ r _ _ -> do+ let rid = RR.request_id r+ res1 <- getRideStatus settingsWithOAuth rid+ res2 <- updateRide settingsWithOAuth rid $ RidePatchParams (Just 13.0012) (Just 80.2565) Nothing Nothing Nothing+ res3 <- cancelRide settingsWithOAuth rid+ case (res1, res2, res3) of+ (Success {}, Success {}, Success {}) -> return ()+ _ -> fail "Reminder request failed!"+ Failure {} -> fail "`requestARide` Failed"+ describe "getPaymentMethods:" $ do+ shouldPass $ getPaymentMethods settingsWithOAuth+ describe "reminder:" $ do+ it "should pass" $ do+ resp <- createReminder settingsWithServerToken $ ReminderParams 1461984150 "+919876543210" (Event 1462984150 Nothing Nothing Nothing Nothing Nothing) (Just $ TripBranding Nothing Nothing)+ case resp of+ Success _ r _ _ -> do+ let rid = r_reminder_id r+ res1 <- getReminderInfo settingsWithServerToken rid+ res2 <- updateReminder settingsWithServerToken rid $ ReminderPatchParams (Just 1461984150) (Just "+911234567890") (Just $ Event 1462984150 Nothing Nothing Nothing Nothing Nothing)+ res3 <- deleteReminder settingsWithServerToken rid+ case (res1, res2, res3) of+ (Success {}, Success {}, Success {}) -> return ()+ _ -> fail "Reminder request failed!"+ Failure {} -> fail "`createReminder` Failed"++shouldPass :: (Show (ApiOut m r), Show (ApiErr m r)) => IO (Response m r) -> SpecWith ()+shouldPass x = do+ it "should pass" $ do+ resp <- x+ resp `shouldSatisfy` isSuccess++instance Show OtherError where+ show (OtherError e) = show e++instance (Show (ApiOut m r), Show (ApiErr m r)) => Show (Response m r) where+ show (Success _ x _ _) = show x+ show (Failure (Left x)) = show x+ show (Failure (Right x)) = show x++instance Show (ApiErr m r) => Show (ApiError m r) where+ show (ApiError _ x _ _) = show x++isSuccess :: Response m r -> Bool+isSuccess r = case r of+ Success {} -> True+ Failure {} -> False
+ uber.cabal view
@@ -0,0 +1,50 @@+name: uber+version: 0.1.0.0+synopsis: Uber client for Haskell +description: Bindings for Uber API+homepage: https://github.com/byteally/webapi-uber.git+license: BSD3+license-file: LICENSE+author: Tarun+maintainer: Tarun <tj.joshi7@gmail.com>+--copyright: 2016 Author name here+category: Web, Network+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Uber+ , Uber.Auth+ , Uber.Client+ , Uber.Contract+ , Uber.Settings+ , Uber.Types.Product+ , Uber.Types.PriceEstimate+ , Uber.Types.TimeEstimate+ , Uber.Types.History+ , Uber.Types.UserInfo+ , Uber.Types.RideRequest+ , Uber.Types.Misc+ , Uber.Types.Reminder+ build-depends: base >= 4.7 && < 5+ , aeson+ , text+ , webapi == 0.2.*+ default-language: Haskell2010++test-suite uber-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , hspec+ , text+ , uber+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/byteally/webapi-uber.git