diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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`). + + + +# 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 diff --git a/example-app/example.hs b/example-app/example.hs --- a/example-app/example.hs +++ b/example-app/example.hs @@ -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." diff --git a/fbmessenger-api.cabal b/fbmessenger-api.cabal --- a/fbmessenger-api.cabal +++ b/fbmessenger-api.cabal @@ -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 diff --git a/src/Servant/Client/MultipartFormData.hs b/src/Servant/Client/MultipartFormData.hs --- a/src/Servant/Client/MultipartFormData.hs +++ b/src/Servant/Client/MultipartFormData.hs @@ -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) diff --git a/src/Web/FBMessenger/API/Bot.hs b/src/Web/FBMessenger/API/Bot.hs --- a/src/Web/FBMessenger/API/Bot.hs +++ b/src/Web/FBMessenger/API/Bot.hs @@ -1,4 +1,18 @@ --- | This module provides the Messenger Platform Bot API +-- | +-- Module : Web.FBMessenger.API.Bot +-- License : BSD3 +-- Maintainer : Marcello Seri +-- 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 diff --git a/src/Web/FBMessenger/API/Bot/Requests.hs b/src/Web/FBMessenger/API/Bot/Requests.hs --- a/src/Web/FBMessenger/API/Bot/Requests.hs +++ b/src/Web/FBMessenger/API/Bot/Requests.hs @@ -1,3 +1,14 @@ +-- | +-- Module : Web.FBMessenger.API.Bot.Requests +-- License : BSD3 +-- Maintainer : Marcello Seri +-- Stability : experimental +-- Portability : unknown +-- +-- This module contains types and helpers to build requests to the +-- +-- 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 diff --git a/src/Web/FBMessenger/API/Bot/Responses.hs b/src/Web/FBMessenger/API/Bot/Responses.hs --- a/src/Web/FBMessenger/API/Bot/Responses.hs +++ b/src/Web/FBMessenger/API/Bot/Responses.hs @@ -1,12 +1,21 @@ +-- | +-- Module : Web.FBMessenger.API.Bot.Requests +-- License : BSD3 +-- Maintainer : Marcello Seri +-- Stability : experimental +-- Portability : unknown +-- +-- This module contains types and helpers to parse the responses from the +-- . +-- 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 diff --git a/src/Web/FBMessenger/API/Bot/SendAPI.hs b/src/Web/FBMessenger/API/Bot/SendAPI.hs --- a/src/Web/FBMessenger/API/Bot/SendAPI.hs +++ b/src/Web/FBMessenger/API/Bot/SendAPI.hs @@ -1,3 +1,14 @@ +-- | +-- Module : Web.FBMessenger.API.Bot.Requests +-- License : BSD3 +-- Maintainer : Marcello Seri +-- Stability : experimental +-- Portability : unknown +-- +-- This module contains a 'servant' client for the +-- +-- 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 diff --git a/src/Web/FBMessenger/API/Bot/WebhookAPI.hs b/src/Web/FBMessenger/API/Bot/WebhookAPI.hs --- a/src/Web/FBMessenger/API/Bot/WebhookAPI.hs +++ b/src/Web/FBMessenger/API/Bot/WebhookAPI.hs @@ -1,3 +1,15 @@ +-- | +-- Module : Web.FBMessenger.API.Bot.Requests +-- License : BSD3 +-- Maintainer : Marcello Seri +-- Stability : experimental +-- Portability : unknown +-- +-- This module contains types and helpers to parse the webhook requests coming +-- from the . +-- You can find a complete example with the source code of this library on +-- . +-- {-# 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