module Line.Messaging.Webhook (
module Line.Messaging.Webhook.Types,
webhook,
webhookApp,
defaultOnFailure,
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
webhook :: (Monad m)
=> ChannelSecret
-> BL.ByteString
-> Signature
-> 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
webhookApp :: ChannelSecret
-> ([Event] -> IO ())
-> (WebhookFailure -> Application)
-> 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
defaultOnFailure :: WebhookFailure -> Application
defaultOnFailure failure _ f = f .
responseBuilder status400 [] . string8 . show $ failure
webhookAction :: ChannelSecret
-> ([Event] -> IO ())
-> (WebhookFailure -> Scotty.ActionM ())
-> 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
defaultOnFailure' :: WebhookFailure -> Scotty.ActionM ()
defaultOnFailure' err = do
Scotty.status status400
Scotty.text . TL.pack . show $ err