line 1.0.1.0 → 2.0.0.0
raw patch · 17 files changed
+1553/−76 lines, 17 filesdep +QuickCheckdep +hspecdep +hspec-waidep ~line
Dependencies added: QuickCheck, hspec, hspec-wai, quickcheck-instances, raw-strings-qq, scotty
Dependency ranges changed: line
Files
- CHANGELOG.md +23/−0
- README.md +22/−0
- examples/API.hs +78/−0
- examples/ScottyWebhook.hs +76/−0
- examples/WAIWebhook.hs +73/−0
- line.cabal +29/−4
- src/Line/Messaging/API/Types.hs +32/−22
- src/Line/Messaging/Webhook.hs +77/−25
- src/Line/Messaging/Webhook/Types.hs +6/−7
- src/Line/Messaging/Webhook/Validation.hs +6/−16
- test/Line/Messaging/API/TypesSpec.hs +136/−0
- test/Line/Messaging/API/TypesSpecHelper.hs +284/−0
- test/Line/Messaging/Webhook/TypesSpec.hs +134/−0
- test/Line/Messaging/Webhook/TypesSpecHelper.hs +469/−0
- test/Line/Messaging/Webhook/ValidationSpec.hs +27/−0
- test/Line/Messaging/WebhookSpec.hs +80/−0
- test/Spec.hs +1/−2
+ CHANGELOG.md view
@@ -0,0 +1,23 @@+## 2.0.0.0 (4 Dev 2016)++* Make `Line.Messaging.Webhook.Validation` independent from WAI. As it does not+ use `Request` of WAI, its argument type is changed.+* Remove `WebhookResult`, as returning other than empty string is meaningless+ for webhook response+* Add Scotty version of webhook handler+* Add Stack yaml to fix macOS Sierra problem+* Derive `Eq` type class for `APIErrorBody`+* Make optional fields of template messages have type of `Maybe a`++## 1.0.1.0 (28 Nov 2016)++* Update lower bound of `base` to 4.8 (Issue: #2)+* Add Stack yamls for lts-6.26 resolver++## 1.0.0.1 (27 Nov 2016)++* Documentation fix++## 1.0.0.0 (27 Nov 2016)++* Initial release
+ README.md view
@@ -0,0 +1,22 @@+# line [](https://travis-ci.org/noraesae/line)++Haskell SDK for the [LINE](https://line.me) API++## Features++* Internal [auth signature validator](https://devdocs.line.me/en/#webhook-authentication)+* Webhook handled with handler function, [WAI](https://hackage.haskell.org/package/wai) application,+ or [Scotty](https://hackage.haskell.org/package/scotty) action+* Functions and types for [LINE Messaging API](https://devdocs.line.me/en/#messaging-api)++## Documentation++Please refer to [the API docs available on Hackage](https://hackage.haskell.org/package/line).++## Examples++Please see the [examples](examples) directory.++## LICENSE++[BSD3](LICENSE)
+ examples/API.hs view
@@ -0,0 +1,78 @@+{-|+An example code to show how to use functions and types for LINE Messaging API.+-}++{-# LANGUAGE OverloadedStrings #-}++module API where++import Line.Messaging.API+import Line.Messaging.Webhook+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T++-- | Message event handler.+--+-- For using the handler and create a webhook server, please refer to the+-- webhook example.+handleMessageEvent :: ReplyableEvent EventMessage -> IO ()+handleMessageEvent event = do+ case getMessage event of+ -- For text event message, just echo+ TextEM _ (Text text) -> echo (getReplyToken event) text+ -- For image, video and audio, download contents+ ImageEM identifier -> download identifier ".jpg"+ VideoEM identifier -> download identifier ".mp4"+ AudioEM identifier -> download identifier ".m4a"+ -- For location, push a template message+ LocationEM identifier location -> pushTemplate identifier location+ _ -> return ()++-- | An unlifter for the 'APIIO' type.+--+-- It uses the 'runAPI' function with a channel access token provided.+api :: APIIO a -> IO (Either APIError a)+api = runAPI $ return "some channel access token"++-- | An echoing action+--+-- It just send a reply with a text. By 'api', the result is+-- 'Either APIError ()', but the error is not handled for simplicity.+echo :: ReplyToken -> T.Text -> IO ()+echo replyToken content = do+ api $ reply replyToken [ Message . Text $ content ]+ return ()++-- | Download content+--+-- It downloads a binary content of image, video or audio spcified by+-- its identifier.+download :: ID -> String -> IO ()+download identifier ext = do+ let filename = "recent" ++ ext+ content <- either (const "") id <$> (api $ getContent identifier)+ BL.writeFile filename content++-- | Push a template message.+--+-- In this case, it is better to use 'reply' instead of 'push', as it is+-- cheap. 'push' is used here for example usage.+pushTemplate :: ID -> Location -> IO ()+pushTemplate identifier (Location _ address _ _) = do+ (name, description, homepage, thumbnail) <- getRestaurant address+ api $ push identifier [+ Message . Text $ "Here are some restaurants around the location.",+ Message . Template "Alt text for old clients" $+ Buttons (Just thumbnail) (Just name) description [+ TplPostbackAction "Reservation" "Reserved!" (Just name),+ TplURIAction "Homepage" homepage+ ]+ ]+ return ()++ where+ -- | A fucntion to return a list of restaunts for an address+ --+ -- This function is just to be used as an example, so it is not implemented.+ getRestaurant :: T.Text -> IO (T.Text, T.Text, URL, URL)+ getRestaurant address = undefined
+ examples/ScottyWebhook.hs view
@@ -0,0 +1,76 @@+{-|+An example code to show how to create a simple Scotty application to handle LINE+message webhooks.+-}++{-# LANGUAGE OverloadedStrings #-}++module ScottyWebhook where++import Control.Monad (forM_)+import Control.Monad.IO.Class (liftIO)+import Line.Messaging.Webhook+import Line.Messaging.Types (Text(..), Location(..))+import Web.Scotty+import qualified Data.Text as T++-- | An IO action to get channel secret. The channel secret is issued for each+-- LINE bot, and can be found in the LINE developer page.+getChannelSecret :: IO ChannelSecret+getChannelSecret = return "some channel secret"++-- | A Scotty application to handle webhook requests.+--+-- 'webhookAction' is used with a channel secret, event handler and error+-- handler.+app :: ScottyM ()+app =+ get "/webhook" $ do+ channelSecret <- liftIO getChannelSecret+ webhookAction channelSecret handler defaultOnFailure'++-- | An event handler.+--+-- A webhook request can contain several events at once, so the first argument+-- is a list of 'Event's. The function just call the event handler for each+-- event.+handler :: [Event] -> IO ()+handler events = forM_ events handleEvent++-- | A function to handle each event.+--+-- The type of events can be decided with pattern matching. About possible+-- types, please refer to the doc of Line.Messaging.Webhook.Types module.+--+-- Basically, content of each event has a type of 'EventTuple', which may or+-- may not contain a reply token and internal data.+handleEvent :: Event -> IO ()+handleEvent (JoinEvent event) = printSource event+handleEvent (LeaveEvent event) = printSource event+handleEvent (MessageEvent event) = handleMessageEvent event+handleEvent _ = return ()++-- | An example function to print event source of event.+--+-- Event source exists for all the event tuple types, so the reply token and+-- data types can be polymorphic.+printSource :: EventTuple r a -> IO ()+printSource event = do+ putStrLn . concatMap T.unpack $ case getSource event of+ User identifier -> [ "A user", identifier ]+ Group identifier -> [ "A group", identifier ]+ Room identifier -> [ "A room", identifier ]++-- | An example function to print text and location details of a message+--+-- A message event is always replyable and has message data in it.+handleMessageEvent :: ReplyableEvent EventMessage -> IO ()+handleMessageEvent event = do+ putStrLn . concatMap T.unpack $ case getMessage event of+ TextEM identifier (Text text) -> -- TextEM stands for a text event message+ -- print message ID and internal text+ [ "A text message", identifier, text ]+ LocationEM identifier (Location title address _ _) ->+ -- print message ID and location information+ [ "A location message", identifier, title, address ]+ _ -> []
+ examples/WAIWebhook.hs view
@@ -0,0 +1,73 @@+{-|+An example code to show how to create a simple WAI application to handle LINE+message webhooks.+-}++{-# LANGUAGE OverloadedStrings #-}++module WAIWebhook where++import Control.Monad (forM_)+import Line.Messaging.Webhook+import Line.Messaging.Types (Text(..), Location(..))+import Network.Wai+import qualified Data.Text as T++-- | An IO action to get channel secret. The channel secret is issued for each+-- LINE bot, and can be found in the LINE developer page.+getChannelSecret :: IO ChannelSecret+getChannelSecret = return "some channel secret"++-- | A WAI application to handle webhook requests.+--+-- 'webhookApp' is used with a channel secret, event handler and error handler.+app :: Application+app req f = do+ channelSecret <- getChannelSecret+ webhookApp channelSecret handler defaultOnFailure req f++-- | An event handler.+--+-- A webhook request can contain several events at once, so the first argument+-- is a list of 'Event's. The function just call the event handler for each+-- event.+handler :: [Event] -> IO ()+handler events = forM_ events handleEvent++-- | A function to handle each event.+--+-- The type of events can be decided with pattern matching. About possible+-- types, please refer to the doc of Line.Messaging.Webhook.Types module.+--+-- Basically, content of each event has a type of 'EventTuple', which may or+-- may not contain a reply token and internal data.+handleEvent :: Event -> IO ()+handleEvent (JoinEvent event) = printSource event+handleEvent (LeaveEvent event) = printSource event+handleEvent (MessageEvent event) = handleMessageEvent event+handleEvent _ = return ()++-- | An example function to print event source of event.+--+-- Event source exists for all the event tuple types, so the reply token and+-- data types can be polymorphic.+printSource :: EventTuple r a -> IO ()+printSource event = do+ putStrLn . concatMap T.unpack $ case getSource event of+ User identifier -> [ "A user", identifier ]+ Group identifier -> [ "A group", identifier ]+ Room identifier -> [ "A room", identifier ]++-- | An example function to print text and location details of a message+--+-- A message event is always replyable and has message data in it.+handleMessageEvent :: ReplyableEvent EventMessage -> IO ()+handleMessageEvent event = do+ putStrLn . concatMap T.unpack $ case getMessage event of+ TextEM identifier (Text text) -> -- TextEM stands for a text event message+ -- print message ID and internal text+ [ "A text message", identifier, text ]+ LocationEM identifier (Location title address _ _) ->+ -- print message ID and location information+ [ "A location message", identifier, title, address ]+ _ -> []
line.cabal view
@@ -1,5 +1,5 @@ name: line-version: 1.0.1.0+version: 2.0.0.0 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -15,7 +15,7 @@ . * Internal auth signature validator .- * Webhook handled with handler function or WAI application+ * Webhook handled with handler function, WAI application, or Scotty action . * Functions and types for <https://devdocs.line.me/en/#messaging-api LINE Messaging API> .@@ -23,6 +23,10 @@ <https://github.com/noraesae/line/tree/master/examples examples> directory. category: Network author: Jun+extra-source-files:+ README.md+ CHANGELOG.md+ examples/*.hs source-repository head type: git@@ -49,7 +53,8 @@ base64-bytestring >=1.0.0.1 && <1.1, time >=1.6.0.1 && <1.7, wreq >=0.4.1.0 && <0.5,- lens ==4.14.*+ lens ==4.14.*,+ scotty >=0.11.0 && <0.12 default-language: Haskell2010 default-extensions: OverloadedStrings hs-source-dirs: src@@ -60,8 +65,28 @@ main-is: Spec.hs build-depends: base >=4.9.0.0 && <4.10,- line >=1.0.1.0 && <1.1+ line >=2.0.0.0 && <2.1,+ hspec >=2.2.4 && <2.3,+ hspec-wai >=0.6.6 && <0.7,+ QuickCheck >=2.8.2 && <2.9,+ quickcheck-instances >=0.3.12 && <0.4,+ text >=1.2.2.1 && <1.3,+ bytestring >=0.10.8.1 && <0.11,+ cryptohash-sha256 >=0.11.100.1 && <0.12,+ base64-bytestring >=1.0.0.1 && <1.1,+ transformers >=0.5.2.0 && <0.6,+ scotty >=0.11.0 && <0.12,+ aeson >=0.11.2.1 && <0.12,+ raw-strings-qq ==1.1.*,+ time >=1.6.0.1 && <1.7 default-language: Haskell2010 default-extensions: OverloadedStrings hs-source-dirs: test+ other-modules:+ Line.Messaging.API.TypesSpec+ Line.Messaging.API.TypesSpecHelper+ Line.Messaging.WebhookSpec+ Line.Messaging.Webhook.TypesSpec+ Line.Messaging.Webhook.TypesSpecHelper+ Line.Messaging.Webhook.ValidationSpec ghc-options: -threaded -rtsopts -with-rtsopts=-N
src/Line/Messaging/API/Types.hs view
@@ -48,6 +48,7 @@ import Control.Exception (SomeException) import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), object, (.:), (.=)) import Data.Aeson.Types (Pair)+import Data.Maybe (maybeToList) import Line.Messaging.Common.Types import qualified Data.Text as T import qualified Data.ByteString.Lazy as BL@@ -311,9 +312,9 @@ -- For more details of each field, please refer to the -- <https://devdocs.line.me/en/#buttons Buttons> section in the LINE -- documentation.-data Buttons = Buttons { getButtonsThumbnailURL :: URL+data Buttons = Buttons { getButtonsThumbnailURL :: Maybe URL -- ^ URL for thumbnail image- , getButtonsTitle :: T.Text+ , getButtonsTitle :: Maybe T.Text -- ^ Title text , getButtonsText :: T.Text -- ^ Description text@@ -324,12 +325,15 @@ deriving (Eq, Show) instance ToJSON Buttons where- toJSON (Buttons url title text actions) = object [ "type" .= ("buttons" :: T.Text)- , "thumbnailImageUrl" .= url- , "title" .= title- , "text" .= text- , "actions" .= toJSON actions- ]+ toJSON (Buttons maybeURL maybeTitle text actions) =+ object . concat $+ [ [ "type" .= ("buttons" :: T.Text)+ , "text" .= text+ , "actions" .= toJSON actions+ ]+ , maybeToList $ ("thumbnailImageUrl" .=) <$> maybeURL+ , maybeToList $ ("title" .=) <$> maybeTitle+ ] -- | The confirm content type for template message. --@@ -373,9 +377,9 @@ -- -- It has the same fields as 'Buttons', except that the number of actions is -- up to 3.-data Column = Column { getColumnThumbnailURL :: URL+data Column = Column { getColumnThumbnailURL :: Maybe URL -- ^ URL for thumbnail image- , getColumnTitle :: T.Text+ , getColumnTitle :: Maybe T.Text -- ^ Title text , getColumnText :: T.Text -- ^ Description text@@ -386,11 +390,14 @@ deriving (Eq, Show) instance ToJSON Column where- toJSON (Column url title text actions) = object [ "thumbnailImageUrl" .= url- , "title" .= title- , "text" .= text- , "actions" .= toJSON actions- ]+ toJSON (Column maybeURL maybeTitle text actions) =+ object . concat $+ [ [ "text" .= text+ , "actions" .= toJSON actions+ ]+ , maybeToList $ ("thumbnailImageUrl" .=) <$> maybeURL+ , maybeToList $ ("title" .=) <$> maybeTitle+ ] -- | Just a type alias for 'T.Text', used with 'TemplateAction'. type Label = T.Text@@ -403,7 +410,7 @@ -- ^ Message action. When clicked, a specified text will -- be sent into the same room by a user who clicked the -- button.- | TplPostbackAction Label Postback T.Text+ | TplPostbackAction Label Postback (Maybe T.Text) -- ^ Postback action. When clicked, a specified text will -- be sent, and postback data will be sent to webhook -- server as a postback event.@@ -413,11 +420,14 @@ deriving (Eq, Show) instance ToJSON TemplateAction where- toJSON (TplPostbackAction label data' text) = object [ "type" .= ("postback" :: T.Text)- , "label" .= label- , "data" .= data'- , "text" .= text- ]+ toJSON (TplPostbackAction label data' maybeText) =+ object . concat $+ [ [ "type" .= ("postback" :: T.Text)+ , "label" .= label+ , "data" .= data'+ ]+ , maybeToList $ ("text" .=) <$> maybeText+ ] toJSON (TplMessageAction label text) = object [ "type" .= ("message" :: T.Text) , "label" .= label , "text" .= text@@ -486,7 +496,7 @@ , getErrorProperty :: Maybe T.Text , getErrorDetails :: Maybe [APIErrorBody] }- deriving Show+ deriving (Eq, Show) instance FromJSON APIErrorBody where parseJSON (Object v) = APIErrorBody <$> v .: "message"
src/Line/Messaging/Webhook.hs view
@@ -11,38 +11,43 @@ -- * 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,--- and parses the request into a list of webhook events.+-- 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 :: ChannelSecret- -> Request- -> ExceptT WebhookFailure IO [Event]-webhook secret req = do- body <- liftIO $ lazyRequestBody req- if not $ validateSignature secret req body- then throwE SignatureVerificationFailed- else do- case decode' body of- Nothing -> throwE MessageDecodeFailed- Just (Body events) -> return events+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 -waiResponse :: WebhookResult -> Application-waiResponse result req f = case result of- Ok -> f $ responseBuilder status200 [] ""- WaiResponse res -> f res- WaiApp app -> app req f+getSigFromWaiReq :: Request -> Maybe Signature+getSigFromWaiReq = lookup "X-Line-Signature" . requestHeaders -- | A webhook handler for WAI. It uses 'webhook' internally and returns a WAI -- 'Application'.@@ -57,25 +62,72 @@ -- webhookApp secret handler defaultOnFailure req f -- _ -> undefined ----- handler :: [Event] -> IO WebhookResult--- handler events = forM_ events handleEvent $> Ok+-- 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 WebhookResult) -- ^ Event handler- -> (WebhookFailure -> Application) -- ^ Error handler. Just to return 400 for failures, use 'defaultOnFailure'.+ -> ([Event] -> IO ()) -- ^ Event handler+ -> (WebhookFailure -> Application)+ -- ^ Error handler. Just to return 400 for failures, use 'defaultOnFailure'. -> Application webhookApp secret handler failHandler req f = do- result <- runExceptT $ webhook secret req- case result of- Right events -> handler events >>= waiResponse <*> pure req <*> pure f- Left exception -> failHandler exception req f+ 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+-- get "/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
src/Line/Messaging/Webhook/Types.hs view
@@ -6,8 +6,9 @@ -- * Common types -- | Re-exported for convenience. module Line.Messaging.Common.Types,+ -- * Validation+ Signature, -- * Result and failure- WebhookResult (..), WebhookFailure (..), -- * Webhook request body@@ -46,15 +47,13 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Line.Messaging.API.Types import Line.Messaging.Common.Types-import Network.Wai (Response, Application) import qualified Data.Text as T+import qualified Data.ByteString as B --- | A result type a webhook event handler should return.+-- | A type alias for auth signature. ----- It is eventually transformed to a WAI response or application.-data WebhookResult = Ok -- ^ Respond with an empty 200 OK response.- | WaiResponse Response -- ^ Respond with a WAI response.- | WaiApp Application -- ^ Respond with a WAI application.+-- It is set as @X-Line-Signature@ header in webhook requests+type Signature = B.ByteString -- | A failure type returned when a webhook request is malformed. data WebhookFailure = SignatureVerificationFailed -- ^ When the signature is not valid.
src/Line/Messaging/Webhook/Validation.hs view
@@ -13,25 +13,15 @@ import Crypto.Hash.SHA256 (hmaclazy) import Data.Text.Encoding (encodeUtf8) import Line.Messaging.Types-import Network.Wai-import qualified Data.ByteString as B import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Lazy as BL -getSignature :: Request -> Maybe B.ByteString-getSignature req = lookup "X-Line-Signature" headers- where- headers = requestHeaders req---- | Provided a channel secret, WAI request and request body, it determines--- the request is properly signatured, which probably means it is sent--- from a valid LINE server.+-- | Provided a channel secret, request body and auth signature, it determines+-- the request is properly signatured, which probably means it is sent from a+-- valid LINE server. -- -- For more details of webhook authentication, please refer to -- <https://devdocs.line.me/en/#webhook-authentication the LINE documentation>.-validateSignature :: ChannelSecret -> Request -> BL.ByteString -> Bool-validateSignature secret req body = case getSignature req of- Nothing -> False- Just signature -> hash == signature- where- hash = Base64.encode $ hmaclazy (encodeUtf8 secret) body+validateSignature :: ChannelSecret -> BL.ByteString -> Signature -> Bool+validateSignature secret body signature = hash == signature+ where hash = Base64.encode $ hmaclazy (encodeUtf8 secret) body
+ test/Line/Messaging/API/TypesSpec.hs view
@@ -0,0 +1,136 @@+module Line.Messaging.API.TypesSpec where++import Test.Hspec++import Line.Messaging.API.TypesSpecHelper++import Data.Aeson+import Data.Aeson.Types+import Data.Maybe (isJust, fromJust)+import Line.Messaging.API.Types+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T++fromJSONSpec :: (FromJSON a, Eq a, Show a)+ => [(BL.ByteString, Maybe a)]+ -> SpecWith ()+fromJSONSpec ((raw, result):xs) = do+ let title = if isJust result then "success" else "fail"+ it title $ decode raw `shouldBe` result+ fromJSONSpec xs+fromJSONSpec [] = return ()++messageableSpec :: (Messageable a, Eq a, Show a)+ => String+ -> a+ -> BL.ByteString+ -> SpecWith ()+messageableSpec testTitle a result =+ it testTitle $ toJSON (Message a) `shouldBe` fromJust (decode result)++spec :: Spec+spec = do+ describe "messageables" $ do+ messageableSpec "text"+ (Text "Hello, world")+ textMessageableResult++ messageableSpec "image"+ (Image "https://example.com/original.jpg" "https://example.com/preview.jpg")+ imageMessageableResult++ messageableSpec "video"+ (Video "https://example.com/original.mp4" "https://example.com/preview.jpg")+ videoMessageableResult++ messageableSpec "audio"+ (Audio "https://example.com/original.m4a" 240000)+ audioMessageableResult++ messageableSpec "location"+ (Location "my location" "some address" 35.65910807942215 139.70372892916203)+ locationMessageableResult++ messageableSpec "sticker"+ (Sticker "1" "1")+ stickerMessageableResult++ messageableSpec "imagemap"+ (ImageMap "https://example.com/bot/images/rm001" "this is an imagemap" (1040, 1040)+ [ IMURIAction "https://example.com/" (0, 0, 520, 1040)+ , IMMessageAction "hello" (520, 0, 520, 1040)+ ])+ imageMapMessageableResult++ messageableSpec "template buttons"+ (Template "this is a buttons template" $+ Buttons (Just "https://example.com/bot/images/image.jpg") (Just "Menu") "Please select"+ [ TplPostbackAction "Buy" "action=buy&itemid=123" Nothing+ , TplPostbackAction "Add to cart" "action=add&itemid=123" Nothing+ , TplURIAction "View detail" "http://example.com/page/123"+ ])+ buttonsTemplateMessageableResult++ messageableSpec "template confirm"+ (Template "this is a confirm template" $+ Confirm "Are you sure?"+ [ TplMessageAction "Yes" "yes"+ , TplMessageAction "No" "no"+ ])+ confirmTemplateMessageableResult++ messageableSpec "template carousel"+ (Template "this is a carousel template" $+ Carousel [ Column (Just "https://example.com/bot/images/item1.jpg")+ (Just "this is menu")+ "description"+ [ TplPostbackAction "Buy" "action=buy&itemid=111" Nothing+ , TplPostbackAction "Add to cart" "action=add&itemid=111" Nothing+ , TplURIAction "View detail" "http://example.com/page/111"+ ]+ , Column (Just "https://example.com/bot/images/item2.jpg")+ (Just "this is menu")+ "description"+ [ TplPostbackAction "Buy" "action=buy&itemid=222" Nothing+ , TplPostbackAction "Add to cart" "action=add&itemid=222" Nothing+ , TplURIAction "View detail" "http://example.com/page/222"+ ]+ ])+ carouselTemplateMessageableResult++ describe "JSON decode" $ do+ describe "profile" $ fromJSONSpec+ [ ( fullProfile, Just $ Profile+ "123"+ "Jun"+ (Just "https://example.com/profile.jpg")+ (Just "some status message") )+ , ( noPicProfile, Just $ Profile+ "123"+ "Jun"+ Nothing+ (Just "some status message") )+ , ( noDescProfile, Just $ Profile+ "123"+ "Jun"+ (Just "https://example.com/profile.jpg")+ Nothing )+ , ( simpleProfile, Just $ Profile+ "123"+ "Jun"+ Nothing+ Nothing )+ , ( badProfile, Nothing )+ ]++ describe "API error body" $ fromJSONSpec+ [ ( simpleError, Just $ APIErrorBody "Invalid reply token" Nothing Nothing )+ , ( complexError, Just $ APIErrorBody+ "The request body has 2 error(s)"+ Nothing+ (Just [ APIErrorBody "May not be empty" (Just "messages[0].text") Nothing+ , APIErrorBody "Must be one of the following values: [text, image, video, audio, location, sticker, template, imagemap]" (Just "messages[1].type") Nothing+ ])+ )+ , ( badError, Nothing )+ ]
+ test/Line/Messaging/API/TypesSpecHelper.hs view
@@ -0,0 +1,284 @@+{-# LANGUAGE QuasiQuotes #-}++module Line.Messaging.API.TypesSpecHelper where++import Text.RawString.QQ+import qualified Data.ByteString.Lazy as BL++textMessageableResult :: BL.ByteString+textMessageableResult = [r|+{+ "type": "text",+ "text": "Hello, world"+}+|]++imageMessageableResult :: BL.ByteString+imageMessageableResult = [r|+{+ "type": "image",+ "originalContentUrl": "https://example.com/original.jpg",+ "previewImageUrl": "https://example.com/preview.jpg"+}+|]++videoMessageableResult :: BL.ByteString+videoMessageableResult = [r|+{+ "type": "video",+ "originalContentUrl": "https://example.com/original.mp4",+ "previewImageUrl": "https://example.com/preview.jpg"+}+|]++audioMessageableResult :: BL.ByteString+audioMessageableResult = [r|+{+ "type": "audio",+ "originalContentUrl": "https://example.com/original.m4a",+ "duration": 240000+}+|]++locationMessageableResult :: BL.ByteString+locationMessageableResult = [r|+{+ "type": "location",+ "title": "my location",+ "address": "some address",+ "latitude": 35.65910807942215,+ "longitude": 139.70372892916203+}+|]++stickerMessageableResult :: BL.ByteString+stickerMessageableResult = [r|+{+ "type": "sticker",+ "packageId": "1",+ "stickerId": "1"+}+|]++imageMapMessageableResult :: BL.ByteString+imageMapMessageableResult = [r|+{+ "type": "imagemap",+ "baseUrl": "https://example.com/bot/images/rm001",+ "altText": "this is an imagemap",+ "baseSize": {+ "height": 1040,+ "width": 1040+ },+ "actions": [+ {+ "type": "uri",+ "linkUri": "https://example.com/",+ "area": {+ "x": 0,+ "y": 0,+ "width": 520,+ "height": 1040+ }+ },+ {+ "type": "message",+ "text": "hello",+ "area": {+ "x": 520,+ "y": 0,+ "width": 520,+ "height": 1040+ }+ }+ ]+}+|]++buttonsTemplateMessageableResult :: BL.ByteString+buttonsTemplateMessageableResult = [r|+{+ "type": "template",+ "altText": "this is a buttons template",+ "template": {+ "type": "buttons",+ "thumbnailImageUrl": "https://example.com/bot/images/image.jpg",+ "title": "Menu",+ "text": "Please select",+ "actions": [+ {+ "type": "postback",+ "label": "Buy",+ "data": "action=buy&itemid=123"+ },+ {+ "type": "postback",+ "label": "Add to cart",+ "data": "action=add&itemid=123"+ },+ {+ "type": "uri",+ "label": "View detail",+ "uri": "http://example.com/page/123"+ }+ ]+ }+}+|]++confirmTemplateMessageableResult :: BL.ByteString+confirmTemplateMessageableResult = [r|+{+ "type": "template",+ "altText": "this is a confirm template",+ "template": {+ "type": "confirm",+ "text": "Are you sure?",+ "actions": [+ {+ "type": "message",+ "label": "Yes",+ "text": "yes"+ },+ {+ "type": "message",+ "label": "No",+ "text": "no"+ }+ ]+ }+}+|]++carouselTemplateMessageableResult :: BL.ByteString+carouselTemplateMessageableResult = [r|+{+ "type": "template",+ "altText": "this is a carousel template",+ "template": {+ "type": "carousel",+ "columns": [+ {+ "thumbnailImageUrl": "https://example.com/bot/images/item1.jpg",+ "title": "this is menu",+ "text": "description",+ "actions": [+ {+ "type": "postback",+ "label": "Buy",+ "data": "action=buy&itemid=111"+ },+ {+ "type": "postback",+ "label": "Add to cart",+ "data": "action=add&itemid=111"+ },+ {+ "type": "uri",+ "label": "View detail",+ "uri": "http://example.com/page/111"+ }+ ]+ },+ {+ "thumbnailImageUrl": "https://example.com/bot/images/item2.jpg",+ "title": "this is menu",+ "text": "description",+ "actions": [+ {+ "type": "postback",+ "label": "Buy",+ "data": "action=buy&itemid=222"+ },+ {+ "type": "postback",+ "label": "Add to cart",+ "data": "action=add&itemid=222"+ },+ {+ "type": "uri",+ "label": "View detail",+ "uri": "http://example.com/page/222"+ }+ ]+ }+ ]+ }+}+|]++fullProfile :: BL.ByteString+fullProfile = [r|+{+ "userId": "123",+ "displayName": "Jun",+ "pictureUrl": "https://example.com/profile.jpg",+ "statusMessage": "some status message"+}+|]++noPicProfile :: BL.ByteString+noPicProfile = [r|+{+ "userId": "123",+ "displayName": "Jun",+ "pictureUrl": null,+ "statusMessage": "some status message"+}+|]++noDescProfile :: BL.ByteString+noDescProfile = [r|+{+ "userId": "123",+ "displayName": "Jun",+ "pictureUrl": "https://example.com/profile.jpg",+ "statusMessage": null+}+|]++simpleProfile :: BL.ByteString+simpleProfile = [r|+{+ "userId": "123",+ "displayName": "Jun",+ "pictureUrl": null,+ "statusMessage": null+}+|]++badProfile :: BL.ByteString+badProfile = [r|+{+ "userId'": "123",+ "displayName": "Jun",+ "pictureUrl": "https://example.com/profile.jpg",+ "statusMessage": null+}+|]++simpleError :: BL.ByteString+simpleError = [r|+{+ "message":"Invalid reply token"+}+|]+++complexError :: BL.ByteString+complexError = [r|+{+ "message":"The request body has 2 error(s)",+ "details":[+ {"message":"May not be empty","property":"messages[0].text"},+ {"message":"Must be one of the following values: [text, image, video, audio, location, sticker, template, imagemap]","property":"messages[1].type"}+ ]+}+|]++badError :: BL.ByteString+badError = [r|+{+ "massage": "no message, yes massage"+}+|]
+ test/Line/Messaging/Webhook/TypesSpec.hs view
@@ -0,0 +1,134 @@+module Line.Messaging.Webhook.TypesSpec where++import Test.Hspec++import Line.Messaging.Webhook.TypesSpecHelper++import Data.Aeson+import Data.Maybe (isJust)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Line.Messaging.Webhook.Types+import Line.Messaging.Types (Text(..), Sticker(..), Location(..))+import qualified Data.ByteString.Lazy as BL++fromJSONSpec :: (FromJSON a, Eq a, Show a)+ => [(BL.ByteString, Maybe a)]+ -> SpecWith ()+fromJSONSpec ((raw, result):xs) = do+ let title = if isJust result then "success" else "fail"+ it title $ decode raw `shouldBe` result+ fromJSONSpec xs+fromJSONSpec [] = return ()++datetime :: Integer -> UTCTime+datetime = posixSecondsToUTCTime . (/ 1000) . fromInteger++spec :: Spec+spec = do+ describe "body" $ fromJSONSpec+ [ ( goodBody, Just $ Body [] )+ , ( badBody, Nothing)+ ]++ describe "event source" $ fromJSONSpec+ [ ( goodUser, Just $ User "123" )+ , ( goodGroup, Just $ Group "456" )+ , ( goodRoom, Just $ Room "789" )+ , ( badSource, Nothing )+ ]++ let replyE event a = Just $ Body $ [+ event ( User "U206d25c2ea6bd87c17655609a1c37cb8"+ , datetime 1462629479859+ , "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA"+ , a+ )+ ]+ let nonreplyE event a = Just $ Body $ [+ event ( User "U206d25c2ea6bd87c17655609a1c37cb8"+ , datetime 1462629479859+ , ()+ , a+ )+ ]++ describe "text message event" $ fromJSONSpec+ [ ( goodTextMessage, replyE MessageEvent (TextEM "325708" $ Text "Hello, world") )+ , ( badTextMessage, Nothing )+ ]++ describe "image message event" $ fromJSONSpec+ [ ( goodImageMessage, replyE MessageEvent (ImageEM "325708") )+ , ( badImageMessage, Nothing )+ ]++ describe "video message event" $ fromJSONSpec+ [ ( goodVideoMessage, replyE MessageEvent (VideoEM "325708") )+ , ( badVideoMessage, Nothing )+ ]++ describe "audio message event" $ fromJSONSpec+ [ ( goodAudioMessage, replyE MessageEvent (AudioEM "325708") )+ , ( badAudioMessage, Nothing )+ ]++ describe "location message event" $ fromJSONSpec+ [ ( goodLocationMessage, replyE MessageEvent (LocationEM "325708" $+ Location+ "my location"+ "some address"+ 35.65910807942215+ 139.70372892916203) )+ , ( badLocationMessage, Nothing )+ ]++ describe "stcker message event" $ fromJSONSpec+ [ ( goodStickerMessage, replyE MessageEvent (StickerEM "325708" $+ Sticker+ "1"+ "1") )+ , ( badStickerMessage, Nothing )+ ]++ describe "follow event" $ fromJSONSpec+ [ ( goodFollow, replyE FollowEvent () )+ , ( badFollow, Nothing )+ ]++ describe "unfollow event" $ fromJSONSpec+ [ ( goodUnfollow, nonreplyE UnfollowEvent () )+ , ( badUnfollow, Nothing )+ ]++ describe "join event" $ fromJSONSpec+ [ ( goodJoin, Just $ Body $ [+ JoinEvent ( Group "cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+ , datetime 1462629479859+ , "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA"+ , ()+ )+ ] )+ , ( badJoin, Nothing )+ ]++ describe "leave event" $ fromJSONSpec+ [ ( goodLeave, Just $ Body $ [+ LeaveEvent ( Group "cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+ , datetime 1462629479859+ , ()+ , ()+ )+ ] )+ , ( badLeave, Nothing )+ ]++ describe "postback event" $ fromJSONSpec+ [ ( goodPostback, replyE PostbackEvent "action=buyItem&itemId=123123&color=red" )+ , ( badPostback, Nothing )+ ]++ describe "beacon event" $ fromJSONSpec+ [ ( goodBeacon, replyE BeaconEvent (BeaconEnter "d41d8cd98f") )+ , ( badBeacon, Nothing )+ ]
+ test/Line/Messaging/Webhook/TypesSpecHelper.hs view
@@ -0,0 +1,469 @@+{-# LANGUAGE QuasiQuotes #-}++module Line.Messaging.Webhook.TypesSpecHelper where++import Text.RawString.QQ+import qualified Data.ByteString.Lazy as BL++goodBody :: BL.ByteString+goodBody = [r|+{ "events": [] }+|]++badBody :: BL.ByteString+badBody = [r|+{ "event": [] }+|]++goodUser :: BL.ByteString+goodUser = [r|+{ "type": "user", "userId": "123" }+|]++goodGroup :: BL.ByteString+goodGroup = [r|+{ "type": "group", "groupId": "456" }+|]++goodRoom :: BL.ByteString+goodRoom = [r|+{ "type": "room", "roomId": "789" }+|]++badSource :: BL.ByteString+badSource = [r|+{ "type": "bad", "userId": "123 }+|]++goodTextMessage :: BL.ByteString+goodTextMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id": "325708",+ "type": "text",+ "text": "Hello, world"+ }+}+] }+|]++badTextMessage :: BL.ByteString+badTextMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id": "325708",+ "type": "text'",+ "text": "Hello, world"+ }+}+] }+|]++goodImageMessage :: BL.ByteString+goodImageMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id": "325708",+ "type": "image"+ }+}++] }+|]++badImageMessage :: BL.ByteString+badImageMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id": "325708",+ "type": "image'"+ }+}+] }+|]++goodVideoMessage :: BL.ByteString+goodVideoMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id": "325708",+ "type": "video"+ }+}+] }+|]++badVideoMessage :: BL.ByteString+badVideoMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id": "325708",+ "type": "video'"+ }+}+] }+|]++goodAudioMessage :: BL.ByteString+goodAudioMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id": "325708",+ "type": "audio"+ }+}+] }+|]++badAudioMessage :: BL.ByteString+badAudioMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id": "325708",+ "type": "audio'"+ }+}+] }+|]++goodLocationMessage :: BL.ByteString+goodLocationMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id": "325708",+ "type": "location",+ "title": "my location",+ "address": "some address",+ "latitude": 35.65910807942215,+ "longitude": 139.70372892916203+ }+}+] }+|]++badLocationMessage :: BL.ByteString+badLocationMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id'": "325708",+ "type": "location",+ "title": "my location",+ "address": "〒150-0002 東京都渋谷区渋谷２丁目２１−１",+ "latitude": 35.65910807942215,+ "longitude": 139.70372892916203+ }+}+] }+|]++goodStickerMessage :: BL.ByteString+goodStickerMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message": {+ "id": "325708",+ "type": "sticker",+ "packageId": "1",+ "stickerId": "1"+ }+}+] }+|]++badStickerMessage :: BL.ByteString+badStickerMessage = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "message",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "message'": {+ "id": "325708",+ "type": "sticker",+ "packageId": "1",+ "stickerId": "1"+ }+}+] }+|]++goodFollow :: BL.ByteString+goodFollow = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "follow",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ }+}+] }+|]++badFollow :: BL.ByteString+badFollow = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "follow'",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ }+}+] }+|]++goodUnfollow :: BL.ByteString+goodUnfollow = [r|+{ "events": [+{+ "type": "unfollow",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ }+}+] }+|]++badUnfollow :: BL.ByteString+badUnfollow = [r|+{ "events": [+{+ "type": "unfollow'",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ }+}+] }+|]++goodJoin :: BL.ByteString+goodJoin = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "join",+ "timestamp": 1462629479859,+ "source": {+ "type": "group",+ "groupId": "cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+ }+}+] }+|]++badJoin :: BL.ByteString+badJoin = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "join'",+ "timestamp": 1462629479859,+ "source": {+ "type": "group",+ "groupId": "cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+ }+}+] }+|]++goodLeave :: BL.ByteString+goodLeave = [r|+{ "events": [+{+ "type": "leave",+ "timestamp": 1462629479859,+ "source": {+ "type": "group",+ "groupId": "cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+ }+}+] }+|]++badLeave :: BL.ByteString+badLeave = [r|+{ "events": [+{+ "type": "leave'",+ "timestamp": 1462629479859,+ "source": {+ "type": "group",+ "groupId": "cxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+ }+}+] }+|]++goodPostback :: BL.ByteString+goodPostback = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "postback",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "postback": {+ "data": "action=buyItem&itemId=123123&color=red"+ }+}+] }+|]++badPostback :: BL.ByteString+badPostback = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "postback",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "postback": {+ "data'": "action=buyItem&itemId=123123&color=red"+ }+}+] }+|]++goodBeacon :: BL.ByteString+goodBeacon = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "beacon",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "beacon": {+ "hwid": "d41d8cd98f",+ "type": "enter"+ }+}+] }+|]++badBeacon :: BL.ByteString+badBeacon = [r|+{ "events": [+{+ "replyToken": "nHuyWiB7yP5Zw52FIkcQobQuGDXCTA",+ "type": "beacon",+ "timestamp": 1462629479859,+ "source": {+ "type": "user",+ "userId": "U206d25c2ea6bd87c17655609a1c37cb8"+ },+ "bacon": {+ "hwid": "d41d8cd98f",+ "type": "enter"+ }+}+] }+|]
+ test/Line/Messaging/Webhook/ValidationSpec.hs view
@@ -0,0 +1,27 @@+module Line.Messaging.Webhook.ValidationSpec where++import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances++import Crypto.Hash.SHA256 (hmaclazy)+import Data.Text.Encoding (encodeUtf8)+import Line.Messaging.Webhook.Validation (validateSignature)+import qualified Data.ByteString as B+import qualified Data.ByteString.Base64 as Base64++spec :: Spec+spec = do+ describe "validation" $ do+ it "returns true for valid signature" $ property $ \ channelSecret body ->+ let+ signature = Base64.encode $ hmaclazy (encodeUtf8 channelSecret) body+ in+ validateSignature channelSecret body signature++ it "returns false for invalid signature" $ property $ \ channelSecret body ->+ let+ right = Base64.encode $ hmaclazy (encodeUtf8 channelSecret) body+ wrong = right `B.append` "wrong"+ in+ not $ validateSignature channelSecret body wrong
+ test/Line/Messaging/WebhookSpec.hs view
@@ -0,0 +1,80 @@+module Line.Messaging.WebhookSpec where++import Test.Hspec+import Test.Hspec.Wai++import Control.Monad.Trans.Except (runExceptT)+import Crypto.Hash.SHA256 (hmaclazy)+import Data.Either (isRight)+import Data.Text.Encoding (encodeUtf8)+import Line.Messaging.Webhook+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Base64 as Base64+import qualified Web.Scotty as Scotty++emptyBody :: BL.ByteString+emptyBody = "{ \"events\": [] }"++wrongBody :: BL.ByteString+wrongBody = "{ \"event\": [] }"++createSig :: ChannelSecret -> BL.ByteString -> Signature+createSig sec body = Base64.encode $ hmaclazy (encodeUtf8 sec) body++spec :: Spec+spec = do+ describe "Basic webhook" $ do+ it "right result" $ do+ let secret = "some-secret"+ sig = createSig secret emptyBody+ result <- runExceptT $ webhook secret emptyBody sig+ result `shouldSatisfy` isRight++ it "wrong sig" $ do+ let secret = "some-secret"+ sig = "wrong-sig"+ result <- runExceptT $ webhook secret emptyBody sig+ result `shouldBe` Left SignatureVerificationFailed++ it "malformed body" $ do+ let secret = "some-secret"+ sig = createSig secret wrongBody+ result <- runExceptT $ webhook secret wrongBody sig+ result `shouldBe` Left MessageDecodeFailed++ describe "WAI webhook" $+ let waiApp = return $ webhookApp "some-secret" (const $ return ()) defaultOnFailure+ webhookReq sec body hasCorrectSig = request "GET" "/" headers body+ where+ sig = if hasCorrectSig then createSig sec body else "wrong sig"+ headers = [ ("X-Line-Signature", sig) ]+ in with waiApp $ do+ it "handle req well" $ do+ webhookReq "some-secret" emptyBody True `shouldRespondWith` 200++ it "with wrong sig" $ do+ webhookReq "some-secret" emptyBody False `shouldRespondWith`+ "SignatureVerificationFailed" { matchStatus = 400 }++ it "malformed body" $ do+ webhookReq "some-secret" wrongBody True `shouldRespondWith`+ "MessageDecodeFailed" { matchStatus = 400 }++ describe "Scotty webhook" $+ let waiApp = Scotty.scottyApp $+ Scotty.get "/" $ webhookAction "some-secret" (const $ return ()) defaultOnFailure'+ webhookReq sec body hasCorrectSig = request "GET" "/" headers body+ where+ sig = if hasCorrectSig then createSig sec body else "wrong sig"+ headers = [ ("X-Line-Signature", sig) ]+ in with waiApp $ do+ it "handle req well" $ do+ webhookReq "some-secret" emptyBody True `shouldRespondWith` 200++ it "with wrong sig" $ do+ webhookReq "some-secret" emptyBody False `shouldRespondWith`+ "SignatureVerificationFailed" { matchStatus = 400 }++ it "malformed body" $ do+ webhookReq "some-secret" wrongBody True `shouldRespondWith`+ "MessageDecodeFailed" { matchStatus = 400 }
test/Spec.hs view
@@ -1,2 +1,1 @@-main :: IO ()-main = putStrLn "Test suite not yet implemented"+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}