module Web.MangoPay.Events where
import Web.MangoPay.Monad
import Web.MangoPay.Types
import Data.Text hiding (filter,map,toLower)
import Data.Typeable (Typeable)
import Data.Aeson
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Default
import Control.Applicative
import qualified Network.HTTP.Types as HT
import Data.Maybe (isJust)
import qualified Data.HashMap.Lazy as HM (delete)
import qualified Data.Text.Encoding as TE
import Control.Monad (join)
import qualified Data.ByteString.Char8 as BS
import Data.Char (toLower)
searchEvents :: (MPUsableMonad m) => EventSearchParams -> AccessToken -> MangoPayT m (PagedList Event)
searchEvents esp at=do
url<-getClientURL "/events"
req<-getGetRequest url (Just at) esp
getJSONList req
searchAllEvents :: (MPUsableMonad m) => EventSearchParams -> AccessToken -> MangoPayT m [Event]
searchAllEvents esp at=getAll (\p -> searchEvents esp{espPagination=p}) at
checkEvent :: (MPUsableMonad m) => Event -> AccessToken -> MangoPayT m Bool
checkEvent evt at= do
let dt = Just $ eDate evt
let esp = EventSearchParams (Just $ eEventType evt) dt dt Nothing Nothing
evts <- searchAllEvents esp at
return $ evt `elem` evts
createHook :: (MPUsableMonad m) => Hook -> AccessToken -> MangoPayT m Hook
createHook = createGeneric "/hooks"
modifyHook :: (MPUsableMonad m) => Hook -> AccessToken -> MangoPayT m Hook
modifyHook h = modifyGGeneric (Just $ HM.delete "EventType") "/hooks/" h hId
fetchHook :: (MPUsableMonad m) => HookId -> AccessToken -> MangoPayT m Hook
fetchHook = fetchGeneric "/hooks/"
listHooks :: (MPUsableMonad m) => Maybe Pagination -> AccessToken -> MangoPayT m (PagedList Hook)
listHooks = genericList ["/hooks"]
data EventType=
PAYIN_NORMAL_CREATED
| PAYIN_NORMAL_SUCCEEDED
| PAYIN_NORMAL_FAILED
| PAYOUT_NORMAL_CREATED
| PAYOUT_NORMAL_SUCCEEDED
| PAYOUT_NORMAL_FAILED
| TRANSFER_NORMAL_CREATED
| TRANSFER_NORMAL_SUCCEEDED
| TRANSFER_NORMAL_FAILED
| PAYIN_REFUND_CREATED
| PAYIN_REFUND_SUCCEEDED
| PAYIN_REFUND_FAILED
| PAYOUT_REFUND_CREATED
| PAYOUT_REFUND_SUCCEEDED
| PAYOUT_REFUND_FAILED
| TRANSFER_REFUND_CREATED
| TRANSFER_REFUND_SUCCEEDED
| TRANSFER_REFUND_FAILED
| KYC_CREATED
| KYC_VALIDATION_ASKED
| KYC_SUCCEEDED
| KYC_FAILED
deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable)
instance ToHtQuery (Maybe EventType) where
n ?+ d=n ?+ fmap show d
instance ToJSON EventType where
toJSON =toJSON . show
instance FromJSON EventType where
parseJSON = jsonRead "EventType"
data EventSearchParams=EventSearchParams{
espEventType :: Maybe EventType
,espBeforeDate :: Maybe POSIXTime
,espAfterDate :: Maybe POSIXTime
,espPagination :: Maybe Pagination
,espSortByDate :: Maybe SortDirection
}
deriving (Show,Eq,Ord,Typeable)
instance Default EventSearchParams where
def=EventSearchParams Nothing Nothing Nothing Nothing Nothing
instance HT.QueryLike EventSearchParams where
toQuery (EventSearchParams et bd ad p ms)=filter (isJust .snd)
["eventtype" ?+ et
,"beforeDate" ?+ bd
,"afterDate" ?+ ad
,"Sort" ?+ ((("Date:" ++) . map toLower . show) <$> ms)
] ++ paginationAttributes p
data Event=Event {
eResourceId :: Text
,eEventType :: EventType
,eDate :: POSIXTime
}
deriving (Show,Eq,Ord,Typeable)
instance ToJSON Event where
toJSON e=objectSN ["ResourceId" .= eResourceId e,"EventType" .= eEventType e,"Date" .= eDate e]
instance FromJSON Event where
parseJSON (Object v) =Event <$>
v .: "ResourceId" <*>
v .: "EventType" <*>
v .: "Date"
parseJSON _=fail "Event"
eventFromQueryString :: HT.Query -> Maybe Event
eventFromQueryString q=do
rid<-fmap TE.decodeUtf8 $ join $ findAssoc q "RessourceId"
et<-join $ fmap (maybeRead . BS.unpack) $ join $ findAssoc q "EventType"
d<-fmap fromIntegral $ join $ fmap ((maybeRead :: String -> Maybe Integer). BS.unpack) $ join $ findAssoc q "Date"
return $ Event rid et d
eventFromQueryStringT :: [(Text, Text)] -> Maybe Event
eventFromQueryStringT q=do
rid<- findAssoc q "RessourceId"
et<-join $ fmap (maybeRead . unpack) $ findAssoc q "EventType"
d<-fmap fromIntegral $ join $ fmap ((maybeRead :: String -> Maybe Integer). unpack) $ findAssoc q "Date"
return $ Event rid et d
data HookStatus=Enabled | Disabled
deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable)
instance ToJSON HookStatus where
toJSON Enabled="ENABLED"
toJSON Disabled="DISABLED"
instance FromJSON HookStatus where
parseJSON (String "ENABLED") =pure Enabled
parseJSON (String "DISABLED") =pure Disabled
parseJSON _= fail "HookStatus"
data HookValidity=Valid | Invalid
deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable)
instance ToJSON HookValidity where
toJSON Valid="VALID"
toJSON Invalid="INVALID"
instance FromJSON HookValidity where
parseJSON (String "VALID") =pure Valid
parseJSON (String "INVALID") =pure Invalid
parseJSON _= fail "HookValidity"
type HookId=Text
data Hook=Hook {
hId :: Maybe HookId
,hCreationDate :: Maybe POSIXTime
,hTag :: Maybe Text
,hUrl :: Text
,hStatus :: HookStatus
,hValidity :: Maybe HookValidity
,hEventType :: EventType
}
deriving (Show,Eq,Ord,Typeable)
instance ToJSON Hook where
toJSON h=objectSN ["Tag" .= hTag h,"EventType" .= hEventType h,"Url" .= hUrl h,"Status" .= hStatus h]
instance FromJSON Hook where
parseJSON (Object v) =Hook <$>
v .: "Id" <*>
v .: "CreationDate" <*>
v .: "Tag" <*>
v .: "Url" <*>
v .: "Status" <*>
v .: "Validity" <*>
v .: "EventType"
parseJSON _=fail "Hook"