line-bot-sdk 0.4.0.0 → 0.5.0.0

raw patch · 13 files changed

+366/−302 lines, 13 filesdep +freedep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: free

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• README.md +24/−0
• examples/Echo.hs +10/−9
• line-bot-sdk.cabal +5/−3
• src/Line/Bot/Client.hs +60/−86
• src/Line/Bot/Client/Auth.hs +0/−29
• src/Line/Bot/Endpoints.hs +0/−137
• src/Line/Bot/Internal/Auth.hs +25/−0
• src/Line/Bot/Internal/Endpoints.hs +164/−0
• src/Line/Bot/Types.hs +15/−6
• src/Line/Bot/Webhook.hs +2/−3
• src/Line/Bot/Webhook/Events.hs +6/−8
• test/Line/Bot/ClientSpec.hs +54/−20
• test/Line/Bot/WebhookSpec.hs +1/−1

@@ -1,1 +1,25 @@ # line-bot-sdk [![Build Status](https://travis-ci.org/moleike/line-bot-sdk.svg?branch=master)](https://travis-ci.org/moleike/line-bot-sdk)++Servant library for building LINE chatbots. ++Features:++* Servant combinator `LineReqBody` for validation of request signatures using the channel secret. This is required to distinguish legitimate requests sent by LINE from malicious requests++* Bindings for (most) of the Messaging APIs++## Usage++See the +[examples/](https://github.com/moleike/line-bot-sdk/tree/master/examples) directory.++## Documentation++For details see the reference [documentation on Hackage][hackage].++[hackage]: http://hackage.haskell.org/package/line-bot-sdk "Hackage"++## Contribute++Please report bugs via the+[github issue tracker](https://github.com/moleike/line-bot-sdk/issues).

@@ -1,14 +1,15 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE NamedFieldPuns    #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TypeOperators     #-}+{-# LANGUAGE DataKinds                #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE NamedFieldPuns           #-}+{-# LANGUAGE OverloadedStrings        #-}+{-# LANGUAGE TypeOperators            #-}  module Main (main) where  import           Control.Monad                        (forM_) import           Control.Monad.IO.Class               (liftIO) import           Control.Monad.Trans.Reader           (ReaderT, ask, runReaderT)+import           Data.Maybe                           (fromMaybe) import           Data.String                          (fromString) import           Line.Bot.Client                      (Line, replyMessage,                                                        runLine)@@ -18,7 +19,7 @@ import           Network.Wai.Middleware.RequestLogger (logStdout) import           Servant import           Servant.Server                       (Context ((:.), EmptyContext))-import           System.Environment                   (getEnv)+import           System.Environment                   (getEnv, lookupEnv)  type WebM = ReaderT ChannelToken Handler @@ -43,12 +44,12 @@   where     api = Proxy :: Proxy API     pc = Proxy :: Proxy '[ChannelSecret]-    server = hoistServerWithContext api pc (flip runReaderT token) echoServer+    server = hoistServerWithContext api pc (`runReaderT` token) echoServer     context = secret :. EmptyContext  main :: IO () main = do   token  <- fromString <$> getEnv "CHANNEL_TOKEN"   secret <- fromString <$> getEnv "CHANNEL_SECRET"-  port   <- read       <$> getEnv "PORT"-  run port $ logStdout $ app token secret+  port   <- fmap read  <$> lookupEnv "PORT"+  run (fromMaybe 8000 port) $ logStdout $ app token secret

@@ -1,5 +1,5 @@ name:                line-bot-sdk-version:             0.4.0.0+version:             0.5.0.0 synopsis:            Haskell SDK for LINE Messaging API homepage:            https://github.com/moleike/line-bot-sdk#readme bug-reports:         https://github.com/moleike/line-bot-sdk/issues@@ -30,9 +30,9 @@   exposed-modules:     Line.Bot.Webhook                      , Line.Bot.Webhook.Events                      , Line.Bot.Client-                     , Line.Bot.Client.Auth                      , Line.Bot.Types-                     , Line.Bot.Endpoints+                     , Line.Bot.Internal.Auth+                     , Line.Bot.Internal.Endpoints    build-depends:       base                 >= 4.7 && < 5                      , aeson                >= 1.4.2 && < 1.5@@ -101,6 +101,8 @@                      , servant-client-core >= 0.15                      , wai                      , warp+                     , free+                     , time    ghc-options:         -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010 

@@ -5,7 +5,6 @@ {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UndecidableInstances  #-} -- | -- Module      : Line.Bot.Client -- Copyright   : (c) Alexandre Moreno, 2019@@ -42,16 +41,16 @@   ) where -import           Control.Monad.Trans.Class  (lift)-import           Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)-import           Data.ByteString.Lazy       (ByteString)+import           Control.Monad.Trans.Class   (lift)+import           Control.Monad.Trans.Reader  (ReaderT, ask, runReaderT)+import           Data.ByteString.Lazy        (ByteString) import           Data.Proxy-import           Data.Time.Calendar         (Day)-import           Line.Bot.Client.Auth-import           Line.Bot.Endpoints+import           Data.Time.Calendar          (Day)+import           Line.Bot.Internal.Auth+import           Line.Bot.Internal.Endpoints import           Line.Bot.Types-import           Network.HTTP.Client        (newManager)-import           Network.HTTP.Client.TLS    (tlsManagerSettings)+import           Network.HTTP.Client         (newManager)+import           Network.HTTP.Client.TLS     (tlsManagerSettings) import           Servant.API import           Servant.Client @@ -60,7 +59,7 @@  -- | @Line@ is the monad in which bot requests run. Contains the -- OAuth access token for a channel-type Line = ReaderT ChannelToken ClientM+type Line = ReaderT Auth ClientM  withLineEnv :: (ClientEnv -> IO a) -> IO a withLineEnv app = do@@ -73,106 +72,81 @@  -- | Runs a @Line@ computation with the given channel access token runLine :: Line a -> ChannelToken -> IO (Either ServantError a)-runLine comp token = runLine' $ runReaderT comp token--getProfile' :: Auth -> Id User -> ClientM Profile--getGroupMemberProfile' :: Auth -> Id Group -> Id User -> ClientM Profile--leaveGroup' :: Auth -> Id Group -> ClientM NoContent--getRoomMemberProfile' :: Auth -> Id Room -> Id User -> ClientM Profile--leaveRoom' :: Auth -> Id Room -> ClientM NoContent--replyMessage' :: Auth -> ReplyMessageBody -> ClientM NoContent--pushMessage' :: Auth -> PushMessageBody -> ClientM NoContent--multicastMessage' :: Auth -> MulticastMessageBody -> ClientM NoContent--getContent' :: Auth -> MessageId -> ClientM ByteString--getPushMessageCount' :: Auth -> LineDate -> ClientM MessageCount--getReplyMessageCount' :: Auth -> LineDate -> ClientM MessageCount--getMulticastMessageCount' :: Auth -> LineDate -> ClientM MessageCount--issueLinkToken' :: Auth -> Id User -> ClientM LinkToken--issueChannelToken' :: ClientCredentials -> ClientM ShortLivedChannelToken--revokeChannelToken' :: ChannelToken -> ClientM NoContent--getProfile'-  :<|> getGroupMemberProfile'-  :<|> leaveGroup'-  :<|> getRoomMemberProfile'-  :<|> leaveRoom'-  :<|> replyMessage'-  :<|> pushMessage'-  :<|> multicastMessage'-  :<|> getContent'-  :<|> getPushMessageCount'-  :<|> getReplyMessageCount'-  :<|> getMulticastMessageCount'-  :<|> issueLinkToken'-  :<|> issueChannelToken'-  :<|> revokeChannelToken' = client (Proxy :: Proxy Endpoints)+runLine comp = runLine' . runReaderT comp . mkAuth  getProfile :: Id User -> Line Profile-getProfile a = ask >>= \token -> lift $ getProfile' (mkAuth token) a+getProfile a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy GetProfile) auth a  getGroupMemberProfile :: Id Group -> Id User -> Line Profile-getGroupMemberProfile a b =-  ask >>= \token -> lift $ getGroupMemberProfile' (mkAuth token) a b+getGroupMemberProfile a b = ask >>= \auth ->+  lift $ client (Proxy :: Proxy GetGroupMemberProfile) auth a b  leaveGroup :: Id Group -> Line NoContent-leaveGroup a = ask >>= \token -> lift $ leaveGroup' (mkAuth token) a+leaveGroup a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy LeaveGroup) auth a  getRoomMemberProfile :: Id Room -> Id User -> Line Profile-getRoomMemberProfile a b =-  ask >>= \token -> lift $ getRoomMemberProfile' (mkAuth token) a b+getRoomMemberProfile a b = ask >>= \auth ->+  lift $ client (Proxy :: Proxy GetRoomMemberProfile) auth a b  leaveRoom :: Id Room -> Line NoContent-leaveRoom a = ask >>= \token -> lift $ leaveRoom' (mkAuth token) a+leaveRoom a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy LeaveRoom) auth a +replyMessage' :: ReplyMessageBody -> Line NoContent+replyMessage' a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy ReplyMessage) auth a+ replyMessage :: ReplyToken -> [Message] -> Line NoContent-replyMessage a ms = ask >>= \token -> lift $ replyMessage' (mkAuth token) body-  where body = ReplyMessageBody a ms+replyMessage a ms = replyMessage' (ReplyMessageBody a ms) +pushMessage' :: PushMessageBody -> Line NoContent+pushMessage' a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy PushMessage) auth a+ pushMessage :: Id a -> [Message] -> Line NoContent-pushMessage a ms = ask >>= \token -> lift $ pushMessage' (mkAuth token) body-  where body = PushMessageBody a ms+pushMessage a ms = pushMessage' (PushMessageBody a ms) +multicastMessage' :: MulticastMessageBody -> Line NoContent+multicastMessage' a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy MulticastMessage) auth a+ multicastMessage :: [Id User] -> [Message] -> Line NoContent-multicastMessage a ms = ask-  >>= \token -> lift $ multicastMessage' (mkAuth token) body-  where body = MulticastMessageBody a ms+multicastMessage a ms = multicastMessage' (MulticastMessageBody a ms)  -- | TODO: this should use a streaming library for constant memory usage over large data getContent :: MessageId -> Line ByteString-getContent a = ask >>= \token -> lift $ getContent' (mkAuth token) a+getContent a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy GetContent) auth a -getPushMessageCount :: Day -> Line MessageCount-getPushMessageCount a =-  ask >>= \token -> lift $ getPushMessageCount' (mkAuth token) (LineDate a)+getPushMessageCount' :: LineDate -> Line MessageCount+getPushMessageCount' a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy GetPushMessageCount) auth a -getReplyMessageCount :: Day -> Line MessageCount-getReplyMessageCount a =-  ask >>= \token -> lift $ getReplyMessageCount' (mkAuth token) (LineDate a)+getPushMessageCount :: Day -> Line (Maybe Int)+getPushMessageCount = fmap count . getPushMessageCount' . LineDate -getMulticastMessageCount :: Day -> Line MessageCount-getMulticastMessageCount a =-  ask >>= \token -> lift $ getMulticastMessageCount' (mkAuth token) (LineDate a)+getReplyMessageCount' :: LineDate -> Line MessageCount+getReplyMessageCount' a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy GetReplyMessageCount) auth a +getReplyMessageCount :: Day -> Line (Maybe Int)+getReplyMessageCount = fmap count . getReplyMessageCount' . LineDate++getMulticastMessageCount' :: LineDate -> Line MessageCount+getMulticastMessageCount' a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy GetMulticastMessageCount) auth a++getMulticastMessageCount :: Day -> Line (Maybe Int)+getMulticastMessageCount = fmap count . getMulticastMessageCount' . LineDate+ issueLinkToken :: Id User -> Line LinkToken-issueLinkToken a = ask >>= \token -> lift $ issueLinkToken' (mkAuth token) a+issueLinkToken a = ask >>= \auth ->+  lift $ client (Proxy :: Proxy IssueLinkToken) auth a -issueChannelToken :: ChannelId -> ChannelSecret -> ClientM ShortLivedChannelToken-issueChannelToken a b = issueChannelToken' $ ClientCredentials a b+issueChannelToken :: ClientCredentials -> ClientM ShortLivedChannelToken+issueChannelToken = client (Proxy :: Proxy IssueChannelToken)  revokeChannelToken :: ChannelToken -> ClientM NoContent-revokeChannelToken = revokeChannelToken'-+revokeChannelToken = client (Proxy :: Proxy RevokeChannelToken)

@@ -1,29 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--- |--- Module      : Line.Bot.Client.Auth--- Copyright   : (c) Alexandre Moreno, 2019--- License     : BSD3--- Maintainer  : alexmorenocano@gmail.com--- Stability   : experimental--module Line.Bot.Client.Auth where--import           Line.Bot.Endpoints                   (ChannelAuth)-import           Line.Bot.Types                       (ChannelToken)-import           Network.HTTP.Types                   (hAuthorization)-import           Servant.API                          (AuthProtect)-import           Servant.Client.Core.Internal.Auth    (AuthClientData,-                                                       AuthenticatedRequest,-                                                       mkAuthenticatedRequest)-import           Servant.Client.Core.Internal.Request (Request, addHeader)---type instance AuthClientData ChannelAuth = ChannelToken--type Auth = AuthenticatedRequest ChannelAuth--mkAuth :: ChannelToken -> Auth-mkAuth token = mkAuthenticatedRequest token addAuthorizationHeader- where-  addAuthorizationHeader :: ChannelToken -> Request -> Request-  addAuthorizationHeader = addHeader hAuthorization

@@ -1,137 +0,0 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UndecidableInstances  #-}--- |--- Module      : Line.Bot.Endpoints--- Copyright   : (c) Alexandre Moreno, 2019--- License     : BSD3--- Maintainer  : alexmorenocano@gmail.com--- Stability   : experimental--module Line.Bot.Endpoints where--import           Data.ByteString.Lazy (ByteString)-import           Line.Bot.Types-import           Servant.API-import           Servant.Client---- | Combinator for authenticating with the channel access token-type ChannelAuth = AuthProtect "channel-access-token"--type GetProfile = ChannelAuth-  :> "profile"-  :> Capture "userId" (Id User)-  :> Get '[JSON] Profile--type GetGroupMemberProfile = ChannelAuth-  :> "group"-  :> Capture "groupId" (Id Group)-  :> "member"-  :> Capture "userId" (Id User)-  :> Get '[JSON] Profile--type LeaveGroup = ChannelAuth-  :> "group"-  :> Capture "groupId" (Id Group)-  :> "leave"-  :> PostNoContent '[JSON] NoContent--type GetRoomMemberProfile = ChannelAuth-  :> "room"-  :> Capture "roomId" (Id Room)-  :> "member"-  :> Capture "userId" (Id User)-  :> Get '[JSON] Profile--type LeaveRoom = ChannelAuth-  :> "room"-  :> Capture "roomId" (Id Room)-  :> "leave"-  :> PostNoContent '[JSON] NoContent--type ReplyMessage = ChannelAuth-  :> ReqBody '[JSON] ReplyMessageBody-  :> "message"-  :> "reply"-  :> PostNoContent '[JSON] NoContent--type PushMessage = ChannelAuth-  :> ReqBody '[JSON] PushMessageBody-  :> "message"-  :> "push"-  :> PostNoContent '[JSON] NoContent--type MulticastMessage = ChannelAuth-  :> ReqBody '[JSON] MulticastMessageBody-  :> "message"-  :> "multicast"-  :> PostNoContent '[JSON] NoContent--type GetContent = ChannelAuth-  :> "message"-  :> Capture "messageId" MessageId-  :> "content"-  :> Get '[OctetStream] ByteString--type GetReplyMessageCount = ChannelAuth-  :> "message"-  :> "delivery"-  :> "reply"-  :> QueryParam' '[Required, Strict] "date" LineDate-  :> Get '[JSON] MessageCount--type GetPushMessageCount = ChannelAuth-  :> "message"-  :> "delivery"-  :> "push"-  :> QueryParam' '[Required, Strict] "date" LineDate-  :> Get '[JSON] MessageCount--type GetMulticastMessageCount = ChannelAuth-  :> "message"-  :> "delivery"-  :> "multicast"-  :> QueryParam' '[Required, Strict] "date" LineDate-  :> Get '[JSON] MessageCount--type IssueLinkToken = ChannelAuth-  :> "user"-  :> Capture "userId" (Id User)-  :> "linkToken"-  :> Get '[JSON] LinkToken--type IssueChannelToken =-  ReqBody '[FormUrlEncoded] ClientCredentials-  :> "oauth"-  :> "accessToken"-  :> Post '[JSON] ShortLivedChannelToken--type RevokeChannelToken =-  ReqBody '[FormUrlEncoded] ChannelToken-  :> "oauth"-  :> "revoke"-  :> PostNoContent '[JSON] NoContent--type Endpoints = "v2" :> "bot" :>-  (    GetProfile-  :<|> GetGroupMemberProfile-  :<|> LeaveGroup-  :<|> GetRoomMemberProfile-  :<|> LeaveRoom-  :<|> ReplyMessage-  :<|> PushMessage-  :<|> MulticastMessage-  :<|> GetContent-  :<|> GetReplyMessageCount-  :<|> GetPushMessageCount-  :<|> GetMulticastMessageCount-  :<|> IssueLinkToken-  :<|> IssueChannelToken-  :<|> RevokeChannelToken-  )

@@ -0,0 +1,25 @@+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module      : Line.Bot.Internal.Auth+-- Copyright   : (c) Alexandre Moreno, 2019+-- License     : BSD3+-- Maintainer  : alexmorenocano@gmail.com+-- Stability   : experimental++module Line.Bot.Internal.Auth where++import           Line.Bot.Internal.Endpoints          (ChannelAuth)+import           Line.Bot.Types                       (ChannelToken)+import           Network.HTTP.Types                   (hAuthorization)+import           Servant.API                          (AuthProtect)+import           Servant.Client.Core.Internal.Auth    (AuthClientData,+                                                       AuthenticatedRequest,+                                                       mkAuthenticatedRequest)+import           Servant.Client.Core.Internal.Request (Request, addHeader)++type instance AuthClientData ChannelAuth = ChannelToken++type Auth = AuthenticatedRequest ChannelAuth++mkAuth :: ChannelToken -> Auth+mkAuth token = mkAuthenticatedRequest token (addHeader hAuthorization)

@@ -0,0 +1,164 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-}+-- |+-- Module      : Line.Bot.Internal.Endpoints+-- Copyright   : (c) Alexandre Moreno, 2019+-- License     : BSD3+-- Maintainer  : alexmorenocano@gmail.com+-- Stability   : experimental++module Line.Bot.Internal.Endpoints where++import           Data.ByteString.Lazy (ByteString)+import           Line.Bot.Types+import           Servant.API+import           Servant.Client++-- | Combinator for authenticating with the channel access token+type ChannelAuth = AuthProtect "channel-access-token"++type GetProfile' a = ChannelAuth+  :> "v2" :> "bot"+  :> "profile"+  :> Capture "userId" (Id User)+  :> Get '[JSON] a++type GetProfile = GetProfile' Profile++type GetGroupMemberProfile' a = ChannelAuth+  :> "v2" :> "bot"+  :> "group"+  :> Capture "groupId" (Id Group)+  :> "member"+  :> Capture "userId" (Id User)+  :> Get '[JSON] a++type GetGroupMemberProfile = GetGroupMemberProfile' Profile++type LeaveGroup = ChannelAuth+  :> "v2" :> "bot"+  :> "group"+  :> Capture "groupId" (Id Group)+  :> "leave"+  :> PostNoContent '[JSON] NoContent++type GetRoomMemberProfile' a = ChannelAuth+  :> "v2" :> "bot"+  :> "room"+  :> Capture "roomId" (Id Room)+  :> "member"+  :> Capture "userId" (Id User)+  :> Get '[JSON] a++type GetRoomMemberProfile = GetRoomMemberProfile' Profile++type LeaveRoom = ChannelAuth+  :> "v2" :> "bot"+  :> "room"+  :> Capture "roomId" (Id Room)+  :> "leave"+  :> PostNoContent '[JSON] NoContent++type ReplyMessage' a = ChannelAuth+  :> "v2" :> "bot"+  :> "message"+  :> "reply"+  :> ReqBody '[JSON] a+  :> PostNoContent '[JSON] NoContent++type ReplyMessage = ReplyMessage' ReplyMessageBody++type PushMessage' a = ChannelAuth+  :> "v2" :> "bot"+  :> "message"+  :> "push"+  :> ReqBody '[JSON] a+  :> PostNoContent '[JSON] NoContent++type PushMessage = PushMessage' PushMessageBody++type MulticastMessage' a = ChannelAuth+  :> "v2" :> "bot"+  :> "message"+  :> "multicast"+  :> ReqBody '[JSON] a+  :> PostNoContent '[JSON] NoContent++type MulticastMessage = MulticastMessage' MulticastMessageBody++type GetContent = ChannelAuth+  :> "v2" :> "bot"+  :> "message"+  :> Capture "messageId" MessageId+  :> "content"+  :> Get '[OctetStream] ByteString++type GetContentStream = ChannelAuth+  :> "v2" :> "bot"+  :> "message"+  :> Capture "messageId" MessageId+  :> "content"+  :> StreamGet NoFraming OctetStream (SourceIO ByteString)++type GetReplyMessageCount' a b = ChannelAuth+  :> "v2" :> "bot"+  :> "message"+  :> "delivery"+  :> "reply"+  :> QueryParam' '[Required, Strict] "date" a+  :> Get '[JSON] b++type GetReplyMessageCount = GetReplyMessageCount' LineDate MessageCount++type GetPushMessageCount' a b = ChannelAuth+  :> "v2" :> "bot"+  :> "message"+  :> "delivery"+  :> "push"+  :> QueryParam' '[Required, Strict] "date" a+  :> Get '[JSON] b++type GetPushMessageCount = GetPushMessageCount' LineDate MessageCount++type GetMulticastMessageCount' a b = ChannelAuth+  :> "v2" :> "bot"+  :> "message"+  :> "delivery"+  :> "multicast"+  :> QueryParam' '[Required, Strict] "date" a+  :> Get '[JSON] b++type GetMulticastMessageCount = GetMulticastMessageCount' LineDate MessageCount++type IssueLinkToken' a = ChannelAuth+  :> "v2" :> "bot"+  :> "user"+  :> Capture "userId" (Id User)+  :> "linkToken"+  :> Get '[JSON] a++type IssueLinkToken = IssueLinkToken' LinkToken++type IssueChannelToken' a b =+  ReqBody '[FormUrlEncoded] a+  :> "v2" :> "bot"+  :> "oauth"+  :> "accessToken"+  :> Post '[JSON] b++type IssueChannelToken = IssueChannelToken' ClientCredentials ShortLivedChannelToken++type RevokeChannelToken' a =+  ReqBody '[FormUrlEncoded] a+  :> "v2" :> "bot"+  :> "oauth"+  :> "revoke"+  :> PostNoContent '[JSON] NoContent++type RevokeChannelToken = RevokeChannelToken' ChannelToken

@@ -115,6 +115,15 @@ instance ToJSON (Id a) where   toJSON = String . toQueryParam +instance FromHttpApiData (Id User) where+  parseUrlPiece = pure . UserId++instance FromHttpApiData (Id Group) where+  parseUrlPiece = pure . GroupId++instance FromHttpApiData (Id Room) where+  parseUrlPiece = pure . RoomId+ instance IsString (Id User) where   fromString s = UserId (fromString s) @@ -198,7 +207,7 @@ instance ToJSON ReplyToken instance FromJSON ReplyToken -data LinkToken = LinkToken { linkToken :: Text }+newtype LinkToken = LinkToken { linkToken :: Text }   deriving (Eq, Show, Generic)  instance FromJSON LinkToken@@ -216,10 +225,10 @@   , messages :: [Message]   } -deriving instance Show (PushMessageBody)+deriving instance Show PushMessageBody  instance ToJSON PushMessageBody where-  toJSON (PushMessageBody {..}) = object+  toJSON PushMessageBody {..} = object     [ "to"       .= to     , "messages" .= messages     ]@@ -314,12 +323,12 @@   toQueryParam = T.pack . show  data MessageCount = MessageCount-  { count  :: Int+  { count  :: Maybe Int   , status :: String   } deriving (Eq, Show)  instance FromJSON MessageCount where   parseJSON = withObject "MessageCount" $ \o -> do-    count  <- o .:  "success"+    count  <- o .:? "success"     status <- o .:  "status"-    return $ MessageCount{..}+    return MessageCount{..}

@@ -8,7 +8,6 @@ {-# LANGUAGE PolyKinds             #-} {-# LANGUAGE RankNTypes            #-} {-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TupleSections         #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE TypeOperators         #-} {-# LANGUAGE UndecidableInstances  #-}@@ -77,7 +76,7 @@         let signatureH = lookup hSignature $ requestHeaders request          if validateReqBody signatureH rawBody-          then case (f rawBody) of+          then case f rawBody of              Left e  -> delayedFailFatal err400 { errBody = cs e }              Right v -> return v           else delayedFailFatal err401@@ -89,7 +88,7 @@       hSignature = "X-Line-Signature"        validateReqBody :: Maybe B.ByteString -> BL.ByteString -> Bool-      validateReqBody digest body = maybe False (== SHA256.hmaclazy secret body) digest'+      validateReqBody digest body = digest' == Just (SHA256.hmaclazy secret body)         where           digest' = Base64.decodeLenient <$> digest           secret  = unChannelSecret channelSecret

@@ -7,7 +7,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE StandaloneDeriving         #-} -- | -- Module      : Line.Bot.Webhook.Events -- Copyright   : (c) Alexandre Moreno, 2019@@ -41,7 +40,7 @@ import           Data.Maybe import           Data.Scientific import           Data.String-import           Data.Text             as T hiding (drop, stripPrefix, toLower)+import           Data.Text             as T hiding (drop, toLower) import           Data.Time             (LocalTime, UTCTime) import           Data.Time.Calendar    (Day) import           Data.Time.Clock.POSIX@@ -205,7 +204,7 @@       _       -> fail ("unknown source: " ++ messageType)  -data Members = Members { members :: [Source] }+newtype Members = Members { members :: [Source] }   deriving (Eq, Show, Generic)  instance FromJSON Members@@ -217,13 +216,12 @@   deriving (Eq, Show)  instance FromJSON PostbackDateTime where-  parseJSON = withObject "PostbackDateTime" $ \o -> do-    dateTime <- asum+  parseJSON = withObject "PostbackDateTime" $ \o ->+    asum       [ PostbackDay       <$> o .: "date"       , PostbackLocalTime <$> o .: "datetime"       , PostbackTimeOfDay <$> o .: "time"       ]-    return dateTime  data Postback = Postback Text PostbackDateTime   deriving (Eq, Show)@@ -255,7 +253,7 @@     hwid      <- o .:  "hwid"     eventType <- o .:  "type"     dm        <- o .:? "dm"-    return $ Beacon{..}+    return Beacon{..}  data AccountLinkResult = Ok | Failed  deriving (Eq, Show, Generic)@@ -293,4 +291,4 @@   parseJSON = withObject "Things" $ \o -> do     deviceId  <- o .: "deviceId"     eventType <- o .: "type"-    return $ Things{..}+    return Things{..}

@@ -2,30 +2,37 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE TypeFamilies      #-} {-# LANGUAGE TypeOperators     #-}  module Line.Bot.ClientSpec (spec) where  import           Control.Arrow                    (left)+import           Control.Monad                    ((>=>))+import           Control.Monad.Free import           Control.Monad.Trans.Reader       (runReaderT) import           Data.Aeson                       (Value) import           Data.Aeson.QQ import           Data.ByteString                  as B (stripPrefix)+import           Data.Foldable                    (toList) import           Data.Text import           Data.Text.Encoding+import           Data.Time.Calendar               (fromGregorian) import           Line.Bot.Client                  hiding (runLine)-import           Line.Bot.Client.Auth-import           Line.Bot.Endpoints               (ChannelAuth)+import           Line.Bot.Internal.Auth+import           Line.Bot.Internal.Endpoints import           Line.Bot.Types import           Network.HTTP.Client              (defaultManagerSettings,                                                    newManager) import           Network.HTTP.Types               (hAuthorization)-import           Network.Wai                      (Request, requestHeaders)+import           Network.Wai                      as Wai (Request,+                                                          requestHeaders) import           Network.Wai.Handler.Warp         (Port, withApplication) import           Servant import           Servant.Client-import           Servant.Client.Core.Reexport+import           Servant.Client.Core+import           Servant.Client.Free as F import           Servant.Server                   (Context (..)) import           Servant.Server.Experimental.Auth (AuthHandler, AuthServerData,                                                    mkAuthHandler)@@ -36,18 +43,18 @@ type instance AuthServerData ChannelAuth = ChannelToken  -- a dummy auth handler that returns the channel access token-authHandler :: AuthHandler Request ChannelToken-authHandler = mkAuthHandler $ \request -> do-  case lookup hAuthorization (requestHeaders request) >>= B.stripPrefix "Bearer " of+authHandler :: AuthHandler Wai.Request ChannelToken+authHandler = mkAuthHandler $ \request ->+  case lookup hAuthorization (Wai.requestHeaders request) >>= B.stripPrefix "Bearer " of     Nothing -> throwError $ err401 { errBody = "Bad" }     Just t  -> return $ ChannelToken $ decodeUtf8 t -serverContext :: Context '[AuthHandler Request ChannelToken]+serverContext :: Context '[AuthHandler Wai.Request ChannelToken] serverContext = authHandler :. EmptyContext -type API =-       ChannelAuth :> "v2" :> "bot" :> "profile" :> "1" :> Get '[JSON] Value-  :<|> ChannelAuth :> "v2" :> "bot" :> "group" :> "1" :> "member" :> "1" :> Get '[JSON] Value+type API = GetProfile' Value+      :<|> GetGroupMemberProfile' Value+      :<|> GetRoomMemberProfile' Value  testProfile :: Value testProfile = [aesonQQ|@@ -65,19 +72,46 @@   app $ mkClientEnv manager $ BaseUrl Http "localhost" port ""  runLine :: Line a -> Port -> IO (Either ServantError a)-runLine comp port = withPort port $ runClientM $ runReaderT comp "fake"+runLine comp port = withPort port $ runClientM $ runReaderT comp (mkAuth "fake") +getReplyMessageCountF :: Auth -> LineDate -> Free ClientF MessageCount+getReplyMessageCountF = F.client (Proxy :: Proxy GetReplyMessageCount)++getPushMessageCountF :: Auth -> LineDate -> Free ClientF MessageCount+getPushMessageCountF = F.client (Proxy :: Proxy GetPushMessageCount)++getMulticastMessageCountF :: Auth -> LineDate -> Free ClientF MessageCount+getMulticastMessageCountF = F.client (Proxy :: Proxy GetMulticastMessageCount)+ app :: Application app = serveWithContext (Proxy :: Proxy API) serverContext $-       (\_ -> return testProfile)-  :<|> (\_ -> return testProfile)+       (\_ _ -> return testProfile)+  :<|> (\_ _ _ -> return testProfile)+  :<|> (\_ _ _ -> return testProfile)  spec :: Spec spec = describe "Line client" $ do-  it "should return user profile" $ do-    withApplication (pure app) $ \port -> do-      runLine (getProfile "1") port >>= \x -> x `shouldSatisfy` isRight+  it "should return user profile" $+    withApplication (pure app) $+      runLine (getProfile "1") >=> (`shouldSatisfy` isRight) -  it "should return group user profile" $ do-    withApplication (pure app) $ \port -> do-      runLine (getGroupMemberProfile "1" "1") port >>= \x -> x `shouldSatisfy` isRight+  it "should return group user profile" $+    withApplication (pure app) $+      runLine (getGroupMemberProfile "1" "1") >=> (`shouldSatisfy` isRight)++  it "should return room user profile" $+    withApplication (pure app) $+      runLine (getRoomMemberProfile "1" "1") >=> (`shouldSatisfy` isRight)++  it "should send `date` query param for push message count" $ do+    let Free (RunRequest Request{..} _) = getPushMessageCountF (mkAuth "fake") (LineDate $ fromGregorian 2019 4 7)+    toList requestQueryString `shouldBe` [("date", Just "20190407")]++  it "should send `date` query param for reply message count" $ do+    let Free (RunRequest Request{..} _) = getReplyMessageCountF (mkAuth "fake") (LineDate $ fromGregorian 2019 4 7)+    toList requestQueryString `shouldBe` [("date", Just "20190407")]++  it "should send `date` query param for multicast message count" $ do+    let Free (RunRequest Request{..} _) = getMulticastMessageCountF (mkAuth "fake") (LineDate $ fromGregorian 2019 4 7)+    toList requestQueryString `shouldBe` [("date", Just "20190407")]+

@@ -58,7 +58,7 @@ |]  spec :: Spec-spec = with (pure app) $ do+spec = with (pure app) $   describe "Webhook server" $ do      it "should return 200 with a signed request" $ do