line-bot-sdk 0.5.2 → 0.6.0
raw patch · 9 files changed
+131/−177 lines, 9 filesdep ~http-client-tlsdep ~timedep ~warp
Dependency ranges changed: http-client-tls, time, warp
Files
- README.md +4/−3
- line-bot-sdk.cabal +7/−4
- src/Line/Bot/Client.hs +61/−42
- src/Line/Bot/Internal/Auth.hs +0/−25
- src/Line/Bot/Internal/Endpoints.hs +10/−38
- src/Line/Bot/Types.hs +21/−27
- src/Line/Bot/Webhook.hs +2/−4
- src/Line/Bot/Webhook/Events.hs +8/−13
- test/Line/Bot/ClientSpec.hs +18/−21
README.md view
@@ -6,7 +6,7 @@ * 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+* Bindings for (most of) the Messaging APIs ## Installation @@ -34,9 +34,10 @@ ## Documentation -The documentation for the latest release is available on [Hackage][hackage]. +See the official API documentation for more information. -[hackage]: http://hackage.haskell.org/package/line-bot-sdk "Hackage"+- English: https://developers.line.biz/en/docs/messaging-api/overview/+- Japanese: https://developers.line.biz/ja/docs/messaging-api/overview/ ## Usage
line-bot-sdk.cabal view
@@ -1,5 +1,5 @@ name: line-bot-sdk-version: 0.5.2+version: 0.6.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@@ -31,16 +31,18 @@ , Line.Bot.Webhook.Events , Line.Bot.Client , Line.Bot.Types- , Line.Bot.Internal.Auth , Line.Bot.Internal.Endpoints + other-modules: Paths_line_bot_sdk+ autogen-modules: Paths_line_bot_sdk+ build-depends: base >= 4.7 && < 5 , aeson >= 1.4.2 && < 1.5 , bytestring >= 0.10.8 && < 0.11 , scientific >= 0.3.6 && < 0.4 , text >= 1.2.3 && < 1.3 , transformers >= 0.5.5 && < 0.6- , time >= 1.8.0 && < 1.9+ , time >= 1.9.3 && < 1.10 , base64-bytestring >= 1.0.0 && < 1.1 , cryptohash-sha256 >= 0.11.101 && < 0.12 , http-client >= 0.5.14 && < 0.7@@ -71,7 +73,7 @@ , transformers >= 0.5.5 && < 0.6 , wai >= 3.2.2 && < 3.3 , wai-extra >= 3.0.25 && < 3.1- , warp >= 3.2.26 && < 3.3+ , warp >= 3.3.12 && < 3.4 default-language: Haskell2010 @@ -92,6 +94,7 @@ , hspec-expectations , http-types , http-client+ , http-client-tls , aeson , transformers , aeson-qq
src/Line/Bot/Client.hs view
@@ -60,23 +60,22 @@ where import Control.DeepSeq (NFData)-import Control.Monad.IO.Class import Control.Monad.Reader-import Control.Monad.Trans.Class (lift) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LB import Data.Functor-import Data.Maybe-import Data.Monoid import Data.Proxy import Data.Time.Calendar (Day)-import Line.Bot.Internal.Auth (Auth, mkAuth)+import Data.Text (Text, pack)+import GHC.TypeLits (Symbol) import Line.Bot.Internal.Endpoints import Line.Bot.Types import Network.HTTP.Client (newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) import Servant.API import Servant.Client.Streaming+import Paths_line_bot_sdk (version)+import Data.Version (showVersion) defaultEndpoint :: BaseUrl defaultEndpoint = BaseUrl Https "api.line.me" 443 ""@@ -84,6 +83,9 @@ blobEndpoint :: BaseUrl blobEndpoint = BaseUrl Https "api-data.line.me" 443 "" +userAgent :: Text+userAgent = "line-bot-sdk-haskell/" <> pack (showVersion version)+ -- | @Line@ is the monad in which bot requests run. Contains the -- OAuth access token for a channel type Line = ReaderT ChannelToken ClientM@@ -110,64 +112,81 @@ withLine :: Line a -> ChannelToken -> (Either ClientError a -> IO b) -> IO b withLine comp = withLine' . runReaderT comp -withHost :: MonadReader ClientEnv m => BaseUrl -> m a -> m a-withHost baseUrl = local (\env -> env { baseUrl = baseUrl })+withHost :: BaseUrl -> Line a -> Line a+withHost baseUrl = mapReaderT $ local (\env -> env { baseUrl = baseUrl }) -type LineAuth a = Auth -> ClientM a+type family AddHeaders a :: * where+ AddHeaders ((sym :: Symbol) :> last)+ = (sym :: Symbol) :> AddHeaders last+ AddHeaders (first :> last)+ = first :> AddHeaders last+ AddHeaders last+ = Header' '[Required, Strict] "Authorization" ChannelToken+ :> Header' '[Required, Strict] "User-Agent" Text+ :> last+ +type ClientWithHeaders a = ChannelToken -> Text -> ClientM a -type family AddLineAuth a :: * where- AddLineAuth (LineAuth a) = Line a- AddLineAuth (a -> b) = a -> AddLineAuth b+type family EmbedLine a :: * where+ EmbedLine (ClientWithHeaders a) = Line a+ EmbedLine (a -> b) = a -> EmbedLine b class HasLine a where- addLineAuth :: a -> AddLineAuth a+ embedLine :: a -> EmbedLine a -instance HasLine (LineAuth a) where- addLineAuth comp = ask >>= lift . comp . mkAuth+instance HasLine (ClientWithHeaders a) where+ embedLine comp = do+ token <- ask+ lift $ comp token userAgent -instance HasLine (a -> LineAuth b) where- addLineAuth comp = addLineAuth . comp+instance HasLine (a -> ClientWithHeaders b) where+ embedLine comp = embedLine . comp -instance HasLine (a -> b -> LineAuth c) where- addLineAuth comp = addLineAuth . comp+instance HasLine (a -> b -> ClientWithHeaders c) where+ embedLine comp = embedLine . comp -line :: (HasLine (Client ClientM api), HasClient ClientM api)+line :: (HasLine (Client ClientM (AddHeaders api)), HasClient ClientM (AddHeaders api)) => Proxy api- -> AddLineAuth (Client ClientM api)-line = addLineAuth . client+ -> EmbedLine (Client ClientM (AddHeaders api))+line = embedLine . clientWithHeaders -unfoldMemberUserIds :: (Maybe String -> Line MemberIds) -> Line [Id User]+clientWithHeaders :: (HasClient ClientM (AddHeaders api))+ => Proxy api+ -> Client ClientM (AddHeaders api)+clientWithHeaders (Proxy :: Proxy api) = client (Proxy :: Proxy (AddHeaders api))++unfoldMemberUserIds :: (Maybe String -> Line MemberIds) -> Line [Id 'User] unfoldMemberUserIds k = go Nothing where go tok = do MemberIds{next, memberIds = a} <- k tok as <- maybe (return []) (\_ -> go next) next return $ a ++ as -getProfile :: Id User -> Line Profile+getProfile :: Id 'User -> Line Profile getProfile = line (Proxy @GetProfile) -getGroupMemberProfile :: Id Group -> Id User -> Line Profile+getGroupMemberProfile :: Id 'Group -> Id 'User -> Line Profile getGroupMemberProfile = line (Proxy @GetGroupMemberProfile) -leaveGroup :: Id Group -> Line NoContent+leaveGroup :: Id 'Group -> Line NoContent leaveGroup = line (Proxy @LeaveGroup) -getGroupMemberUserIds' :: Id Group -> Maybe String -> Line MemberIds+getGroupMemberUserIds' :: Id 'Group -> Maybe String -> Line MemberIds getGroupMemberUserIds' = line (Proxy @GetGroupMemberUserIds) -getGroupMemberUserIds :: Id Group -> Line [Id User]+getGroupMemberUserIds :: Id 'Group -> Line [Id 'User] getGroupMemberUserIds = unfoldMemberUserIds . getGroupMemberUserIds' -getRoomMemberProfile :: Id Room -> Id User -> Line Profile+getRoomMemberProfile :: Id 'Room -> Id 'User -> Line Profile getRoomMemberProfile = line (Proxy @GetRoomMemberProfile) -leaveRoom :: Id Room -> Line NoContent+leaveRoom :: Id 'Room -> Line NoContent leaveRoom = line (Proxy @LeaveRoom) -getRoomMemberUserIds' :: Id Room -> Maybe String -> Line MemberIds+getRoomMemberUserIds' :: Id 'Room -> Maybe String -> Line MemberIds getRoomMemberUserIds' = line (Proxy @GetRoomMemberUserIds) -getRoomMemberUserIds :: Id Room -> Line [Id User]+getRoomMemberUserIds :: Id 'Room -> Line [Id 'User] getRoomMemberUserIds = unfoldMemberUserIds . getRoomMemberUserIds' replyMessage' :: ReplyMessageBody -> Line NoContent@@ -185,7 +204,7 @@ multicastMessage' :: MulticastMessageBody -> Line NoContent multicastMessage' = line (Proxy @MulticastMessage) -multicastMessage :: [Id User] -> [Message] -> Line NoContent+multicastMessage :: [Id 'User] -> [Message] -> Line NoContent multicastMessage a ms = multicastMessage' (MulticastMessageBody a ms) broadcastMessage' :: BroadcastMessageBody -> Line NoContent@@ -194,14 +213,14 @@ broadcastMessage :: [Message] -> Line NoContent broadcastMessage = broadcastMessage' . BroadcastMessageBody -getContent' :: MessageId -> Auth -> ClientM LB.ByteString-getContent' = client (Proxy @GetContent)+getContent' :: MessageId -> Line LB.ByteString+getContent' = line (Proxy @GetContent) getContent :: MessageId -> Line LB.ByteString-getContent a = ask >>= lift . withHost blobEndpoint . getContent' a . mkAuth+getContent = withHost blobEndpoint . getContent' -getContentS' :: MessageId -> Auth -> ClientM (SourceIO ByteString)-getContentS' = client (Proxy @GetContentStream)+getContentS' :: MessageId -> Line (SourceIO ByteString)+getContentS' = line (Proxy @GetContentStream) -- | This is an streaming version of 'getContent' meant to be used with coroutine -- libraries like @pipes@, @conduits@, @streaming@, etc. You need and instance@@ -212,7 +231,7 @@ -- > getContentC :: MessageId -> Line (ConduitT () ByteString IO ()) -- > getContentC = fmap fromSourceIO . getContentS getContentS :: MessageId -> Line (SourceIO ByteString)-getContentS a = ask >>= lift . withHost blobEndpoint . getContentS' a . mkAuth+getContentS = withHost blobEndpoint . getContentS' getPushMessageCount' :: LineDate -> Line MessageCount getPushMessageCount' = line (Proxy @GetPushMessageCount)@@ -244,7 +263,7 @@ getMessageQuota :: Line Int getMessageQuota = fmap totalUsage getMessageQuota' -issueLinkToken :: Id User -> Line LinkToken+issueLinkToken :: Id 'User -> Line LinkToken issueLinkToken = line (Proxy @IssueLinkToken) issueChannelToken' :: ClientCredentials -> ClientM ShortLivedChannelToken@@ -265,11 +284,11 @@ getRichMenu :: RichMenuId -> Line RichMenu getRichMenu = fmap richMenu . getRichMenu' -uploadRichMenuImageJpg' :: RichMenuId -> ByteString -> Auth -> ClientM NoContent-uploadRichMenuImageJpg' = client (Proxy @UploadRichMenuImageJpg)+uploadRichMenuImageJpg' :: RichMenuId -> ByteString -> Line NoContent+uploadRichMenuImageJpg' = line (Proxy @UploadRichMenuImageJpg) uploadRichMenuImageJpg :: RichMenuId -> ByteString -> Line NoContent-uploadRichMenuImageJpg a b = ask >>= lift . withHost blobEndpoint . uploadRichMenuImageJpg' a b . mkAuth+uploadRichMenuImageJpg a = withHost blobEndpoint . uploadRichMenuImageJpg' a deleteRichMenu :: RichMenuId -> Line NoContent deleteRichMenu = line (Proxy @DeleteRichMenu)
− src/Line/Bot/Internal/Auth.hs
@@ -1,25 +0,0 @@-{-# 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.Auth (AuthClientData,- AuthenticatedRequest,- mkAuthenticatedRequest)-import Servant.Client.Core.Request (Request, addHeader)--type instance AuthClientData ChannelAuth = ChannelToken--type Auth = AuthenticatedRequest ChannelAuth--mkAuth :: ChannelToken -> Auth-mkAuth token = mkAuthenticatedRequest token (addHeader hAuthorization)
src/Line/Bot/Internal/Endpoints.hs view
@@ -19,71 +19,61 @@ import qualified Data.ByteString.Lazy as LB (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 = "v2":> "bot" :> "profile"- :> Capture "userId" (Id User)- :> ChannelAuth+ :> Capture "userId" (Id 'User) :> Get '[JSON] a type GetProfile = GetProfile' Profile type GetGroupMemberProfile' a = "v2":> "bot" :> "group"- :> Capture "groupId" (Id Group)+ :> Capture "groupId" (Id 'Group) :> "member"- :> Capture "userId" (Id User)- :> ChannelAuth+ :> Capture "userId" (Id 'User) :> Get '[JSON] a type GetGroupMemberProfile = GetGroupMemberProfile' Profile type LeaveGroup = "v2":> "bot" :> "group"- :> Capture "groupId" (Id Group)+ :> Capture "groupId" (Id 'Group) :> "leave"- :> ChannelAuth :> PostNoContent '[JSON] NoContent type GetGroupMemberUserIds' a = "v2":> "bot" :> "group"- :> Capture "groupId" (Id Group)+ :> Capture "groupId" (Id 'Group) :> "members" :> "ids" :> QueryParam "start" String- :> ChannelAuth :> Get '[JSON] a type GetGroupMemberUserIds = GetGroupMemberUserIds' MemberIds type GetRoomMemberProfile' a = "v2":> "bot" :> "room"- :> Capture "roomId" (Id Room)+ :> Capture "roomId" (Id 'Room) :> "member"- :> Capture "userId" (Id User)- :> ChannelAuth+ :> Capture "userId" (Id 'User) :> Get '[JSON] a type GetRoomMemberProfile = GetRoomMemberProfile' Profile type LeaveRoom = "v2":> "bot" :> "room"- :> Capture "roomId" (Id Room)+ :> Capture "roomId" (Id 'Room) :> "leave"- :> ChannelAuth :> PostNoContent '[JSON] NoContent type GetRoomMemberUserIds' a = "v2":> "bot" :> "room"- :> Capture "roomId" (Id Room)+ :> Capture "roomId" (Id 'Room) :> "members" :> "ids" :> QueryParam "start" String- :> ChannelAuth :> Get '[JSON] a type GetRoomMemberUserIds = GetRoomMemberUserIds' MemberIds@@ -92,7 +82,6 @@ "v2":> "bot" :> "message" :> "reply" :> ReqBody '[JSON] a- :> ChannelAuth :> PostNoContent '[JSON] NoContent type ReplyMessage = ReplyMessage' ReplyMessageBody@@ -101,7 +90,6 @@ "v2":> "bot" :> "message" :> "push" :> ReqBody '[JSON] a- :> ChannelAuth :> PostNoContent '[JSON] NoContent type PushMessage = PushMessage' PushMessageBody@@ -110,7 +98,6 @@ "v2":> "bot" :> "message" :> "multicast" :> ReqBody '[JSON] a- :> ChannelAuth :> PostNoContent '[JSON] NoContent type MulticastMessage = MulticastMessage' MulticastMessageBody@@ -119,7 +106,6 @@ "v2":> "bot" :> "message" :> "broadcast" :> ReqBody '[JSON] a- :> ChannelAuth :> PostNoContent '[JSON] NoContent type BroadcastMessage = BroadcastMessage' BroadcastMessageBody@@ -128,21 +114,18 @@ "v2":> "bot" :> "message" :> Capture "messageId" MessageId :> "content"- :> ChannelAuth :> Get '[OctetStream] LB.ByteString type GetContentStream = "v2":> "bot" :> "message" :> Capture "messageId" MessageId :> "content"- :> ChannelAuth :> StreamGet NoFraming OctetStream (SourceIO ByteString) type GetReplyMessageCount' a b = "v2":> "bot" :> "message" :> "delivery" :> "reply" :> QueryParam' '[Required, Strict] "date" a- :> ChannelAuth :> Get '[JSON] b type GetReplyMessageCount = GetReplyMessageCount' LineDate MessageCount@@ -151,7 +134,6 @@ "v2":> "bot" :> "message" :> "delivery" :> "push" :> QueryParam' '[Required, Strict] "date" a- :> ChannelAuth :> Get '[JSON] b type GetPushMessageCount = GetPushMessageCount' LineDate MessageCount@@ -160,7 +142,6 @@ "v2" :> "bot" :> "message" :> "delivery" :> "multicast" :> QueryParam' '[Required, Strict] "date" a- :> ChannelAuth :> Get '[JSON] b type GetMulticastMessageCount = GetMulticastMessageCount' LineDate MessageCount@@ -169,7 +150,6 @@ "v2" :> "bot" :> "message" :> "delivery" :> "broadcast" :> QueryParam' '[Required, Strict] "date" a- :> ChannelAuth :> Get '[JSON] b type GetBroadcastMessageCount = GetBroadcastMessageCount' LineDate MessageCount@@ -177,16 +157,14 @@ type GetMessageQuota' a = "v2":> "bot" :> "message" :> "quota" :> "consumption"- :> ChannelAuth :> Get '[JSON] a type GetMessageQuota = GetMessageQuota' MessageQuota type IssueLinkToken' a = "v2":> "bot" :> "user"- :> Capture "userId" (Id User)+ :> Capture "userId" (Id 'User) :> "linkToken"- :> ChannelAuth :> Get '[JSON] a type IssueLinkToken = IssueLinkToken' LinkToken@@ -210,7 +188,6 @@ type CreateRichMenu' a b = "v2" :> "bot" :> "richmenu" :> ReqBody '[JSON] a- :> ChannelAuth :> PostNoContent '[JSON] b type CreateRichMenu = CreateRichMenu' RichMenu RichMenuId@@ -218,7 +195,6 @@ type DeleteRichMenu' a = "v2" :> "bot" :> "richmenu" :> Capture "richMenuId" a- :> ChannelAuth :> Delete '[JSON] NoContent type DeleteRichMenu = DeleteRichMenu' RichMenuId@@ -226,7 +202,6 @@ type GetRichMenu' a b = "v2" :> "bot" :> "richmenu" :> Capture "richMenuId" a- :> ChannelAuth :> Get '[JSON] b type GetRichMenu = GetRichMenu' RichMenuId RichMenuResponse@@ -236,7 +211,6 @@ :> Capture "richMenuId" a :> "content" :> ReqBody '[JPEG] b- :> ChannelAuth :> Post '[JSON] NoContent type UploadRichMenuImageJpg = UploadRichMenuImageJpg' RichMenuId ByteString@@ -244,7 +218,6 @@ type GetRichMenuList' a = "v2" :> "bot" :> "richmenu" :> "list"- :> ChannelAuth :> Get '[JSON] a type GetRichMenuList = GetRichMenuList' RichMenuResponseList@@ -252,7 +225,6 @@ type SetDefaultRichMenu' a = "v2":> "bot" :> "user" :> "all" :> "richmenu" :> Capture "richMenuId" a- :> ChannelAuth :> PostNoContent '[JSON] NoContent type SetDefaultRichMenu = SetDefaultRichMenu' RichMenuId
src/Line/Bot/Types.hs view
@@ -62,28 +62,22 @@ import Control.Arrow ((>>>)) import Control.DeepSeq import Data.Aeson-import Data.Aeson.Types import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as LB import Data.Char (toLower) import Data.List as L (stripPrefix)-import Data.Maybe (fromJust)-import Data.Monoid ((<>)) import Data.String-import Data.Text as T hiding (drop, toLower)+import Data.Text as T hiding (count, drop, toLower) import Data.Text.Encoding import Data.Time.Calendar (Day) import Data.Time.Format import Data.Typeable import GHC.Generics hiding (to)-import Network.HTTP.Media (MediaType, (//))+import Network.HTTP.Media ((//)) import Servant.API-import Text.Show import Web.FormUrlEncoded (ToForm (..)) -- newtype ChannelToken = ChannelToken { unChannelToken :: Text } deriving (Eq, Show, Generic, NFData) @@ -121,9 +115,9 @@ -- | ID of a chat user, group or room data Id :: ChatType -> * where- UserId :: Text -> Id User- GroupId :: Text -> Id Group- RoomId :: Text -> Id Room+ UserId :: Text -> Id 'User+ GroupId :: Text -> Id 'Group+ RoomId :: Text -> Id 'Room deriving instance Eq (Id a) deriving instance Show (Id a)@@ -142,32 +136,32 @@ instance ToJSON (Id a) where toJSON = String . toQueryParam -instance FromHttpApiData (Id User) where+instance FromHttpApiData (Id 'User) where parseUrlPiece = pure . UserId -instance FromHttpApiData (Id Group) where+instance FromHttpApiData (Id 'Group) where parseUrlPiece = pure . GroupId -instance FromHttpApiData (Id Room) where+instance FromHttpApiData (Id 'Room) where parseUrlPiece = pure . RoomId -instance IsString (Id User) where+instance IsString (Id 'User) where fromString s = UserId (fromString s) -instance IsString (Id Group) where+instance IsString (Id 'Group) where fromString s = GroupId (fromString s) -instance IsString (Id Room) where+instance IsString (Id 'Room) where fromString s = RoomId (fromString s) -instance FromJSON (Id User) where- parseJSON = withText "Id User" $ return . UserId+instance FromJSON (Id 'User) where+ parseJSON = withText "Id 'User" $ return . UserId -instance FromJSON (Id Group) where- parseJSON = withText "Id Group" $ return . GroupId+instance FromJSON (Id 'Group) where+ parseJSON = withText "Id 'Group" $ return . GroupId -instance FromJSON (Id Room) where- parseJSON = withText "Id Room" $ return . RoomId+instance FromJSON (Id 'Room) where+ parseJSON = withText "Id 'Room" $ return . RoomId type MessageId = Text @@ -265,7 +259,7 @@ ] data MulticastMessageBody = MulticastMessageBody- { to :: [Id User]+ { to :: [Id 'User] , messages :: [Message] } deriving (Show, Generic, NFData)@@ -379,7 +373,7 @@ instance FromJSON MessageQuota data MemberIds = MemberIds- { memberIds :: [Id User]+ { memberIds :: [Id 'User] , next :: Maybe String } deriving (Eq, Show, Generic, NFData) @@ -459,13 +453,13 @@ data RichMenuBulkLinkBody = RichMenuBulkLinkBody { richMenuId :: Text- , userIds :: [Id User]+ , userIds :: [Id 'User] } deriving (Show, Eq, Generic, NFData) instance ToJSON RichMenuBulkLinkBody newtype RichMenuBulkUnlinkBody = RichMenuBulkUnlinkBody- { userIds :: [Id User] }+ { userIds :: [Id 'User] } deriving (Show, Eq, Generic, NFData) instance ToJSON RichMenuBulkUnlinkBody
src/Line/Bot/Webhook.hs view
@@ -28,11 +28,9 @@ ) where -import Control.Monad (forM_, (>>))+import Control.Monad (forM_) import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Crypto.Hash.SHA256 as SHA256-import Data.Aeson-import Data.Aeson.Types import qualified Data.ByteString as B import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Lazy as BL@@ -43,7 +41,7 @@ import Line.Bot.Types (ChannelSecret (..)) import Line.Bot.Webhook.Events as Events import Network.HTTP.Types (HeaderName, hContentType)-import Network.Wai (Request, lazyRequestBody,+import Network.Wai (lazyRequestBody, requestHeaders) import Servant import Servant.API.ContentTypes
src/Line/Bot/Webhook/Events.hs view
@@ -37,26 +37,21 @@ import Control.Arrow ((>>>)) import Data.Aeson-import Data.Aeson.Types import Data.Char import Data.Foldable import Data.List as L (stripPrefix)-import Data.Maybe-import Data.Scientific-import Data.String import Data.Text as T hiding (drop, toLower)-import Data.Time (LocalTime, UTCTime)+import Data.Time (UTCTime) import Data.Time.Calendar (Day) import Data.Time.Clock.POSIX import Data.Time.Format import Data.Time.LocalTime import Data.Typeable (Typeable) import GHC.Generics (Generic)-import Line.Bot.Types hiding (Message, Text)-+import Line.Bot.Types hiding (Message) data Events = Events- { destination :: Id User -- ^ User ID of a bot that should receive webhook events+ { destination :: Id 'User -- ^ 'User ID of a bot that should receive webhook events , events :: [Event] -- ^ List of webhook event objects } deriving (Show, Generic)@@ -207,9 +202,9 @@ _ -> fail ("unknown source: " ++ messageType) instance ToJSON Source where- toJSON (Source (UserId a)) = object ["type" .= "user", "userId" .= a]- toJSON (Source (GroupId a)) = object ["type" .= "group", "groupId" .= a]- toJSON (Source (RoomId a)) = object ["type" .= "room", "roomId" .= a]+ toJSON (Source (UserId a)) = object ["type" .= String "user", "userId" .= a]+ toJSON (Source (GroupId a)) = object ["type" .= String "group", "groupId" .= a]+ toJSON (Source (RoomId a)) = object ["type" .= String "room", "roomId" .= a] newtype Members = Members { members :: [Source] } deriving (Show, Generic)@@ -230,13 +225,13 @@ , PostbackTimeOfDay <$> o .: "time" ] -data Postback = Postback Text PostbackDateTime+data Postback = Postback Text (Maybe PostbackDateTime) deriving (Eq, Show) instance FromJSON Postback where parseJSON = withObject "Postback" $ \o -> do postbackData <- o .: "data"- params <- o .: "params"+ params <- o .:? "params" return $ Postback postbackData params data BeaconEvent = Enter | Leave | Banner
test/Line/Bot/ClientSpec.hs view
@@ -5,10 +5,10 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-} module Line.Bot.ClientSpec (spec) where -import Control.Arrow (left) import Control.DeepSeq (NFData) import Control.Monad ((>=>)) import Control.Monad.Free@@ -17,15 +17,13 @@ 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.Internal.Auth import Line.Bot.Internal.Endpoints import Line.Bot.Types-import Network.HTTP.Client (defaultManagerSettings,- newManager)+import Network.HTTP.Client (newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Types (hAuthorization) import Network.Wai as Wai (Request, requestHeaders)@@ -34,13 +32,12 @@ import Servant.Client.Core import Servant.Client.Free as F import Servant.Client.Streaming-import Servant.Server (Context (..)) import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData, mkAuthHandler) import Test.Hspec import Test.Hspec.Expectations.Contrib-import Test.Hspec.Wai +type ChannelAuth = AuthProtect "channel-token" type instance AuthServerData ChannelAuth = ChannelToken -- a dummy auth handler that returns the channel access token@@ -57,14 +54,14 @@ :<|> GetGroupMemberProfile' Value :<|> GetRoomMemberProfile' Value -getReplyMessageCountF :: LineDate -> Auth -> Free ClientF MessageCount-getReplyMessageCountF = F.client (Proxy :: Proxy GetReplyMessageCount)+getReplyMessageCountF :: LineDate -> Free ClientF MessageCount+getReplyMessageCountF = F.client (Proxy @GetReplyMessageCount) -getPushMessageCountF :: LineDate -> Auth -> Free ClientF MessageCount-getPushMessageCountF = F.client (Proxy :: Proxy GetPushMessageCount)+getPushMessageCountF :: LineDate -> Free ClientF MessageCount+getPushMessageCountF = F.client (Proxy @GetPushMessageCount) -getMulticastMessageCountF :: LineDate -> Auth -> Free ClientF MessageCount-getMulticastMessageCountF = F.client (Proxy :: Proxy GetMulticastMessageCount)+getMulticastMessageCountF :: LineDate -> Free ClientF MessageCount+getMulticastMessageCountF = F.client (Proxy @GetMulticastMessageCount) testProfile :: Value testProfile = [aesonQQ|@@ -78,20 +75,20 @@ withPort :: Port -> (ClientEnv -> IO a) -> IO a withPort port app = do- manager <- newManager defaultManagerSettings+ manager <- newManager tlsManagerSettings app $ mkClientEnv manager $ BaseUrl Http "localhost" port "" token :: ChannelToken token = "fake" runLine :: NFData a => Line a -> Port -> IO (Either ClientError a)-runLine comp port = withPort port $ runClientM $ runReaderT comp token+runLine comp port = withPort port $ \env -> runClientM (runReaderT comp token) env app :: Application app = serveWithContext (Proxy :: Proxy API) serverContext $- (\_ _ -> return testProfile)- :<|> (\_ _ _ -> return testProfile)- :<|> (\_ _ _ -> return testProfile)+ (\_ -> return testProfile)+ :<|> (\_ _ -> return testProfile)+ :<|> (\_ _ -> return testProfile) spec :: Spec spec = describe "Line client" $ do@@ -108,15 +105,15 @@ runLine (getRoomMemberProfile "1" "1") >=> (`shouldSatisfy` isRight) it "should send `date` query param for push message count" $ do- let Free (RunRequest Request{..} _) = getPushMessageCountF date (mkAuth token)+ let Free (RunRequest Request{..} _) = getPushMessageCountF date toList requestQueryString `shouldBe` [("date", Just "20190407")] it "should send `date` query param for reply message count" $ do- let Free (RunRequest Request{..} _) = getReplyMessageCountF date (mkAuth token)+ let Free (RunRequest Request{..} _) = getReplyMessageCountF date toList requestQueryString `shouldBe` [("date", Just "20190407")] it "should send `date` query param for multicast message count" $ do- let Free (RunRequest Request{..} _) = getMulticastMessageCountF date (mkAuth token)+ let Free (RunRequest Request{..} _) = getMulticastMessageCountF date toList requestQueryString `shouldBe` [("date", Just "20190407")] where date = LineDate $ fromGregorian 2019 4 7