{-| This module provides webhook handlers both general and WAI-specific. -} module Line.Messaging.Webhook ( -- * Types -- | Re-exported for convenience. module Line.Messaging.Webhook.Types, -- * Basic webhook webhook, -- * Webhook as a WAI application webhookApp, defaultOnFailure, -- * Webhook as a Scotty action webhookAction, defaultOnFailure', ) where import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT) import Data.Aeson (decode') import Data.ByteString.Builder (string8) import Data.Text.Encoding (encodeUtf8) import Line.Messaging.Webhook.Types import Line.Messaging.Webhook.Validation (validateSignature) import Network.HTTP.Types.Status import Network.Wai import qualified Data.Text.Lazy as TL import qualified Data.ByteString.Lazy as BL import qualified Web.Scotty as Scotty -- | A basic webhook function. It validates a request with a channel secret, -- signature and body, and parses the body into a list of webhook events. -- -- To handle failures, the result is in the form of @'ExceptT' 'WebhookFailure'@. webhook :: (Monad m) => ChannelSecret -> BL.ByteString -- ^ Request body -> Signature -- ^ Auth signature in @X-Line-Signature@ header -> ExceptT WebhookFailure m [Event] webhook secret body sig = do if not $ validateSignature secret body sig then throwE SignatureVerificationFailed else do case decode' body of Nothing -> throwE MessageDecodeFailed Just (Body events) -> return events getSigFromWaiReq :: Request -> Maybe Signature getSigFromWaiReq = lookup "X-Line-Signature" . requestHeaders -- | A webhook handler for WAI. It uses 'webhook' internally and returns a WAI -- 'Application'. -- -- An example webhook server using WAI will be like below: -- -- @ -- app :: Application -- app req f = case pathInfo req of -- "webhook" : _ -> do -- secret <- getChannelSecret -- webhookApp secret handler defaultOnFailure req f -- _ -> undefined -- -- handler :: [Event] -> IO () -- handler events = forM_ events handleEvent -- -- handleEvent :: Event -> IO () -- handleEvent (MessageEvent event) = undefined -- handle a message event -- handleEvent _ = return () -- @ webhookApp :: ChannelSecret -- ^ Channel secret -> ([Event] -> IO ()) -- ^ Event handler -> (WebhookFailure -> Application) -- ^ Error handler. Just to return 400 for failures, use 'defaultOnFailure'. -> Application webhookApp secret handler failHandler req f = do body <- lazyRequestBody req let maybeSig = getSigFromWaiReq req case maybeSig of Nothing -> failHandler SignatureVerificationFailed req f Just sig -> do result <- runExceptT $ webhook secret body sig case result of Right events -> handler events >> (f $ responseBuilder status200 [] "") Left exception -> failHandler exception req f -- | A basic error handler to be used with 'webhookApp'. It returns 400 Bad -- Request with the 'WebhookFailure' code for its body. defaultOnFailure :: WebhookFailure -> Application defaultOnFailure failure _ f = f . responseBuilder status400 [] . string8 . show $ failure -- | A webhook handler for Scotty. It uses 'webhook' internally and returns a -- Scotty action of type 'ActionM' @()@ -- -- An example webhook server using WAI will be like below: -- -- @ -- main :: IO () -- main = scotty 3000 $ do -- post "/webhook" $ webhookAction handler defaultOnFailure' -- -- handler :: [Event] -> IO () -- handler events = forM_ events handleEvent -- -- handleEvent :: Event -> IO () -- handleEvent (MessageEvent event) = undefined -- handle a message event -- handleEvent _ = return () -- @ webhookAction :: ChannelSecret -- ^ Channel secret -> ([Event] -> IO ()) -- ^ Event handler -> (WebhookFailure -> Scotty.ActionM ()) -- ^ Error handler. Just to return 400 for failures, use 'defaultOnFailure''. -> Scotty.ActionM () webhookAction secret handler failHandler = do body <- Scotty.body maybeSig <- Scotty.header "X-Line-Signature" case maybeSig of Nothing -> failHandler SignatureVerificationFailed Just sig -> do result <- runExceptT $ webhook secret body (encodeUtf8 $ TL.toStrict sig) case result of Right events -> (liftIO $ handler events) >> Scotty.text "" Left exception -> failHandler exception -- | A basic error handler to be used with 'webhookAction'. It returns 400 Bad -- Request with the 'WebhookFailure' code for its body. It has the same purpose -- as 'defaultOnFailure', except that it is for Scotty. defaultOnFailure' :: WebhookFailure -> Scotty.ActionM () defaultOnFailure' err = do Scotty.status status400 Scotty.text . TL.pack . show $ err