line-bot-sdk 0.2.0.0 → 0.3.0.0
raw patch · 7 files changed
+125/−48 lines, 7 filesdep +http-api-data
Dependencies added: http-api-data
Files
- line-bot-sdk.cabal +4/−2
- src/Line/Bot/Client.hs +21/−31
- src/Line/Bot/Client/Auth.hs +28/−0
- src/Line/Bot/Endpoints.hs +15/−1
- src/Line/Bot/Types.hs +41/−1
- src/Line/Bot/Webhook.hs +5/−3
- src/Line/Bot/Webhook/Events.hs +11/−10
line-bot-sdk.cabal view
@@ -1,5 +1,5 @@ name: line-bot-sdk-version: 0.2.0.0+version: 0.3.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@@ -18,7 +18,7 @@ of the following modules: . * A client library for the <https://developers.line.biz/en/docs/messaging-api/ LINE Messaging API>,- including the 'Line' monad, which manages the channel credentials.+ including the 'Line' monad, which manages the channel credentials. . * A servant combinator to write safe Line webhooks. .@@ -33,6 +33,7 @@ , Line.Bot.Types other-modules: Line.Bot.Endpoints+ , Line.Bot.Client.Auth build-depends: base >= 4.7 && < 5 , aeson >= 1.4.2 && < 1.5@@ -46,6 +47,7 @@ , errors >= 2.3.0 && < 2.4 , http-client >= 0.5.14 && < 0.7 , http-types >= 0.12.2 && < 0.13+ , http-api-data >= 0.4 && < 0.5 , http-client-tls >= 0.3.5 && < 0.4 , servant >= 0.15 && < 0.16 , string-conversions >= 0.4.0 && < 0.5
src/Line/Bot/Client.hs view
@@ -4,7 +4,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- |@@ -33,31 +32,26 @@ , getContent -- ** Account Link , issueLinkToken+ -- ** OAuth+ , issueChannelToken+ , revokeChannelToken ) where -import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)-import Data.ByteString.Lazy (ByteString)-import Data.Monoid ((<>))+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)+import Data.ByteString.Lazy (ByteString) import Data.Proxy import Data.String-import Data.Text as T+import Data.Text as T+import Line.Bot.Client.Auth import Line.Bot.Endpoints import Line.Bot.Types-import Network.HTTP.Client (newManager)-import Network.HTTP.Client.TLS (tlsManagerSettings)-import Servant.API hiding (addHeader)+import Network.HTTP.Client (newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Servant.API hiding (addHeader) import Servant.Client-import Servant.Client.Core.Internal.Auth (AuthClientData,- AuthenticatedRequest,- mkAuthenticatedRequest)-import Servant.Client.Core.Internal.Request (Request, addHeader)-import Servant.Server.Experimental.Auth (AuthHandler,- AuthServerData,- mkAuthHandler) - host :: BaseUrl host = BaseUrl Https "api.line.me" 443 "" @@ -65,11 +59,7 @@ -- OAuth access token for a channel type Line = ReaderT ChannelToken ClientM -type Auth = AuthenticatedRequest (AuthProtect ChannelAuth)--type instance AuthClientData (AuthProtect ChannelAuth) = ChannelToken--defaultClient:: ClientM a -> IO (Either ServantError a)+defaultClient :: ClientM a -> IO (Either ServantError a) defaultClient comp = do manager <- newManager tlsManagerSettings runClientM comp (mkClientEnv manager host)@@ -86,12 +76,6 @@ -> IO (Either ServantError a) runLineWith f comp token = f $ runReaderT comp token -mkAuth :: ChannelToken -> Auth-mkAuth token = mkAuthenticatedRequest token addAuthHeader- where- addAuthHeader :: ChannelToken -> Request -> Request- addAuthHeader = addHeader "Authorization"- getProfile' :: Auth -> Id User -> ClientM Profile getGroupMemberProfile' :: Auth -> Id Group -> Id User -> ClientM Profile@@ -108,10 +92,14 @@ multicastMessage' :: Auth -> MulticastMessageBody -> ClientM NoContent -getContent' :: Auth -> String -> ClientM ByteString+getContent' :: Auth -> MessageId -> ClientM ByteString issueLinkToken' :: Auth -> Id User -> ClientM LinkToken +issueChannelToken :: ClientCredentials -> ClientM ShortLivedChannelToken++revokeChannelToken :: ChannelToken -> ClientM NoContent+ getProfile' :<|> getGroupMemberProfile' :<|> leaveGroup'@@ -121,7 +109,9 @@ :<|> pushMessage' :<|> multicastMessage' :<|> getContent'- :<|> issueLinkToken' = client (Proxy :: Proxy Endpoints)+ :<|> issueLinkToken'+ :<|> issueChannelToken+ :<|> revokeChannelToken = client (Proxy :: Proxy Endpoints) getProfile :: Id User -> Line Profile getProfile a = ask >>= \token -> lift $ getProfile' (mkAuth token) a@@ -153,7 +143,7 @@ >>= \token -> lift $ multicastMessage' (mkAuth token) body where body = MulticastMessageBody a ms -getContent :: String -> Line ByteString+getContent :: MessageId -> Line ByteString getContent a = ask >>= \token -> lift $ getContent' (mkAuth token) a issueLinkToken :: Id User -> Line LinkToken
+ src/Line/Bot/Client/Auth.hs view
@@ -0,0 +1,28 @@+{-# 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 Auth = AuthenticatedRequest (AuthProtect ChannelAuth)++type instance AuthClientData (AuthProtect ChannelAuth) = ChannelToken++mkAuth :: ChannelToken -> Auth+mkAuth token = mkAuthenticatedRequest token addAuthorizationHeader+ where+ addAuthorizationHeader :: ChannelToken -> Request -> Request+ addAuthorizationHeader = addHeader hAuthorization
src/Line/Bot/Endpoints.hs view
@@ -74,7 +74,7 @@ type GetContent = AuthProtect ChannelAuth :> "message"- :> Capture "messageId" String+ :> Capture "messageId" MessageId :> "content" :> Get '[OctetStream] ByteString @@ -84,6 +84,18 @@ :> "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@@ -95,4 +107,6 @@ :<|> MulticastMessage :<|> GetContent :<|> IssueLinkToken+ :<|> IssueChannelToken+ :<|> RevokeChannelToken )
src/Line/Bot/Types.hs view
@@ -8,6 +8,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-}@@ -23,6 +24,7 @@ , ChannelSecret(..) , ChatType(..) , Id(..)+ , MessageId , URL(..) , Message(..) , ReplyToken(..)@@ -34,6 +36,8 @@ , QuickReply(..) , QuickReplyButton(..) , Action(..)+ , ClientCredentials(..)+ , ShortLivedChannelToken(..) ) where @@ -43,27 +47,38 @@ 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.Encoding import GHC.Generics hiding (to) import Servant.API import Text.Show+import Web.FormUrlEncoded (ToForm (..)) newtype ChannelToken = ChannelToken Text- deriving (Eq)+ deriving (Eq, Show, Generic) +instance FromJSON ChannelToken+ instance IsString ChannelToken where fromString s = ChannelToken (fromString s) instance ToHttpApiData ChannelToken where toQueryParam (ChannelToken t) = "Bearer " <> t +instance ToForm ChannelToken where+ toForm (ChannelToken t) = [ ("access_token", t) ]+ newtype ChannelSecret = ChannelSecret { unChannelSecret :: B.ByteString } instance IsString ChannelSecret where fromString s = ChannelSecret (B.pack s) +instance ToHttpApiData ChannelSecret where+ toQueryParam = decodeUtf8 . unChannelSecret+ data ChatType = User | Group | Room -- | ID of a chat user, group or room@@ -93,6 +108,8 @@ instance FromJSON (Id Room) where parseJSON = withText "Id Room" $ return . RoomId +type MessageId = Text+ newtype URL = URL Text deriving (Show, Eq, Generic) @@ -252,3 +269,26 @@ Just s -> fmap toLower s Nothing -> orig }++type ChannelId = Id User++data ClientCredentials = ClientCredentials+ { clientId :: ChannelId+ , clientSecret :: ChannelSecret+ }++instance ToForm ClientCredentials where+ toForm ClientCredentials{..} =+ [ ("grant_type", "client_credentials")+ , ("client_id", toQueryParam clientId)+ , ("client_secret", toQueryParam clientSecret)+ ]++data ShortLivedChannelToken = ShortLivedChannelToken+ { accessToken :: ChannelToken+ , expiresIn :: Int+ } deriving (Eq, Show, Generic)++instance FromJSON ShortLivedChannelToken where+ parseJSON = genericParseJSON defaultOptions+ { fieldLabelModifier = camelTo2 '_' }
src/Line/Bot/Webhook.hs view
@@ -46,9 +46,11 @@ import Servant.API.ContentTypes import Servant.Server.Internal -+-- | This type alias just specifies how webhook requests should be handled type Webhook = LineReqBody '[JSON] Events :> Post '[JSON] NoContent +-- | A Servant combinator that extracts the request body as a value of type a+-- and performs signature valiadation data LineReqBody (contentTypes :: [*]) (a :: *) deriving (Typeable) @@ -87,8 +89,8 @@ hSignature = "X-Line-Signature" validateReqBody :: Maybe B.ByteString -> BL.ByteString -> Bool- validateReqBody digest body = maybe False f digest'+ validateReqBody digest body = maybe False (== SHA256.hmaclazy secret body) digest' where digest' = Base64.decodeLenient <$> digest- f = (== SHA256.hmaclazy (unChannelSecret channelSecret) body)+ secret = unChannelSecret channelSecret
src/Line/Bot/Webhook/Events.hs view
@@ -52,13 +52,14 @@ data Events = Events- { destination :: Id User- , events :: [Event]+ { destination :: Id User -- ^ User ID of a bot that should receive webhook events+ , events :: [Event] -- ^ List of webhook event objects } deriving (Eq, Show, Generic) instance FromJSON Events +-- | Events generated on the LINE Platform. data Event = EventMessage { replyToken :: ReplyToken , message :: Message@@ -119,32 +120,33 @@ , constructorTagModifier = (\(x : xs) -> toLower x : xs) . drop 5 } + data Message =- Text { messageId :: Text+ Text { messageId :: MessageId , text :: Text }- | Image { messageId :: Text+ | Image { messageId :: MessageId , contentProvider :: ContentProvider }- | Video { messageId :: Text+ | Video { messageId :: MessageId , duration :: Int , contentProvider :: ContentProvider }- | Audio { messageId :: Text+ | Audio { messageId :: MessageId , duration :: Int , contentProvider :: ContentProvider }- | File { messageId :: Text+ | File { messageId :: MessageId , fileSize :: Int , fileName :: Text }- | Location { messageId :: Text+ | Location { messageId :: MessageId , title :: Text , address :: Text , latitude :: Double , longitude :: Double }- | Sticker { messageId :: Text+ | Sticker { messageId :: MessageId , packageId :: Text , stickerId :: Text }@@ -190,7 +192,6 @@ . fromRational . toRational . (/ 1000)- data Source = SourceUser (Id User)