packages feed

fbmessenger-api 0.1.1.0 → 0.1.1.1

raw patch · 9 files changed

+190/−44 lines, 9 files

Files

+ README.md view
@@ -0,0 +1,78 @@+# FBMessenger API++[![Build Status](https://travis-ci.org/mseri/fbmessenger-api-hs.svg?branch=master)](https://travis-ci.org/mseri/fbmessenger-api-hs)+![Hackage](https://img.shields.io/hackage/v/fbmessenger-api.svg)+![Hackage Dependencies](https://img.shields.io/hackage-deps/v/fbmessenger-api.svg)+![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)+![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)++High-level bindings to the [Messenger Platform API](https://developers.facebook.com/docs/messenger-platform/) based on [servant](https://haskell-servant.github.io/) library.+We try to maintain the overall structure compatible with [telegram-api](https://github.com/klappvisor/haskell-telegram-api).++There was an incongruence between the spec and the actual serialization of the webhook requests that became apparent when testing an actual messenger bot. For this reason you should **use only versions of the library that are `>= 0.1.1`**!++This library is alpha software and the API design could change to improve composability, ergonomicity and ease of use. We recommend using `stack` for dealing with this library (you will need to add it to the `extra-deps` in `stack.yaml`).++<!-- Useful links: +- [servant tutorial](http://haskell-servant.readthedocs.io/en/stable/tutorial)+- [simple python bindings for the messenger api](https://github.com/geeknam/messengerbot)+- [bytemyapp](http://bitemyapp.com/archive.html)+- [aeson tutorial](https://artyom.me/aeson)+- [haskell is easy](https://haskelliseasy.readthedocs.io/en/latest/)+/ -->++# Usage++Before being able to test and use the bot, you will need to verify your key. +The example app in `example-app/example.hs` contains a servant server that implements the verification and a trivial echo-server.+You can run it with++```{.bash}+VERIFY_TOKEN="your_token_goes_here" stack exec example  +```++and pass it some data (here assuming you have `httpie` installed)++```{.bash}+http get 'localhost:3000/webhook/?hub.verify_token=your_token_goes_here&hub.challenge=test'+http post :3000/webhook < test-files/wsTextMessageRequest.json+```++Otherwise run `stack ghci` then copy and paste the following++```{.haskell}+:m +Network.HTTP.Client+:m +Network.HTTP.Client.TLS+:m +Data.Text++let token = Token $ Data.Text.pack "your_token_goes_here"+let manager = newManager tlsManagerSettings+manager >>= \m -> subscribedApps $ Just token m+```++You should get a positive response or (in case of inactive token): ++```{.haskell}+Left (FailureResponse {responseStatus = Status {statusCode = 400, statusMessage = "Bad Request"}, responseContentType = application/json, responseBody = "{\"error\":{\"message\":\"Invalid OAuth access token.\",\"type\":\"OAuthException\",\"code\":190,\"fbtrace_id\":\"ESxHmUos2B+\"}}"})+```++# Contribution++1. Fork repository+2. Do some changes+3. Create pull request+4. Wait for CI build and review++You can use stack to build the project++    stack build++To run tests++    stack test++# TODO++- Tests for the network part of the api (hard, requires a bot setted up and permanently running just for the tests)+- Check if assumption on https://github.com/mseri/fbmessenger-api-hs/blob/master/src/Web/FBMessenger/API/Bot/WebhookAPI.hs#L99 is safe+- Cleanup Webhooks API Requests and add higher level helpers
example-app/example.hs view
@@ -61,7 +61,7 @@     token = Token $ T.pack pageTokenStored      echoMessage :: EventMessage -> ExceptT ServantErr IO T.Text-    echoMessage msg = do+    echoMessage msg =       case evtContent msg of         EmTextMessage _ _ text -> liftIO $ echoTextMessage text (evtSenderId msg)          _                      -> return "[WARN]: this is just an example, no complex message is echoed."
fbmessenger-api.cabal view
@@ -1,8 +1,8 @@ name:                fbmessenger-api-version:             0.1.1.0+version:             0.1.1.1 synopsis:            High-level bindings to Facebook Messenger Platform API description:         Please see README.md-homepage:            https://github.com/mseri/fbmessenger-api-hs#readme+homepage:            https://github.com/mseri/fbmessenger-api-hs#fbmessenger-api license:             BSD3 license-file:        LICENSE author:              Marcello Seri@@ -11,7 +11,7 @@ category:            Web build-type:          Simple stability:           Experimental--- extra-source-files:+extra-source-files:  README.md cabal-version:       >=1.10 data-files:          test-files/*.json
src/Servant/Client/MultipartFormData.hs view
@@ -99,7 +99,7 @@   let acceptCT = contentType ct   (_status, respBody, respCT, hdrs, _response) <-     performRequest' reqToRequest' reqMethod (req { reqAccept = [acceptCT] }) manager reqHost-  unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody+  unless (matches respCT acceptCT) $ throwE $ UnsupportedContentType respCT respBody   case mimeUnrender ct respBody of     Left err -> throwE $ DecodeFailure err respCT respBody     Right val -> return (hdrs, val)
src/Web/FBMessenger/API/Bot.hs view
@@ -1,4 +1,18 @@--- | This module provides the Messenger Platform Bot API+-- |+-- Module      : Web.FBMessenger.API.Bot+-- License     : BSD3+-- Maintainer  : Marcello Seri <marcello.seri@gmail.com>+-- Stability   : experimental+-- Portability : unknown+--+-- This module provides the Messenger Platform Bot API.+-- It re-exports the following modules:+--+--   - 'Web.FBMessenger.API.Bot.Requests'+--   - 'Web.FBMessenger.API.Bot.Responses'+--   - 'Web.FBMessenger.API.Bot.WebhookAPI'+--   - 'Web.FBMessenger.API.Bot.SendAPI'+-- module Web.FBMessenger.API.Bot ( module X ) where  import Web.FBMessenger.API.Bot.SendAPI as X
src/Web/FBMessenger/API/Bot/Requests.hs view
@@ -1,3 +1,14 @@+-- |+-- Module      : Web.FBMessenger.API.Bot.Requests +-- License     : BSD3+-- Maintainer  : Marcello Seri <marcello.seri@gmail.com>+-- Stability   : experimental+-- Portability : unknown+--+-- This module contains types and helpers to build requests to the+-- <https://developers.facebook.com/docs/messenger-platform/ Messenger Platform API> +-- to use with 'Web.FBMessenger.API.Bot.SendAPI'.+-- {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE FlexibleInstances          #-}@@ -7,7 +18,6 @@  {-# OPTIONS_GHC -fno-warn-unused-binds  #-} --- | This module contains data objects which represents requests to Messenger Platform Bot API module Web.FBMessenger.API.Bot.Requests      ( -- * Types       Button                       (..)@@ -72,7 +82,7 @@ instance FromJSON Recipient where     parseJSON = parseJsonDrop 10 --- | Take reciptient id (optional) or phone_number (optional) and return a Maybe Recipient object.+-- | Take reciptient id (optional) or phone_number (optional) and return a 'Maybe Recipient' object. --   Return Nothing when values are either both (Just _) or both Nothing.   recipient :: Maybe Text -> Maybe Text -> Maybe Recipient recipient Nothing Nothing   = Nothing@@ -82,7 +92,7 @@  -- | Push notification type for the message data NotificationType = Regular        -- ^ will emit a sound/vibration and a phone notification (default)-                      | SilentPush     -- ^ will just emit a phone notification+                      | SilentPush     -- ^ will emit a phone notification                       | NoPush         -- ^ will not emit either                       deriving (Eq, Show) @@ -116,7 +126,7 @@       SendTextMessageRequest <$> o .: "recipient" <*> t <*> o .:? "notification_type"      -- | Take a notification type (optional), a recipient and a text. ---   Return a SendTextMessageRequest. +--   Return a 'SendTextMessageRequest'.  --   Raise an error if the text is longer than 320 characters. sendTextMessageRequest :: Maybe NotificationType -> Recipient -> Text -> SendTextMessageRequest sendTextMessageRequest notificationType recipient text @@ -244,7 +254,7 @@         _  -> fail "impossible to parse the attachment wrapper type"   --- | Type for Button objects. See Button type for additional informations.+-- | Type for 'Button' objects. See 'Button' type for additional informations. data ButtonType = WebUrl | Postback deriving (Eq, Show)  instance ToJSON ButtonType where@@ -256,7 +266,7 @@   parseJSON "postback" = pure Postback   parseJSON _          = fail "Failed to parse ButtonType" --- | Button object for structured messages payloads+-- | 'Button' object for structured messages payloads data Button = Button    { btn_type    :: ButtonType   -- ^ Value is "web_url" or "postback"   , btn_title   :: Text         -- ^ Button title@@ -347,7 +357,7 @@   parseJSON = parseJsonDrop 3    paymentSummary :: Double -> PaymentSummary-paymentSummary totalCost = PaymentSummary Nothing Nothing Nothing totalCost +paymentSummary totalCost = PaymentSummary Nothing Nothing Nothing totalCost  data PaymentAdjustment = PaymentAdjustment   { pa_name   :: Maybe Text     -- ^ Name of adjustment@@ -377,31 +387,32 @@       SendStructuredMessageRequest <$> o .: "recipient" <*> aw <*> o .:? "notification_type"   -- | Take a notification type (optional), a recipient, an image url.---   Return a SendStructuredMessageRequest for a structured message with image attachment+--   Return a 'SendStructuredMessageRequest' for a structured message with image attachment sendImageMessageRequest :: Maybe NotificationType -> Recipient -> Text -> SendStructuredMessageRequest sendImageMessageRequest notificationType recipient imgUrl =    SendStructuredMessageRequest recipient attachment notificationType   where attachment = ItImage $ ImagePayload imgUrl --- | Take a notification type (optional), a recipient, a list of ButtonElement.---   Return a SendStructuredMessageRequest for a structured message with generic template+-- | Take a notification type (optional), a recipient, a list of 'ButtonElement'.+--   Return a 'SendStructuredMessageRequest' for a structured message with generic template sendGenericTemplateMessageRequest :: Maybe NotificationType -> Recipient -> [BubbleElement]  -> SendStructuredMessageRequest sendGenericTemplateMessageRequest notificationType recipient bubbles =    SendStructuredMessageRequest recipient attachment notificationType   where attachment = ItGeneric $ GenericTemplate bubbles  --- | Take a notification type (optional), a recipient, the text of the message and a list of buttons (they will appear as call-to-actions).---   Return a SendStructuredMessageRequest for a structured message with button template+-- | Take a notification type (optional), a recipient, the text of the message and a list of +--   buttons (they will appear as call-to-actions).+--   Return a 'SendStructuredMessageRequest' for a structured message with button template sendButtonTemplateMessageRequest :: Maybe NotificationType -> Recipient -> Text -> [Button]  -> SendStructuredMessageRequest sendButtonTemplateMessageRequest notificationType recipient text buttons =    SendStructuredMessageRequest recipient attachment notificationType   where attachment = ItButton $ ButtonTemplate text buttons --- | Take a notification type (optional), a recipient and all the informations needed to construct a ReceiptTemplate object.+-- | Take a notification type (optional), a recipient and all the informations needed to construct a 'ReceiptTemplate' object. --   Namely: the recipient name, the order number (must be unique), the currency, the payment method, the timestamp (optional),  --   the order url (optional), a list with the receipt items, the shipping address (optional), the payment summary and,  --   finally, a list of payment adjustments (optional).---   Return a SendStructuredMessageRequest for a structured message with receipt template+--   Return a 'SendStructuredMessageRequest' for a structured message with receipt template sendReceiptTemplateMessageRequest :: Maybe NotificationType -> Recipient -> Text -> Text -> Text -> Text -> Maybe Text                                            -> Maybe Text -> [ReceiptItem] -> Maybe ShippingAddress -> PaymentSummary -> Maybe [PaymentAdjustment]                                            -> SendStructuredMessageRequest@@ -433,19 +444,19 @@ setWelcomeTextMessageRequest = WelcomeTextMessage   -- | Take an image url.---   Return a WelcomeMessageRequest for a structured message with image attachment+--   Return a 'WelcomeMessageRequest' for a structured message with image attachment setWelcomeImageMessageRequest :: Text -> WelcomeMessageRequest setWelcomeImageMessageRequest imgUrl = WelcomeStructuredMessage attachment   where attachment = ItImage $ ImagePayload imgUrl   -- | Take a list of ButtonElement.---   Return a WelcomeMessageRequest for a structured message with generic template+--   Return a 'WelcomeMessageRequest' for a structured message with generic template setWelcomeGenericTemplateMessageRequest :: [BubbleElement]  -> WelcomeMessageRequest setWelcomeGenericTemplateMessageRequest bubbles = WelcomeStructuredMessage attachment   where attachment = ItGeneric $ GenericTemplate bubbles   -- | Take the text of the message and a list of buttons (they will appear as call-to-actions).---   Return a WelcomeMessageRequest for a structured message with button template+--   Return a 'WelcomeMessageRequest' for a structured message with button template setWelcomeButtonTemplateMessageRequest :: Text -> [Button]  -> WelcomeMessageRequest setWelcomeButtonTemplateMessageRequest text buttons = WelcomeStructuredMessage attachment   where attachment = ItButton $ ButtonTemplate text buttons@@ -466,7 +477,7 @@   , fileUpload_content :: FileUploadContent -- ^ The payload/source to upload.   } --- | Return a FileUpload from a given FilePath. +-- | Return a 'FileUpload' from a given 'FilePath'.  --   At the moment, only png and jpg images are supported by the API. localFileUpload :: FilePath -> FileUpload localFileUpload path = FileUpload@@ -505,7 +516,7 @@ -- sendImageMessageRequest :: Recipient -> Text -> UploadImageMessageRequest Text -- sendImageMessageRequest reciptient image = UploadImageMessageRequest recipient image emptyImageMessageAttachment --- | Take a recipient and FileUpload (relative to a jpg or png). Return a (UploadImageMessageRequest FileUpload) +-- | Take a 'Recipient' and 'FileUpload' (relative to a jpg or png). Return a ('UploadImageMessageRequest FileUpload')  --   for a structured message contatining and image uploaded using multipart form data.  uploadImageMessageRequest :: Recipient -> FileUpload -> UploadImageMessageRequest FileUpload uploadImageMessageRequest = UploadImageMessageRequest
src/Web/FBMessenger/API/Bot/Responses.hs view
@@ -1,12 +1,21 @@+-- |+-- Module      : Web.FBMessenger.API.Bot.Requests +-- License     : BSD3+-- Maintainer  : Marcello Seri <marcello.seri@gmail.com>+-- Stability   : experimental+-- Portability : unknown+--+-- This module contains types and helpers to parse the responses from the+-- <https://developers.facebook.com/docs/messenger-platform/ Messenger Platform API>. +-- See also 'Web.FBMessenger.API.Bot.SendAPI'.+-- {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE RecordWildCards            #-} {-# LANGUAGE TypeOperators              #-}- {-# OPTIONS_GHC -fno-warn-unused-binds  #-} --- | This module contains responses from Messenger Platform Bot API module Web.FBMessenger.API.Bot.Responses    ( -- * Types      MessageResponse        (..)@@ -130,17 +139,16 @@   parseJSON _            = fail "Unable to parse SendErrorCode"   --- | Take a Send API error object and return a tuple containing the error code and the error_data (seems to always be the description)+-- | Take a Send API error object and return a tuple containing the error code +--   and the error_data (seems to always be the description) errorInfo :: SendErrorObject -> (SendErrorCode, Text) errorInfo err = (ecode, edata)    where edata = eoErrorData err         ecode = eoCode err --- | Extracts a Send API Error object from the ServantError (when possible).+-- | Extracts a Send API Error object from the 'ServantError' (when possible). extractSendError :: ServantError -> Maybe SendErrorObject extractSendError FailureResponse{ responseStatus = _, responseContentType = _                                 , responseBody = body -                                } = do-                                  eo <- decode body :: Maybe SendErrorObject-                                  return eo+                                } = decode body :: Maybe SendErrorObject extractSendError _ = Nothing
src/Web/FBMessenger/API/Bot/SendAPI.hs view
@@ -1,3 +1,14 @@+-- |+-- Module      : Web.FBMessenger.API.Bot.Requests +-- License     : BSD3+-- Maintainer  : Marcello Seri <marcello.seri@gmail.com>+-- Stability   : experimental+-- Portability : unknown+--+-- This module contains a 'servant' client for the +-- <https://developers.facebook.com/docs/messenger-platform/ Messenger Platform API>+-- and helpers useful to construct the appropriate requests and parse the responses.+-- {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-}@@ -37,7 +48,7 @@    deriving (Show, Eq, Ord, ToHttpApiData, FromHttpApiData)  -- | Type for token--- NOTE: QueryParam here gives us a Maybe Token+-- NOTE: 'QueryParam' here gives us a 'Maybe Token' type GraphAPIAccessToken = QueryParam "access_token" Token  @@ -95,32 +106,41 @@ sendTextMessage :: Maybe Token -> SendTextMessageRequest -> Manager -> IO (Either ServantError MessageResponse) sendTextMessage = run graphAPIBaseUrl sendTextMessage_ --- | Upload an image and send a structured messages containing it. On success, minor informations on the sent message are returned.+-- | Upload an image and send a structured messages containing it. +--   On success, minor informations on the sent message are returned. uploadImageMessage :: Maybe Token -> UploadImageMessageRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) uploadImageMessage = run graphAPIBaseUrl uploadImageMessage_ --- | Send a structured messages. This can be an image message (containing an image url) or any template message (generic, button, receipt).  +-- | Send a structured messages. This can be an image message (containing an image url) +--   or any template message (generic, button, receipt).   --   On success, minor informations on the sent message are returned. sendStructuredMessage :: Maybe Token -> SendStructuredMessageRequest -> Manager -> IO (Either ServantError MessageResponse) sendStructuredMessage = run graphAPIBaseUrl sendStructuredMessage_  -- | Test if your bot's auth token is enabled. Requires no parameters.---   Return a simple object containing a boolean value indicating if the token is correctly registered.+--   Return a simple object containing a boolean value indicating if the +--   token is correctly registered. subscribedApps :: Maybe Token -> Manager -> IO (Either ServantError SubscriptionResponse) subscribedApps token manager = runExceptT $ subscribedApps_ token manager graphAPIBaseUrl --- | Set a welcome message, this can be an image message (containing an image url) or any template message (generic, button, receipt).---   In addition to the token and the message request, you need to provide the facebook page_id.---   Return a simple object containing a string indicating if the welcome message is correctly registered.+-- | Set a welcome message, this can be an image message (containing an image url) +--   or any template message (generic, button, receipt).+--   In addition to the token and the message request, you need to provide the +--   facebook page_id.+--   Return a simple object containing a string indicating if the welcome message +--   is correctly registered. setWelcomeMessage :: Maybe Token -> Text -> WelcomeMessageRequest -> Manager -> IO (Either ServantError WelcomeMessageResponse) setWelcomeMessage token pageId message manager = runExceptT $ welcomeMessage_ token pageId message manager graphAPIBaseUrl --- | Remove the welcome message. In addition to the token, you need to provide the facebook page_id.---   Return a simple object containing a string indicating if the welcome message is correctly removed.+-- | Remove the welcome message. In addition to the token, you need to provide +--   the facebook page_id.+--   Return a simple object containing a string indicating if the welcome +--   message is correctly removed. removeWelcomeMessage :: Maybe Token -> Text -> Manager -> IO (Either ServantError WelcomeMessageResponse) removeWelcomeMessage token pageId manager = runExceptT $ deleteWMessage_ token pageId welcomeDeleteMessage manager graphAPIBaseUrl --- | Get the profile informations of a user. In addition to the token, you need to provide the user_id.+-- | Get the profile informations of a user. In addition to the token, you need+--   to provide the user_id. --   Return a record containing the profile informations. getUserProfileInfo :: Maybe Token -> Text -> Manager -> IO (Either ServantError UserProfileResponse) getUserProfileInfo token userId manager = runExceptT $ userProfile_ token userProfileFields userId manager graphAPIBaseUrl
src/Web/FBMessenger/API/Bot/WebhookAPI.hs view
@@ -1,3 +1,15 @@+-- |+-- Module      : Web.FBMessenger.API.Bot.Requests +-- License     : BSD3+-- Maintainer  : Marcello Seri <marcello.seri@gmail.com>+-- Stability   : experimental+-- Portability : unknown+--+-- This module contains types and helpers to parse the webhook requests coming+-- from the <https://developers.facebook.com/docs/messenger-platform/ Messenger Platform API>. +-- You can find a complete example with the source code of this library on+-- <https://github.com/mseri/fbmessenger-api-hs/blob/master/example-app/example.hs github>.+--  {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE FlexibleInstances          #-}@@ -28,6 +40,7 @@ --        * try to cleanup and simplify the API and the data representation  --        * consider adding useful getters and a mapper from [RemoteEvents] -> [EventMessage] +-- | This type wraps the content of a webhook request data RemoteEventList = RemoteEventList [RemoteEvent] deriving (Eq, Show) instance ToJSON RemoteEventList where     toJSON (RemoteEventList evts) = object [ "object" .= ("page"::String), "entry" .= evts ]@@ -39,7 +52,8 @@                   evts <- o .: "entry"                   return (RemoteEventList evts) -+-- | A webhook request contains a list of 'RemoteEvents', objects containing +--   an id, a time and a list of messaging events. data RemoteEvent = RemoteEvent     { evt_id        :: Text             -- ^ Page ID of page      , evt_time      :: Int              -- ^ Time of update@@ -51,7 +65,8 @@ instance FromJSON RemoteEvent where     parseJSON = parseJsonDrop 4 -+-- | This is an event message, for additional information refer to the official+--   Messenger Platform API. data EventMessage = EventMessage      { evtSenderId    :: Text            -- ^ Sender user ID     , evtRecipientId :: Text            -- ^ Recipient user ID