line-bot-sdk 0.5.1.0 → 0.5.2

raw patch · 9 files changed

+404/−131 lines, 9 filesdep +deepseqdep +http-mediadep −errorsdep −exceptionsdep −monad-controldep ~servantdep ~servant-clientdep ~servant-client-corePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: deepseq, http-media

Dependencies removed: errors, exceptions, monad-control, streaming, transformers-base

Dependency ranges changed: servant, servant-client, servant-client-core, servant-server

API changes (from Hackage documentation)

Files

• README.md +12/−9
• line-bot-sdk.cabal +11/−15
• src/Line/Bot/Client.hs +132/−59
• src/Line/Bot/Internal/Auth.hs +8/−8
• src/Line/Bot/Internal/Endpoints.hs +74/−4
• src/Line/Bot/Types.hs +138/−20
• src/Line/Bot/Webhook.hs +14/−1
• src/Line/Bot/Webhook/Events.hs +12/−13
• test/Line/Bot/ClientSpec.hs +3/−2

@@ -41,21 +41,24 @@ ## Usage  ```haskell+{-# LANGUAGE DataKinds         #-} {-# LANGUAGE OverloadedStrings #-} -import Data.String (fromString)-import Line.Bot.Client (Line, getProfile, runLine)-import Line.Bot.Types (Profile)-import System.Environment (getEnv)+import           Data.String        (fromString)+import           Line.Bot.Client+import           Line.Bot.Types+import           System.Environment (getEnv) -profile :: Line Profile-profile = getProfile "U4af4980629..."+getProfiles :: Id Room -> Line [Profile]+getProfiles roomId = do+  userIds <- getRoomMemberUserIds roomId+  sequence $ getRoomMemberProfile roomId <$> userIds  main = do-  token <- fromString <$> getEnv "CHANNEL_TOKEN"-  result <- runLine profile token+  token  <- fromString <$> getEnv "CHANNEL_TOKEN"+  result <- runLine (getProfiles "U4af4980629...") token   case result of-    Left err -> print err+    Left err      -> print err     Right profile -> print profile ``` 

@@ -1,5 +1,5 @@ name:                line-bot-sdk-version:             0.5.1.0+version:             0.5.2 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@@ -43,24 +43,21 @@                      , time                 >= 1.8.0 && < 1.9                      , base64-bytestring    >= 1.0.0 && < 1.1                      , cryptohash-sha256    >= 0.11.101 && < 0.12-                     , errors               >= 2.3.0 && < 2.4                      , http-client          >= 0.5.14 && < 0.7                      , http-types           >= 0.12.2 && < 0.13+                     , http-media                      , http-api-data        >= 0.4 && < 0.5                      , http-client-tls      >= 0.3.5 && < 0.4-                     , servant              >= 0.15 && < 0.16+                     , servant              >= 0.16.2 && < 0.17                      , string-conversions   >= 0.4.0 && < 0.5-                     , servant-client       >= 0.15 && < 0.16-                     , servant-client-core  >= 0.15 && < 0.16-                     , servant-server       >= 0.15 && < 0.16+                     , servant-client       >= 0.16.0.1 && < 0.17+                     , servant-client-core  >= 0.16 && < 0.17+                     , servant-server       >= 0.16.2 && < 0.17                      , wai                  >= 3.2.2 && < 3.3-                     , wai-extra            >= 3.0.25 && < 3.1-                     , exceptions           >= 0.10 && < 0.11-                     , transformers-base    >= 0.4 && < 0.5                      , mtl                  >= 2.2.2 && < 2.3-                     , monad-control        >= 1.0 && < 1.1-                     , streaming            >= 0.2 && < 0.3+                     , deepseq              >= 1.4.2.0  && < 1.5 +   default-language:    Haskell2010  executable echo-server@@ -69,11 +66,9 @@   ghc-options:         -threaded -rtsopts -with-rtsopts=-N   build-depends:       base                 >= 4.7 && < 5                      , line-bot-sdk-                     , servant              >= 0.15 && < 0.16-                     , servant-server       >= 0.15 && < 0.16-                     , servant-client       >= 0.15 && < 0.16+                     , servant              >= 0.16.2 && < 0.17+                     , servant-server       >= 0.16.2 && < 0.17                      , transformers         >= 0.5.5 && < 0.6-                     , time                 >= 1.8.0 && < 1.9                      , wai                  >= 3.2.2 && < 3.3                      , wai-extra            >= 3.0.25 && < 3.1                      , warp                 >= 3.2.26 && < 3.3@@ -108,6 +103,7 @@                      , warp                      , free                      , time +                     , deepseq   ghc-options:         -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010 

@@ -2,9 +2,11 @@ {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE RecordWildCards       #-} {-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE TypeOperators         #-} @@ -18,7 +20,7 @@ module Line.Bot.Client   ( Line   , runLine-  , runLine'+  , withLine   , withLineEnv   -- ** Profile   , getProfile@@ -26,33 +28,46 @@   , getGroupMemberProfile   , leaveGroup   , getGroupMemberUserIds-  , getGroupMemberUserIdsS   -- ** Room   , getRoomMemberProfile   , leaveRoom   , getRoomMemberUserIds-  , getRoomMemberUserIdsS   -- ** Message   , replyMessage   , pushMessage   , multicastMessage+  , broadcastMessage   , getContent+  , getContentS   , getPushMessageCount   , getReplyMessageCount   , getMulticastMessageCount+  , getBroadcastMessageCount   , getMessageQuota   -- ** Account Link   , issueLinkToken   -- ** OAuth   , issueChannelToken   , revokeChannelToken+  -- ** Rich menus+  , createRichMenu+  , deleteRichMenu+  , getRichMenu+  , uploadRichMenuImageJpg+  , getRichMenuList+  , setDefaultRichMenu   ) 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)@@ -60,31 +75,44 @@ import           Line.Bot.Types import           Network.HTTP.Client         (newManager) import           Network.HTTP.Client.TLS     (tlsManagerSettings)-import           Servant.API                 hiding (Stream)-import           Servant.Client-import           Streaming-import qualified Streaming.Prelude           as S+import           Servant.API+import           Servant.Client.Streaming -host :: BaseUrl-host = BaseUrl Https "api.line.me" 443 ""+defaultEndpoint :: BaseUrl+defaultEndpoint = BaseUrl Https "api.line.me" 443 "" +blobEndpoint :: BaseUrl+blobEndpoint = BaseUrl Https "api-data.line.me" 443 ""+ -- | @Line@ is the monad in which bot requests run. Contains the -- OAuth access token for a channel type Line = ReaderT ChannelToken ClientM +-- | Perform a request using LINE 'ClientEnv'+--+-- > withLineEnv $ \env -> runClientM comp env withLineEnv :: (ClientEnv -> IO a) -> IO a withLineEnv app = do   manager <- newManager tlsManagerSettings-  app $ mkClientEnv manager host+  app $ mkClientEnv manager defaultEndpoint --- | Executes a request in the LINE plaform (default)-runLine' :: ClientM a -> IO (Either ServantError a)+runLine' :: NFData a => ClientM a -> IO (Either ClientError a) runLine' comp = withLineEnv $ \env -> runClientM comp env --- | Runs a @Line@ computation with the given channel access token-runLine :: Line a -> ChannelToken -> IO (Either ServantError a)+-- | Executes a request in the LINE plaform with the given 'ChannelToken'+runLine :: NFData a => Line a -> ChannelToken -> IO (Either ClientError a) runLine comp = runLine' . runReaderT comp +withLine' :: ClientM a -> (Either ClientError a -> IO b) -> IO b+withLine' comp k = withLineEnv $ \env -> withClientM comp env k++-- | Execute a request with a streaming response in the LINE platform+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 })+ type LineAuth a = Auth -> ClientM a  type family AddLineAuth a :: * where@@ -95,118 +123,163 @@   addLineAuth :: a -> AddLineAuth a  instance HasLine (LineAuth a) where-  addLineAuth comp = ask >>= \token -> lift $ comp (mkAuth token)+  addLineAuth comp = ask >>= lift . comp . mkAuth  instance HasLine (a -> LineAuth b) where-  addLineAuth comp a = addLineAuth (comp a)+  addLineAuth comp = addLineAuth . comp  instance HasLine (a -> b -> LineAuth c) where-  addLineAuth comp a = addLineAuth (comp a)+  addLineAuth comp = addLineAuth . comp  line :: (HasLine (Client ClientM api), HasClient ClientM api)-     => Proxy api -> AddLineAuth (Client ClientM api)-line api = addLineAuth (client api)+     => Proxy api+     -> AddLineAuth (Client ClientM api)+line = addLineAuth . client +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 = line (Proxy :: Proxy GetProfile)+getProfile = line (Proxy @GetProfile)  getGroupMemberProfile :: Id Group -> Id User -> Line Profile-getGroupMemberProfile = line (Proxy :: Proxy GetGroupMemberProfile)+getGroupMemberProfile = line (Proxy @GetGroupMemberProfile)  leaveGroup :: Id Group -> Line NoContent-leaveGroup = line (Proxy :: Proxy LeaveGroup)+leaveGroup = line (Proxy @LeaveGroup)  getGroupMemberUserIds' :: Id Group -> Maybe String -> Line MemberIds-getGroupMemberUserIds' = line (Proxy :: Proxy GetGroupMemberUserIds)--getGroupMemberUserIdsS :: Id Group -> Stream (Of (Id User)) Line ()-getGroupMemberUserIdsS gid = go gid Nothing-  where-    go gid token = do-      MemberIds{..} <- lift $ getGroupMemberUserIds' gid token-      S.each memberIds-      case next of-        Nothing -> return ()-        token'  -> go gid token'+getGroupMemberUserIds' = line (Proxy @GetGroupMemberUserIds)  getGroupMemberUserIds :: Id Group -> Line [Id User]-getGroupMemberUserIds = S.toList_ . getGroupMemberUserIdsS+getGroupMemberUserIds = unfoldMemberUserIds . getGroupMemberUserIds'  getRoomMemberProfile :: Id Room -> Id User -> Line Profile-getRoomMemberProfile = line (Proxy :: Proxy GetRoomMemberProfile)+getRoomMemberProfile = line (Proxy @GetRoomMemberProfile)  leaveRoom :: Id Room -> Line NoContent-leaveRoom = line (Proxy :: Proxy LeaveRoom)+leaveRoom = line (Proxy @LeaveRoom)  getRoomMemberUserIds' :: Id Room -> Maybe String -> Line MemberIds-getRoomMemberUserIds' = line (Proxy :: Proxy GetRoomMemberUserIds)--getRoomMemberUserIdsS :: Id Room -> Stream (Of (Id User)) Line ()-getRoomMemberUserIdsS gid = go gid Nothing-  where-    go gid token = do-      MemberIds{..} <- lift $ getRoomMemberUserIds' gid token-      S.each memberIds-      case next of-        Nothing -> return ()-        token'  -> go gid token'+getRoomMemberUserIds' = line (Proxy @GetRoomMemberUserIds)  getRoomMemberUserIds :: Id Room -> Line [Id User]-getRoomMemberUserIds = S.toList_ . getRoomMemberUserIdsS+getRoomMemberUserIds = unfoldMemberUserIds . getRoomMemberUserIds'  replyMessage' :: ReplyMessageBody -> Line NoContent-replyMessage' = line (Proxy :: Proxy ReplyMessage)+replyMessage' = line (Proxy @ReplyMessage)  replyMessage :: ReplyToken -> [Message] -> Line NoContent replyMessage a ms = replyMessage' (ReplyMessageBody a ms)  pushMessage' :: PushMessageBody -> Line NoContent-pushMessage' = line (Proxy :: Proxy PushMessage)+pushMessage' = line (Proxy @PushMessage)  pushMessage :: Id a -> [Message] -> Line NoContent pushMessage a ms = pushMessage' (PushMessageBody a ms)  multicastMessage' :: MulticastMessageBody -> Line NoContent-multicastMessage' = line (Proxy :: Proxy MulticastMessage)+multicastMessage' = line (Proxy @MulticastMessage)  multicastMessage :: [Id User] -> [Message] -> Line NoContent multicastMessage a ms = multicastMessage' (MulticastMessageBody a ms) +broadcastMessage' :: BroadcastMessageBody -> Line NoContent+broadcastMessage' = line (Proxy @BroadcastMessage)++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 :: Proxy GetContent)+getContent  a = ask >>= lift . withHost blobEndpoint . getContent' a . mkAuth +getContentS' :: MessageId -> Auth -> ClientM (SourceIO ByteString)+getContentS' = client (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+-- of 'FromSourceIO', see e.g. @servant-conduit@.+--+-- Example:+--+-- > getContentC :: MessageId -> Line (ConduitT () ByteString IO ())+-- > getContentC = fmap fromSourceIO . getContentS+getContentS :: MessageId -> Line (SourceIO ByteString)+getContentS  a = ask >>= lift . withHost blobEndpoint . getContentS' a . mkAuth+ getPushMessageCount' :: LineDate -> Line MessageCount-getPushMessageCount' = line (Proxy :: Proxy GetPushMessageCount)+getPushMessageCount' = line (Proxy @GetPushMessageCount)  getPushMessageCount :: Day -> Line (Maybe Int) getPushMessageCount = fmap count . getPushMessageCount' . LineDate  getReplyMessageCount' :: LineDate -> Line MessageCount-getReplyMessageCount' = line (Proxy :: Proxy GetReplyMessageCount)+getReplyMessageCount' = line (Proxy @GetReplyMessageCount)  getReplyMessageCount :: Day -> Line (Maybe Int) getReplyMessageCount = fmap count . getReplyMessageCount' . LineDate  getMulticastMessageCount' :: LineDate -> Line MessageCount-getMulticastMessageCount' = line (Proxy :: Proxy GetMulticastMessageCount)+getMulticastMessageCount' = line (Proxy @GetMulticastMessageCount)  getMulticastMessageCount :: Day -> Line (Maybe Int) getMulticastMessageCount = fmap count . getMulticastMessageCount' . LineDate +getBroadcastMessageCount' :: LineDate -> Line MessageCount+getBroadcastMessageCount' = line (Proxy @GetBroadcastMessageCount)++getBroadcastMessageCount :: Day -> Line (Maybe Int)+getBroadcastMessageCount = fmap count . getBroadcastMessageCount' . LineDate+ getMessageQuota' :: Line MessageQuota-getMessageQuota' = line (Proxy :: Proxy GetMessageQuota)+getMessageQuota' = line (Proxy @GetMessageQuota)  getMessageQuota :: Line Int getMessageQuota = fmap totalUsage getMessageQuota'  issueLinkToken :: Id User -> Line LinkToken-issueLinkToken = line (Proxy :: Proxy IssueLinkToken)+issueLinkToken = line (Proxy @IssueLinkToken)  issueChannelToken' :: ClientCredentials -> ClientM ShortLivedChannelToken-issueChannelToken' = client (Proxy :: Proxy IssueChannelToken)+issueChannelToken' = client (Proxy @IssueChannelToken)  issueChannelToken :: ChannelId -> ChannelSecret -> ClientM ShortLivedChannelToken issueChannelToken a b = issueChannelToken' $ ClientCredentials a b  revokeChannelToken :: ChannelToken -> ClientM NoContent-revokeChannelToken = client (Proxy :: Proxy RevokeChannelToken)+revokeChannelToken = client (Proxy @RevokeChannelToken)++createRichMenu :: RichMenu -> Line RichMenuId+createRichMenu = line (Proxy @CreateRichMenu)++getRichMenu' :: RichMenuId -> Line RichMenuResponse+getRichMenu' = line (Proxy @GetRichMenu)++getRichMenu :: RichMenuId -> Line RichMenu+getRichMenu = fmap richMenu . getRichMenu'++uploadRichMenuImageJpg' :: RichMenuId -> ByteString -> Auth -> ClientM NoContent+uploadRichMenuImageJpg' = client (Proxy @UploadRichMenuImageJpg)++uploadRichMenuImageJpg :: RichMenuId -> ByteString -> Line NoContent+uploadRichMenuImageJpg a b = ask >>= lift . withHost blobEndpoint . uploadRichMenuImageJpg' a b . mkAuth++deleteRichMenu :: RichMenuId -> Line NoContent+deleteRichMenu = line (Proxy @DeleteRichMenu)++getRichMenuList' :: Line RichMenuResponseList+getRichMenuList' =  line (Proxy @GetRichMenuList)++getRichMenuList :: Line [(RichMenuId, RichMenu)]+getRichMenuList = richmenus <$> getRichMenuList' <&> fmap f where+  f RichMenuResponse{..} = (RichMenuId richMenuId, richMenu)++setDefaultRichMenu :: RichMenuId -> Line NoContent+setDefaultRichMenu = line (Proxy @SetDefaultRichMenu)

@@ -8,14 +8,14 @@  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)+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 

@@ -15,7 +15,8 @@  module Line.Bot.Internal.Endpoints where -import           Data.ByteString.Lazy (ByteString)+import           Data.ByteString      (ByteString)+import qualified Data.ByteString.Lazy as LB (ByteString) import           Line.Bot.Types import           Servant.API import           Servant.Client@@ -88,7 +89,8 @@ type GetRoomMemberUserIds = GetRoomMemberUserIds' MemberIds  type ReplyMessage' a =-     "v2":> "bot" :> "message" :> "reply"+     "v2":> "bot" :> "message"+  :> "reply"   :> ReqBody '[JSON] a   :> ChannelAuth   :> PostNoContent '[JSON] NoContent@@ -113,12 +115,21 @@  type MulticastMessage = MulticastMessage' MulticastMessageBody +type BroadcastMessage' a =+     "v2":> "bot" :> "message"+  :> "broadcast"+  :> ReqBody '[JSON] a+  :> ChannelAuth+  :> PostNoContent '[JSON] NoContent++type BroadcastMessage = BroadcastMessage' BroadcastMessageBody+ type GetContent =      "v2":> "bot" :> "message"   :> Capture "messageId" MessageId   :> "content"   :> ChannelAuth-  :> Get '[OctetStream] ByteString+  :> Get '[OctetStream] LB.ByteString  type GetContentStream =      "v2":> "bot" :> "message"@@ -154,6 +165,15 @@  type GetMulticastMessageCount = GetMulticastMessageCount' LineDate MessageCount +type GetBroadcastMessageCount' a b =+     "v2" :> "bot" :> "message" :> "delivery"+  :> "broadcast"+  :> QueryParam' '[Required, Strict] "date" a+  :> ChannelAuth+  :> Get '[JSON] b++type GetBroadcastMessageCount = GetBroadcastMessageCount' LineDate MessageCount+ type GetMessageQuota' a =      "v2":> "bot" :> "message" :> "quota"   :> "consumption"@@ -183,6 +203,56 @@      "v2" :> "oauth"   :> "revoke"   :> ReqBody '[FormUrlEncoded] a-  :> PostNoContent '[JSON] NoContent+  :> Post '[JSON] NoContent  type RevokeChannelToken = RevokeChannelToken' ChannelToken++type CreateRichMenu' a b =+     "v2" :> "bot" :> "richmenu"+  :> ReqBody '[JSON] a+  :> ChannelAuth+  :> PostNoContent '[JSON] b++type CreateRichMenu = CreateRichMenu' RichMenu RichMenuId++type DeleteRichMenu' a =+     "v2" :> "bot" :> "richmenu"+  :> Capture "richMenuId" a+  :> ChannelAuth+  :> Delete '[JSON] NoContent++type DeleteRichMenu = DeleteRichMenu' RichMenuId++type GetRichMenu' a b =+     "v2" :> "bot" :> "richmenu"+  :> Capture "richMenuId" a+  :> ChannelAuth+  :> Get '[JSON] b++type GetRichMenu = GetRichMenu' RichMenuId RichMenuResponse++type UploadRichMenuImageJpg' a b =+     "v2" :> "bot" :> "richmenu"+  :> Capture "richMenuId" a+  :> "content"+  :> ReqBody '[JPEG] b+  :> ChannelAuth+  :> Post '[JSON] NoContent++type UploadRichMenuImageJpg = UploadRichMenuImageJpg' RichMenuId ByteString++type GetRichMenuList' a =+     "v2" :> "bot" :> "richmenu"+  :> "list"+  :> ChannelAuth+  :> Get '[JSON] a++type GetRichMenuList = GetRichMenuList' RichMenuResponseList++type SetDefaultRichMenu' a =+     "v2":> "bot" :> "user" :> "all" :> "richmenu"+  :> Capture "richMenuId" a+  :> ChannelAuth+  :> PostNoContent '[JSON] NoContent++type SetDefaultRichMenu = SetDefaultRichMenu' RichMenuId

@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds                 #-} {-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE DeriveAnyClass            #-} {-# LANGUAGE DuplicateRecordFields     #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts          #-}@@ -7,6 +8,7 @@ {-# LANGUAGE GADTs                     #-} {-# LANGUAGE KindSignatures            #-} {-# LANGUAGE LambdaCase                #-}+{-# LANGUAGE MultiParamTypeClasses     #-} {-# LANGUAGE NamedFieldPuns            #-} {-# LANGUAGE OverloadedLists           #-} {-# LANGUAGE OverloadedStrings         #-}@@ -33,6 +35,7 @@   , ReplyMessageBody(ReplyMessageBody)   , PushMessageBody(PushMessageBody)   , MulticastMessageBody(MulticastMessageBody)+  , BroadcastMessageBody(BroadcastMessageBody)   , Profile(..)   , QuickReply(..)   , QuickReplyButton(..)@@ -43,13 +46,26 @@   , MessageCount(..)   , MessageQuota(..)   , MemberIds(..)+  , JPEG+  , RichMenuSize(..)+  , RichMenuBounds(..)+  , RichMenuArea(..)+  , RichMenu(..)+  , RichMenuResponse(..)+  , RichMenuId(..)+  , RichMenuResponseList(..)+  , RichMenuBulkLinkBody(..)+  , RichMenuBulkUnlinkBody(..)   ) where  import           Control.Arrow         ((>>>))+import           Control.DeepSeq import           Data.Aeson import           Data.Aeson.Types-import qualified Data.ByteString.Char8 as B+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)@@ -59,14 +75,17 @@ 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           Servant.API import           Text.Show import           Web.FormUrlEncoded    (ToForm (..))  + newtype ChannelToken = ChannelToken { unChannelToken :: Text }-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)  instance FromJSON ChannelToken where   parseJSON = withText "ChannelToken" $ return . ChannelToken@@ -81,16 +100,16 @@ instance ToForm ChannelToken where   toForm (ChannelToken t) = [ ("access_token", t) ] -newtype ChannelSecret = ChannelSecret { unChannelSecret :: B.ByteString }+newtype ChannelSecret = ChannelSecret { unChannelSecret :: C8.ByteString }  instance IsString ChannelSecret where-  fromString s = ChannelSecret (B.pack s)+  fromString s = ChannelSecret (C8.pack s)  instance ToHttpApiData ChannelSecret where   toQueryParam = decodeUtf8 . unChannelSecret  newtype ChannelId = ChannelId { unChannelId :: Text }-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)  instance IsString ChannelId where   fromString s = ChannelId (fromString s)@@ -109,6 +128,11 @@ deriving instance Eq (Id a) deriving instance Show (Id a) +instance NFData (Id a) where+    rnf (UserId a)  = rnf a+    rnf (GroupId a) = rnf a+    rnf (RoomId a)  = rnf a+ instance ToHttpApiData (Id a) where   toQueryParam = \case     UserId a  -> a@@ -148,7 +172,7 @@ type MessageId = Text  newtype URL = URL Text-  deriving (Show, Eq, Generic)+  deriving (Show, Eq, Generic, NFData)  instance ToJSON URL instance FromJSON URL@@ -183,7 +207,7 @@                     , contents   :: Value                     , quickReply :: Maybe QuickReply                     }-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)  instance ToJSON Message where   toJSON = genericToJSON messageJSONOptions@@ -200,22 +224,22 @@  data Profile = Profile   { displayName   :: Text-  , userId        :: Id User+  , userId        :: Text   , pictureUrl    :: URL   , statusMessage :: Maybe Text   }-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)  instance FromJSON Profile  newtype ReplyToken = ReplyToken Text-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)  instance ToJSON ReplyToken instance FromJSON ReplyToken  newtype LinkToken = LinkToken { linkToken :: Text }-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)  instance FromJSON LinkToken @@ -223,7 +247,7 @@   { replyToken :: ReplyToken   , messages   :: [Message]   }-  deriving (Show, Generic)+  deriving (Show, Generic, NFData)  instance ToJSON ReplyMessageBody @@ -244,13 +268,19 @@   { to       :: [Id User]   , messages :: [Message]   }-  deriving (Show, Generic)+  deriving (Show, Generic, NFData)  instance ToJSON MulticastMessageBody +newtype BroadcastMessageBody = BroadcastMessageBody+  { messages :: [Message] }+  deriving (Show, Generic, NFData)++instance ToJSON BroadcastMessageBody+ newtype QuickReply = QuickReply   { items :: [QuickReplyButton] }-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)  instance ToJSON QuickReply @@ -258,7 +288,7 @@   { imageUrl :: Maybe URL   , action   :: Action   }-  deriving (Eq, Show)+  deriving (Eq, Show, Generic, NFData)  instance ToJSON QuickReplyButton where   toJSON QuickReplyButton{..} = object@@ -284,11 +314,14 @@                      }   | ActionLocation   { label :: Text                      }-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)  instance ToJSON Action where   toJSON = genericToJSON actionJSONOptions +instance FromJSON Action where+  parseJSON = genericParseJSON actionJSONOptions+ actionJSONOptions :: Options actionJSONOptions = defaultOptions   { sumEncoding            = TaggedObject@@ -315,7 +348,7 @@ data ShortLivedChannelToken = ShortLivedChannelToken   { accessToken :: ChannelToken   , expiresIn   :: Int-  } deriving (Eq, Show, Generic)+  } deriving (Eq, Show, Generic, NFData)  instance FromJSON ShortLivedChannelToken where   parseJSON = genericParseJSON defaultOptions@@ -341,13 +374,98 @@     return MessageCount{..}  newtype MessageQuota = MessageQuota { totalUsage :: Int }-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)  instance FromJSON MessageQuota  data MemberIds = MemberIds   { memberIds :: [Id User]-  , next :: Maybe String-  } deriving (Eq, Show, Generic)+  , next      :: Maybe String+  } deriving (Eq, Show, Generic, NFData)  instance FromJSON MemberIds++data JPEG deriving Typeable++instance Accept JPEG where+  contentType _ = "image" // "jpeg"++instance MimeRender JPEG ByteString where+  mimeRender _ = LB.fromStrict++data RichMenuSize = RichMenuSize+  { width  :: Int+  , height :: Int+  } deriving (Eq, Show, Generic, NFData)++instance FromJSON RichMenuSize+instance ToJSON RichMenuSize++data RichMenuBounds = RichMenuBounds+  { x      :: Int+  , y      :: Int+  , width  :: Int+  , height :: Int+  } deriving (Eq, Show, Generic, NFData)++instance FromJSON RichMenuBounds+instance ToJSON RichMenuBounds++data RichMenuArea = RichMenuArea+  { bounds :: RichMenuBounds+  , action :: Action+  } deriving (Eq, Show, Generic, NFData)++instance FromJSON RichMenuArea+instance ToJSON RichMenuArea++data RichMenu = RichMenu+  { size        :: RichMenuSize+  , selected    :: Bool+  , name        :: Text+  , chatBarText :: Text+  , areas       :: [RichMenuArea]+  } deriving (Eq, Show, Generic, NFData)++instance FromJSON RichMenu+instance ToJSON RichMenu++data RichMenuResponse = RichMenuResponse+  { richMenuId :: Text+  , richMenu   :: RichMenu+  }+  deriving (Show, Eq, Generic, NFData)++instance FromJSON RichMenuResponse where+  parseJSON = withObject "RichMenuResponse" $ \o -> do+    richMenuId <- o .: "richMenuId"+    richMenu   <- parseJSON (Object o)+    return RichMenuResponse{..}++newtype RichMenuId = RichMenuId+  { richMenuId :: Text }+  deriving (Show, Eq, Generic, NFData)++instance FromJSON RichMenuId++instance ToHttpApiData RichMenuId where+  toQueryParam (RichMenuId a) = a++newtype RichMenuResponseList = RichMenuResponseList+  { richmenus :: [RichMenuResponse] }+  deriving (Show, Eq, Generic, NFData)++instance FromJSON RichMenuResponseList++data RichMenuBulkLinkBody = RichMenuBulkLinkBody+  { richMenuId :: Text+  , userIds    :: [Id User]+  } deriving (Show, Eq, Generic, NFData)++instance ToJSON RichMenuBulkLinkBody++newtype RichMenuBulkUnlinkBody = RichMenuBulkUnlinkBody+  { userIds :: [Id User] }+  deriving (Show, Eq, Generic, NFData)++instance ToJSON RichMenuBulkUnlinkBody

@@ -7,10 +7,12 @@ {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE PolyKinds             #-} {-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE RecordWildCards       #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE TypeOperators         #-} {-# LANGUAGE UndecidableInstances  #-}+ -- | -- Module      : Line.Bot.Webhook -- Copyright   : (c) Alexandre Moreno, 2019@@ -20,12 +22,14 @@  module Line.Bot.Webhook   ( Webhook+  , webhook   , LineReqBody   , module Events   ) where -import           Control.Monad.IO.Class   (liftIO)+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@@ -47,6 +51,15 @@  -- | This type alias just specifies how webhook requests should be handled type Webhook = LineReqBody '[JSON] Events :> Post '[JSON] NoContent++-- | Helper function that takes a handler to process 'Webhook' events:+--+-- > server :: Server Webhook+-- > server = webhook $ \case+-- >   EventMessage { message, replyToken } = handleMessage message replyToken+-- >   _                                    = return ()+webhook :: MonadIO m => (Event -> m a) -> Events -> m NoContent+webhook k Events{..} = forM_ events k >> return NoContent  -- | A Servant combinator that extracts the request body as a value of type a -- and performs signature valiadation

@@ -6,7 +6,6 @@ {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures             #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE RecordWildCards            #-} {-# LANGUAGE StandaloneDeriving         #-}@@ -60,7 +59,7 @@   { destination :: Id User -- ^ User ID of a bot that should receive webhook events   , events      :: [Event] -- ^ List of webhook event objects   }-  deriving (Eq, Show, Generic)+  deriving (Show, Generic)  instance FromJSON Events @@ -114,7 +113,7 @@                       , timestamp  :: EpochMilli                       , things     :: Things                       }-  deriving (Eq, Show, Generic)+  deriving (Show, Generic)  instance FromJSON Event where   parseJSON = genericParseJSON defaultOptions@@ -196,24 +195,24 @@ data Source = forall a. Source (Id a)  deriving instance Show Source--instance Eq Source where-  Source (UserId a)  == Source (UserId b)  = a == b-  Source (GroupId a) == Source (GroupId b) = a == b-  Source (RoomId a)  == Source (RoomId b)  = a == b-  _                  == _                  = False+deriving instance Typeable Source  instance FromJSON Source where   parseJSON = withObject "Source" $ \o -> do     messageType <- o .: "type"     case messageType of-      "user"  -> (Source . UserId)  <$> o .: "userId"-      "group" -> (Source . GroupId) <$> o .: "groupId"-      "room"  -> (Source . RoomId)  <$> o .: "roomId"+      "user"  -> Source . UserId  <$> o .: "userId"+      "group" -> Source . GroupId <$> o .: "groupId"+      "room"  -> Source . RoomId  <$> o .: "roomId"       _       -> 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]+ newtype Members = Members { members :: [Source] }-  deriving (Eq, Show, Generic)+  deriving (Show, Generic)  instance FromJSON Members 

@@ -9,6 +9,7 @@ module Line.Bot.ClientSpec (spec) where  import           Control.Arrow                    (left)+import           Control.DeepSeq                  (NFData) import           Control.Monad                    ((>=>)) import           Control.Monad.Free import           Control.Monad.Trans.Reader       (runReaderT)@@ -30,9 +31,9 @@                                                           requestHeaders) import           Network.Wai.Handler.Warp         (Port, withApplication) import           Servant-import           Servant.Client 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)@@ -83,7 +84,7 @@ token :: ChannelToken token = "fake" -runLine :: Line a -> Port -> IO (Either ServantError a)+runLine :: NFData a => Line a -> Port -> IO (Either ClientError a) runLine comp port = withPort port $ runClientM $ runReaderT comp token  app :: Application