diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,27 @@ +## Webex-teams-api 0.2.0.0 + +* First release of webex-teams-api. +* Module name was changed but most of functions remain same. +* Some key type classes with type families changed. +* Streaming API is moved to separate packages. +* Old streaming API is still available but deprecated. + +## Cisco-spark-api 0.1.0.4 + +* Final release of cisco-spark-api package. + +## Cisco-spark-api 0.1.0.3 + +* Cisco Spark is now Cisco Webex Teams. + +## Cisco-spark-api 0.1.0.2 + +* Catch up to conduit-1.3.0. + +## Cisco-spark-api 0.1.0.1 + +* Put explicit upper bound for conduit. + +## Cisco-spark-api 0.1.0.0 + +* Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2017,2018 Naoto Shimazaki + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,86 @@ +# webex-teams-api + +[![License: MIT](https://img.shields.io/badge/License-MIT-brightgreen.svg)](https://opensource.org/licenses/MIT) +[![Build Status](https://travis-ci.org/nshimaza/webex-teams-api.svg?branch=master)](https://travis-ci.org/nshimaza/webex-teams-api) +[![Hackage](https://img.shields.io/hackage/v/webex-teams-api.svg?style=flat)](https://hackage.haskell.org/package/webex-teams-api) +[![Stackage Nightly](http://stackage.org/package/webex-teams-api/badge/nightly)](http://stackage.org/nightly/package/webex-teams-api) +[![Stackage LTS](http://stackage.org/package/webex-teams-api/badge/lts)](http://stackage.org/lts/package/webex-teams-api) + +A Haskell bindings for Cisco Webex Teams (formerly Cisco Spark) API + +Webex-teams-api (formerly cisco-spark-api) package provides types and functions +for accessing Cisco Webex Teams REST API. Details of the API is available +from [developer site of Cisco Webex](https://developer.webex.com/) + +This package is designed to improve type safety over the API. Each entity is +separately typed. JSON messages contained in REST responses are decoded into +appropriate type of Haskell record. JSON messages sent in REST requests are +encoded only from correct type of record. + +Some Webex Teams REST API return list of objects. Those APIs require HTTP Link +Header based pagination. Haskell functions for those APIs automatically request +subsequent pages as needed. This repo provides optional packages for streaming +response of list API. Webex-teams-conduit and webex-teams-pipes are thin +wrappers of list API. They transform chunky response from list API into +seamless stream of elements. + +This package also provides some sample usage in command line application style. +See source under app directory of the source package. + +### Sample Usage + +Sending a message to a Room. + +```haskell + let auth = Authorization "your authorization token" + roomId = RoomId "Room ID your message to be sent" + messageText = MessageText "your message" + message = CreateMessage (Just roomId) Nothing Nothing (Just messageText) Nothing Nothing + createEntity auth def createMessage >>= print . getResponseBody +``` + +Following example is calling List Membership API which returns membership between +Rooms and users (Person). You can extract each Membership from +Conduit pipe. The `streamListWithFilter`, provided by webex-teams-conduit, +automatically performs pagenation when it is asked more element and last +response had link of subsequent page in HTTP Link Header. + +```haskell + let auth = Authorization "your authorization token" + filter = MembershipFilter yourRoomId Nothing Nothing + runConduit $ streamListWithFilter auth def filter .| takeC 200 .| mapM_C print +``` + +You can find more examples in app/Main.hs under webex-teams-pipes or +webex-teams-conduit. + +### Support for Lens + +This package provides many of records representing objects communicated via +Webex Teams REST API. Those records are designed to allow create lenses by +Control.Lens.TH.makeFields. + +Following example creates overloaded accessors for 'Person', 'Room' and 'Team'. + +```haskell +makeFields ''Person +makeFields ''Room +makeFields ''Team +``` + +You can access 'personId', 'roomId' and 'teamId' via overloaded accessor +function 'id' like this. + +```haskell + let yourPersonId = yourPerson ^. id + yourRoomId = yourRoom ^. id + yourTeamId = yourTeam ^. id +``` + +This package does not provide pre-generated lenses for you because not everyone +need it but you can make it by yourself so easily as described. + +### Limitation + +- WebHook API is not yet implemented. +- Relative reference in Link Header is not recognized as next page diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,371 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Data.ByteString.Char8 as BC8 (pack) +import Data.Default (def) +import Data.Foldable (traverse_) +import Data.Semigroup ((<>)) +import Data.Text as T (pack) +import Network.HTTP.Simple (getResponseBody) +import Options.Applicative +import System.Environment (lookupEnv) +import System.IO (hPutStrLn, stderr) + +import Network.WebexTeams + +main :: IO () +main = lookupEnv "WEBEXTEAMS_AUTH" >>= runIfEnvFound + where + runIfEnvFound Nothing = hPutStrLn stderr "Missing WEBEXTEAMS_AUTH. Set Webex Teams authorization string to WEBEXTEAMS_AUTH environment variable." + runIfEnvFound (Just s) = do + opts <- execParser programOptions + print opts + run (Authorization $ BC8.pack s) opts + +run :: Authorization -> Command -> IO () +run auth (PersonListCommand count filter) = + take count <$> (getListWithFilter auth def filter >>= readAllList) >>= traverse_ print + +run auth (RoomListCommand count filter) = + take count <$> (getListWithFilter auth def filter >>= readAllList) >>= traverse_ print + +run auth (MembershipListCommand count filter) = + take count <$> (getListWithFilter auth def filter >>= readAllList) >>= traverse_ print + +run auth (MessageListCommand count filter) = + take count <$> (getListWithFilter auth def filter >>= readAllList) >>= traverse_ print + +run auth (TeamMembershipListCommand count filter) = + take count <$> (getListWithFilter auth def filter >>= readAllList) >>= traverse_ print + +run auth (TeamListCommand count) = + take count <$> (getTeamList auth def >>= readAllList) >>= traverse_ print + +run auth (PersonDetailCommand personId) = + getDetail auth def personId >>= print . getResponseBody + +run auth (RoomDetailCommand roomId) = + getDetail auth def roomId >>= print . getResponseBody + +run auth (MembershipDetailCommand membershipId) = + getDetail auth def membershipId >>= print . getResponseBody + +run auth (MessageDetailCommand messageId) = + getDetail auth def messageId >>= print . getResponseBody + +run auth (CreateMessageCommand roomId messageText) = + createEntity auth def message >>= print . getResponseBody + where + message = CreateMessage (Just roomId) Nothing Nothing (Just messageText) Nothing Nothing + +run auth (DeleteMessageCommand messageId) = + deleteMessage auth def messageId >>= print . getResponseBody + +run auth (TeamDetailCommand teamId) = + getDetail auth def teamId >>= print . getResponseBody + +run auth (TeamMembershipDetailCommand teamMembershipId) = + getDetail auth def teamMembershipId >>= print . getResponseBody + +run auth (CreateRoomCommand createRoom) = + createEntity auth def createRoom >>= print . getResponseBody + +run auth (DeleteRoomCommand roomId) = + deleteRoom auth def roomId >>= print . getResponseBody + +{- + NOTE: `readAllList` gets entire list of API response eagerly. + It is recommended to use streaming API provided by webex-teams-conduit or + webex-teams-pipes instead of this way. +-} +readAllList :: ListReader i -> IO [i] +readAllList reader = go [] + where + go xs = reader >>= \chunk -> case chunk of + [] -> pure xs + ys -> go (xs <> ys) + +{- + Command line parser +-} +data Command + = PersonListCommand Int PersonFilter + | PersonDetailCommand PersonId + | RoomListCommand Int RoomFilter + | RoomDetailCommand RoomId + | CreateRoomCommand CreateRoom + | DeleteRoomCommand RoomId + | MembershipListCommand Int MembershipFilter + | MembershipDetailCommand MembershipId + | MessageListCommand Int MessageFilter + | MessageDetailCommand MessageId + | CreateMessageCommand RoomId MessageText + | DeleteMessageCommand MessageId + | TeamListCommand Int + | TeamDetailCommand TeamId + | TeamMembershipListCommand Int TeamMembershipFilter + | TeamMembershipDetailCommand TeamMembershipId + deriving (Show) + + +{- + Common command line option parsers +-} +countParser :: Int -> Parser Int +countParser defaultCount = option auto + ( long "count" + <> short 'c' + <> metavar "MAX_ITEMS" + <> value (if defaultCount == def then maxBound else defaultCount) + <> help "Maximum number of items to print" + ) + +roomIdParser :: Parser RoomId +roomIdParser = RoomId . T.pack <$> strArgument + ( metavar "ROOM_ID" + <> help "Identifier of a room") + +emailOptParser :: Parser Email +emailOptParser = Email . T.pack <$> strOption + ( long "email" + <> short 'e' + <> metavar "EMAIL_ADDRESS" + <> help "An email address to filter result" + ) + +teamIdOptParser :: Parser TeamId +teamIdOptParser = TeamId . T.pack <$> strOption + ( long "team" + <> short 't' + <> metavar "TEAM_ID" + <> help "Identifier of a team" + ) + +{- + Person specific command line option parsers +-} +displayNameParser :: Parser DisplayName +displayNameParser = DisplayName . T.pack <$> strOption + ( long "name" + <> short 'n' + <> metavar "DISPLAY_NAME" + <> help "Display name of the person to look up" + ) + +organizationIdOptParser :: Parser OrganizationId +organizationIdOptParser = OrganizationId . T.pack <$> strOption + ( long "org" + <> short 'o' + <> metavar "ORGANIZATION_ID" + <> help "Identifier of a organization to be searched" + ) + +personListOptParser :: Parser Command +personListOptParser = PersonListCommand <$> countParser def + <*> (PersonFilter <$> optional emailOptParser + <*> optional displayNameParser + <*> optional organizationIdOptParser) + +personDetailOptParser :: Parser Command +personDetailOptParser = PersonDetailCommand <$> (PersonId . T.pack <$> strArgument + ( metavar "PERSON_ID" + <> help "Identifier of a person" + )) + +{- + Room specific command line option parsers +-} +roomTypeParser :: Parser (Maybe RoomType) +roomTypeParser + = flag Nothing (Just RoomTypeDirect) + ( long "direct" + <> short 'd' + <> help "Filter only one-to-one space") + <|> flag Nothing (Just RoomTypeGroup) + ( long "group" + <> short 'g' + <> help "Filter only group space") + +roomSortByParser :: Parser (Maybe RoomFilterSortBy) +roomSortByParser + = flag Nothing (Just RoomFilterSortById) + ( long "sort-by-id" + <> help "Sort by room ID") + <|> flag Nothing (Just RoomFilterSortByLastActivity) + ( long "sort-by-last-activity" + <> help "Sort by most recent activity") + <|> flag Nothing (Just RoomFilterSortByCreated) + ( long "sort-by-created" + <> help "Sort by most recentlly created") + +roomTitleParser :: Parser RoomTitle +roomTitleParser = RoomTitle . T.pack <$> strArgument + ( metavar "ROOM_TITLE" + <> help "A user-friendly name for the room") + +roomListOptParser :: Parser Command +roomListOptParser = RoomListCommand <$> countParser def + <*> (RoomFilter <$> optional teamIdOptParser + <*> roomTypeParser + <*> roomSortByParser) + +roomDetailOptParser :: Parser Command +roomDetailOptParser = RoomDetailCommand <$> roomIdParser + +createRoomOptParser :: Parser Command +createRoomOptParser = CreateRoomCommand <$> (CreateRoom <$> roomTitleParser + <*> optional teamIdOptParser) +deleteRoomOptParser :: Parser Command +deleteRoomOptParser = DeleteRoomCommand <$> roomIdParser + + +{- + Membership specific command line option parsers +-} +roomIdOptParser :: Parser RoomId +roomIdOptParser = RoomId . T.pack <$> strOption + ( long "room" + <> short 'r' + <> metavar "ROOM_ID" + <> help "Identifier of a room to be searched" + ) + +personIdOptParser :: Parser PersonId +personIdOptParser = PersonId . T.pack <$> strOption + ( long "person" + <> short 'p' + <> metavar "PERSON_ID" + <> help "Identifier of a person to filter result" + ) + +membershipListOptParser :: Parser Command +membershipListOptParser = MembershipListCommand <$> countParser def + <*> (MembershipFilter <$> optional roomIdOptParser + <*> optional personIdOptParser + <*> optional emailOptParser) + +membershipDetailOptParser :: Parser Command +membershipDetailOptParser = MembershipDetailCommand <$> (MembershipId . T.pack <$> strArgument + ( metavar "MEMBERSHIP_ID" + <> help "Identifier of a membership" + )) + +{- + Message specific command line option parsers +-} +mentionedPeopleParser :: Parser (Maybe MentionedPeople) +mentionedPeopleParser + = flag Nothing (Just MentionedPeopleMe) + ( long "me" + <> help "List messages where the caller is mentioned" + ) + <|> optional (MentionedPeople . PersonId . T.pack <$> strOption + ( long "mentioned-person" + <> short 'p' + <> metavar "PERSON_ID" + <> help "List messages where the specified persionId is mentioned" + ) + ) + +beforeOptParser :: Parser Timestamp +beforeOptParser = Timestamp . T.pack <$> strOption + ( long "before" + <> short 'b' + <> metavar "TIMESTAMP" + <> help "List messages sent before a date and time, in ISO8601 format" + ) + +beforeMessageOptParser :: Parser MessageId +beforeMessageOptParser = MessageId . T.pack <$> strOption + ( long "before-message" + <> short 'm' + <> metavar "MESSAGE_ID" + <> help "List messages sent before a message, by ID" + ) + +messageListOptParser :: Parser Command +messageListOptParser = MessageListCommand <$> countParser 10 + <*> (MessageFilter <$> roomIdParser + <*> mentionedPeopleParser + <*> optional beforeOptParser + <*> optional beforeMessageOptParser + ) + +messageIdParser :: Parser MessageId +messageIdParser = MessageId . T.pack <$> strArgument + ( metavar "MESSAGE_ID" + <> help "Identifier of a message") + +messageDetailOptParser :: Parser Command +messageDetailOptParser = MessageDetailCommand <$> messageIdParser + +messageTextParser :: Parser MessageText +messageTextParser = MessageText . T.pack <$> strArgument + ( metavar "MESSAGE_TEXT" + <> help "Body of message in text" + ) + +createMessageOptParser :: Parser Command +createMessageOptParser = CreateMessageCommand <$> roomIdParser <*> messageTextParser + +deleteMessageOptParser :: Parser Command +deleteMessageOptParser = DeleteMessageCommand <$> messageIdParser + +{- + Team specific command line option parsers +-} +teamIdParser :: Parser TeamId +teamIdParser = TeamId . T.pack <$> strArgument + ( metavar "TEAM_ID" + <> help "Identifier of a team" + ) + +teamListOptParser :: Parser Command +teamListOptParser = TeamListCommand <$> countParser def + +teamDetailOptParser :: Parser Command +teamDetailOptParser = TeamDetailCommand <$> teamIdParser + +{- + Team membership specific command line option parsers +-} +teamMembershipListOptParser :: Parser Command +teamMembershipListOptParser = TeamMembershipListCommand <$> countParser def + <*> (TeamMembershipFilter <$> teamIdParser) + +teamMembershipDetailOptParser :: Parser Command +teamMembershipDetailOptParser = TeamMembershipDetailCommand <$> (TeamMembershipId . T.pack <$> strArgument + ( metavar "TEAM_MEMBERSHIP_ID" + <> help "Identifier of a team membership" + )) + +{- + Top level parsers +-} +commandSubParser :: Parser Command +commandSubParser = hsubparser + ( command "person-list" (info personListOptParser (progDesc "List people")) + <> command "person-detail" (info personDetailOptParser (progDesc "Get detail for a person by ID")) + <> command "room-list" (info roomListOptParser (progDesc "List belonging spaces")) + <> command "room-detail" (info roomDetailOptParser (progDesc "Get detail for a team by ID")) + <> command "create-room" (info createRoomOptParser (progDesc "Create a room")) + <> command "delete-room" (info deleteRoomOptParser (progDesc "Delete a room")) + <> command "membership-list" (info membershipListOptParser (progDesc "List memberships of authenticated user")) + <> command "membership-detail" (info membershipDetailOptParser (progDesc "Get detail for a membership by ID")) + <> command "message-list" (info messageListOptParser (progDesc "List messages in a room")) + <> command "message-detail" (info messageDetailOptParser (progDesc "Get detail for a message by ID")) + <> command "create-message" (info createMessageOptParser (progDesc "Send a message to a room")) + <> command "delete-message" (info deleteMessageOptParser (progDesc "Delete a message")) + <> command "team-list" (info teamListOptParser (progDesc "List belonging teams")) + <> command "team-detail" (info teamDetailOptParser (progDesc "Get detail for a team by ID")) + <> command "team-membership-list" (info teamMembershipListOptParser (progDesc "List team memberships of authenticated user")) + <> command "team-membership-detail" (info teamMembershipDetailOptParser (progDesc "Get detail for a team membership by ID")) + ) + +programOptions :: ParserInfo Command +programOptions = info (commandSubParser <**> helper) + ( fullDesc + <> progDesc "Sample porgram demonstrating how to use webex-teams-api" + <> header "webex-teams-api-exe -- Sample porgram demonstrating how to use webex-teams-api" + ) diff --git a/src/Network/CiscoSpark.hs b/src/Network/CiscoSpark.hs new file mode 100644 --- /dev/null +++ b/src/Network/CiscoSpark.hs @@ -0,0 +1,6 @@ +module Network.CiscoSpark {-# DEPRECATED "Use Network.WebexTeams" #-} + ( + module Network.WebexTeams + ) where + +import Network.WebexTeams diff --git a/src/Network/CiscoSpark/Internal.hs b/src/Network/CiscoSpark/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/CiscoSpark/Internal.hs @@ -0,0 +1,6 @@ +module Network.CiscoSpark.Internal {-# DEPRECATED "Use Network.WebexTeams.Internal" #-} + ( + module Network.WebexTeams.Internal + ) where + +import Network.WebexTeams.Internal diff --git a/src/Network/CiscoSpark/Types.hs b/src/Network/CiscoSpark/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/CiscoSpark/Types.hs @@ -0,0 +1,6 @@ +module Network.CiscoSpark.Types {-# DEPRECATED "Use Network.WebexTeams.Types" #-} + ( + module Network.WebexTeams.Types + ) where + +import Network.WebexTeams.Types diff --git a/src/Network/WebexTeams.hs b/src/Network/WebexTeams.hs new file mode 100644 --- /dev/null +++ b/src/Network/WebexTeams.hs @@ -0,0 +1,541 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Network.WebexTeams +Copyright : (c) Naoto Shimazaki 2017,2018 +License : MIT (see the file LICENSE) + +Maintainer : https://github.com/nshimaza +Stability : experimental + +This module provides types and functions for accessing Cisco Webex Teams REST API. + +The module is designed to improve type safety over the API. Each entity is separately typed. +JSON messages contained in REST responses are decoded into appropriate type of Haskell record. +JSON messages sent in REST requests are encoded only from correct type of record. + +Some Webex Teams REST API return list of objects. Those APIs require HTTP Link Header based pagination. +Haskell functions for those APIs automatically request subsequent pages as needed. + += Examples + +@ + -- Sending a message to a room. + let auth = Authorization "your authorization token" + roomId = RoomId "Room ID your message to be sent" + messageText = MessageText "your message" + message = CreateMessage (Just roomId) Nothing Nothing (Just messageText) Nothing Nothing + createEntity auth def createMessage >>= print . getResponseBody + + -- Obtaining detail of a user. + let personId = PersonId "your person ID" + getDetail auth def personId >>= print . getResponseBody + + -- Obtaining membership of a room as stream of object representing each membership relation. + let filter = MembershipFilter yourRoomId Nothing Nothing + runConduit $ streamListWithFilter auth def filter .| takeC 200 .| mapM_C print + + -- Create a room. + let createRoom = CreateRoom "Title of the new room" Nothing + createEntity auth def createRoom >>= print . getResponseBody + + -- Delete a room. + deleteRoom auth def roomId >>= print . getResponseBody +@ + += List and steaming + +The 'WebexTeams' module doesn't provide streaming API for REST response returning list of entities. +It is because the author of the package wants to keep it streaming library agnostic. Instead, it provides +'ListReader' IO action to read list responses with automatic pagenation. Streaming APIs can be found in +separate packages like webex-teams-pipes or webex-teams-conduit. + += Support for Lens + +This package provides many of records representing objects communicated via Webex Teams REST API. +Those records are designed to allow create lenses by Control.Lens.TH.makeFields. + +Following example creates overloaded accessors for 'Person', 'Room' and 'Team'. + +@ +makeFields ''Person +makeFields ''Room +makeFields ''Team +@ + +You can access 'personId', 'roomId' and 'teamId' via overloaded accessor function 'id' like this. + +@ + let yourPersonId = yourPerson ^. id + yourRoomId = yourRoom ^. id + yourTeamId = yourTeam ^. id +@ + +This package does not provide pre-generated lenses for you because not everyone need it +but you can make it by yourself so easily as described. + + +-} +module Network.WebexTeams + ( + -- * Types + -- ** Class and Type Families + WebexTeamsFilter + , WebexTeamsListItem + , ToResponse + -- ** Common Types + , Authorization (..) + , CiscoSparkRequest (..) + , WebexTeamsRequest (..) + , Timestamp (..) + , ErrorCode (..) + , ErrorTitle (..) + , Errors (..) + -- ** People related types + , Person (..) + , PersonId (..) + , Email (..) + , DisplayName (..) + , NickName (..) + , FirstName (..) + , LastName (..) + , AvatarUrl (..) + , Timezone (..) + , PersonStatus (..) + , PersonType (..) + , PersonList (..) + , PersonFilter (..) + , CreatePerson (..) + , UpdatePerson (..) + -- ** Room related types + , Room (..) + , RoomId (..) + , RoomTitle (..) + , RoomType (..) + , SipAddr (..) + , RoomList (..) + , RoomFilter (..) + , RoomFilterSortBy (..) + , CreateRoom (..) + , UpdateRoom (..) + -- ** Membership related types + , Membership (..) + , MembershipId (..) + , MembershipList (..) + , MembershipFilter (..) + , CreateMembership (..) + , UpdateMembership (..) + -- ** Message related types + , Message (..) + , MessageId (..) + , MessageText (..) + , MessageHtml (..) + , MessageMarkdown (..) + , FileUrl (..) + , MessageList (..) + , MessageFilter (..) + , MentionedPeople (..) + , CreateMessage (..) + -- ** Team related types + , TeamName (..) + , TeamId (..) + , Team (..) + , TeamList (..) + , CreateTeam (..) + , UpdateTeam (..) + -- ** Team Membership related types + , TeamMembership (..) + , TeamMembershipId (..) + , TeamMembershipList (..) + , TeamMembershipFilter (..) + , CreateTeamMembership (..) + , UpdateTeamMembership (..) + -- ** Organization related types + , Organization (..) + , OrganizationId (..) + , OrganizationDisplayName (..) + , OrganizationList (..) + -- ** License related types + , License (..) + , LicenseId (..) + , LicenseName (..) + , LicenseUnit (..) + , LicenseList (..) + , LicenseFilter (..) + -- ** Role related types + , Role (..) + , RoleId (..) + , RoleName (..) + , RoleList (..) + + -- * Functions + -- ** Getting detail of an entity + , getDetail + , getDetailEither + -- ** Streaming response of List API with auto pagenation + , ListReader + , getListWithFilter + , getTeamList + , getOrganizationList + , getRoleList + , streamEntityWithFilter + , streamTeamList + , streamOrganizationList + , streamRoleList + -- ** Creating an entity + , createEntity + , createEntityEither + -- ** Updating an entity + , updateEntity + , updateEntityEither + -- ** Creating default filter spec from mandatory field + , defaultMessageFilter + , defaultTeamMembershipFilter + -- ** Deleting an entity + , deleteRoom + , deleteMembership + , deleteMessage + , deleteTeam + , deleteTeamMembership + ) where + +import Conduit (ConduitT, yieldMany) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Aeson (FromJSON, ToJSON) +import Data.ByteString (ByteString) +import Data.ByteString.Char8 as C8 (unpack) +import Data.Default (Default (def)) +import Data.IORef (IORef, newIORef, readIORef, + writeIORef) +import Data.Maybe (catMaybes, maybeToList) +import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Network.HTTP.Simple +import Network.URI (URIAuth (..)) + +import Network.WebexTeams.Internal +import Network.WebexTeams.Types + + +-- | Authorization string against Webex Teams API to be contained in HTTP Authorization header of every request. +newtype Authorization = Authorization ByteString deriving (Eq, Show) +-- | Wrapping 'Request' in order to provide easy default value specifically for Webex Teams public API. +data WebexTeamsRequest = WebexTeamsRequest + { webexTeamsRequestRequest :: Request -- ^ Holds pre-set 'Request' for REST API. + , webexTeamsRequestScheme :: String -- ^ Should be "https:" in production. + , webexTeamsRequestAuthority :: URIAuth -- ^ Authority part of request URI. + } deriving (Show) + +-- | Type synonym for backward compatibility. +type CiscoSparkRequest = WebexTeamsRequest + +-- | Common part of 'Request' against Webex Teams API. +webexTeamsBaseRequest :: Request +webexTeamsBaseRequest + = addRequestHeader "Content-Type" "application/json; charset=utf-8" + $ setRequestPort 443 + $ setRequestHost "api.ciscospark.com" + $ setRequestSecure True + $ defaultRequest + +-- | Default parameters for HTTP request to Webex Teams REST API. +instance Default WebexTeamsRequest where + def = WebexTeamsRequest webexTeamsBaseRequest "https:" $ URIAuth "" "api.ciscospark.com" "" + +-- | Add given Authorization into request header. +addAuthorizationHeader :: Authorization -> Request -> Request +addAuthorizationHeader (Authorization auth) = addRequestHeader "Authorization" ("Bearer " <> auth) + + +-- | Building common part of 'Request' for List APIs. +makeCommonListReq + :: WebexTeamsRequest -- ^ Common request components + -> ByteString -- ^ API category part of REST URL path + -> WebexTeamsRequest +makeCommonListReq base@WebexTeamsRequest { webexTeamsRequestRequest = req } path + = base { webexTeamsRequestRequest = setRequestPath ("/v1/" <> path) $ setRequestMethod "GET" req } + +{-| + Common worker function for List APIs. + It accesses List API with given 'Request', unwrap result into list of items, stream them to Conduit pipe + and finally it automatically accesses next page designated via HTTP Link header if available. +-} +streamList :: (MonadIO m, WebexTeamsListItem i) => Authorization -> WebexTeamsRequest -> ConduitT () i m () +streamList auth (WebexTeamsRequest req scheme uriAuth) = do + res <- httpJSON $ addAuthorizationHeader auth req + yieldMany . unwrap $ getResponseBody res + streamListLoop auth res scheme uriAuth + +-- | Processing pagination by HTTP Link header. +streamListLoop :: (MonadIO m, FromJSON a, WebexTeamsListItem i) => Authorization -> Response a -> String -> URIAuth -> ConduitT () i m () +streamListLoop auth res scheme uriAuth + = case getNextUrl res >>= validateUrl scheme uriAuth >>= (\url -> parseRequest $ "GET " <> C8.unpack url) of + Nothing -> pure () + Just nextReq -> do + nextRes <- httpJSON $ addAuthorizationHeader auth nextReq + yieldMany . unwrap $ getResponseBody nextRes + streamListLoop auth nextRes scheme uriAuth + +-- | Get list of entities with query parameter and stream it into Conduit pipe. It automatically performs pagination. +{-# DEPRECATED streamEntityWithFilter "Use getListWithFilter or streamListWithFilter of webex-teams-conduit" #-} +streamEntityWithFilter :: (MonadIO m, WebexTeamsFilter filter, WebexTeamsListItem (ToResponse filter)) + => Authorization + -> WebexTeamsRequest + -> filter + -> ConduitT () (ToResponse filter) m () +streamEntityWithFilter auth base param = + streamList auth $ setQeuryString $ makeCommonListReq base (apiPath param) + where + setQeuryString comm@WebexTeamsRequest { webexTeamsRequestRequest = req } + = comm { webexTeamsRequestRequest = setRequestQueryString (toFilterList param) req } + +-- | List of 'Team' and stream it into Conduit pipe. It automatically performs pagination. +{-# DEPRECATED streamTeamList "Use getTeamList or streamTeamList of webex-teams-conduit" #-} +streamTeamList :: MonadIO m => Authorization -> WebexTeamsRequest -> ConduitT () Team m () +streamTeamList auth base = streamList auth $ makeCommonListReq base teamsPath + +-- | Filter list of 'Organization' and stream it into Conduit pipe. It automatically performs pagination. +{-# DEPRECATED streamOrganizationList "Use getOrganizationList or streamOrganizationList of webex-teams-conduit" #-} +streamOrganizationList :: MonadIO m => Authorization -> WebexTeamsRequest -> ConduitT () Organization m () +streamOrganizationList auth base = streamList auth $ makeCommonListReq base organizationsPath + +-- | List of 'Role' and stream it into Conduit pipe. It automatically performs pagination. +{-# DEPRECATED streamRoleList "Use getRoleList or streamRoleList of webex-teams-conduit" #-} +streamRoleList :: MonadIO m => Authorization -> WebexTeamsRequest -> ConduitT () Role m () +streamRoleList auth base = streamList auth $ makeCommonListReq base rolesPath + +{-| + 'ListReader' is IO action returned by functions for list API ('getListWithFilter', 'getTeamList' etc). + It is containing URL inside to be accessed. When you call the IO action, it accesses to Webex Teams REST API, + parse next page URL if available, then return new IO action. The new IO action contains list of responded items and + new URL for next page so you can call the new IO action to get the next page. + + Following example demonstrates how you can get all items into single list. + +@ + readAllList :: ListReader i -> IO [i] + readAllList reader = go [] + where + go xs = reader >>= \chunk -> case chunk of + [] -> pure xs + ys -> go (xs <> ys) +@ + + Note that this example is only for explaining how 'ListReader' works. Practically you should not do the above + because it eagerly creates entire list. You should use streaming APIs instead. Streaming APIs are available via + webex-teams-conduit and webex-teams-pipes package. +-} +type ListReader a = IO [a] + +{-| + Returns common worker function 'ListReader' for List APIs. + ListReader accesses List API with given 'Request' then return responded list of items. + ListReader also keeps next URL if response is pagenated and next page is available. + Next call of ListReader causes another List API access for the next page. + ListReader returns [] when there is no more page. +-} +getList :: (MonadIO m, WebexTeamsListItem i) => Authorization -> WebexTeamsRequest -> m (ListReader i) +getList auth wxReq = liftIO $ listReader <$> newIORef (Just wxReq) + where + listReader :: WebexTeamsListItem i => IORef (Maybe WebexTeamsRequest) -> ListReader i + listReader wxReqRef = do + maybeReq <- readIORef wxReqRef + case maybeReq of + Nothing -> pure [] + Just (WebexTeamsRequest req scheme uriAuth) -> do + res <- httpJSON $ addAuthorizationHeader auth req + writeIORef wxReqRef $ do + maybeUrl <- getNextUrl res + maybeValidUrl <-validateUrl scheme uriAuth maybeUrl + maybeNextReq <- parseRequest $ "GET " <> C8.unpack maybeValidUrl + pure (WebexTeamsRequest maybeNextReq scheme uriAuth) + rr <- readIORef wxReqRef + pure . unwrap $ getResponseBody res + +-- | Get list with query parameter. +getListWithFilter :: (MonadIO m, WebexTeamsFilter filter, WebexTeamsListItem (ToResponse filter)) + => Authorization + -> WebexTeamsRequest + -> filter + -> m (ListReader (ToResponse filter)) +getListWithFilter auth base param = + getList auth $ setQeuryString $ makeCommonListReq base (apiPath param) + where + setQeuryString comm@WebexTeamsRequest { webexTeamsRequestRequest = req } + = comm { webexTeamsRequestRequest = setRequestQueryString (toFilterList param) req } + +-- | Return 'ListReader' for 'Team'. +getTeamList :: MonadIO m => Authorization -> WebexTeamsRequest -> m (ListReader Team) +getTeamList auth base = getList auth $ makeCommonListReq base teamsPath + +-- | Return 'ListReader' for 'Team'. +getOrganizationList :: MonadIO m => Authorization -> WebexTeamsRequest -> m (ListReader Organization) +getOrganizationList auth base = getList auth $ makeCommonListReq base organizationsPath + +-- | Return 'ListReader' for 'Team'. +getRoleList :: MonadIO m => Authorization -> WebexTeamsRequest -> m (ListReader Role) +getRoleList auth base = getList auth $ makeCommonListReq base rolesPath + +makeCommonDetailReq + :: WebexTeamsRequest -- ^ Common request components. + -> Authorization -- ^ Authorization string against Webex Teams API. + -> ByteString -- ^ API category part of REST URL path. + -> Text -- ^ Identifier string part of REST URL path. + -> Request +makeCommonDetailReq (WebexTeamsRequest base _ _) auth path idStr + = setRequestPath ("/v1/" <> path <> "/" <> encodeUtf8 idStr) + $ setRequestMethod "GET" + $ addAuthorizationHeader auth + $ base + +{-| + Get details of a Webex Teams entity. + + Obtaining detail of an entity identified by key. The key can be a value in one of + following types: 'PersonId', 'RoomId', 'MembershipId', 'MessageId', 'TeamId', 'TeamMembershipId', + 'OrganizationId', 'LicenseId', 'RoleId'. API is automatically selected by type of the key. + A JSONException runtime exception will be thrown on an JSON parse errors. +-} +getDetail :: (MonadIO m, WebexTeamsDetail key) + => Authorization -- ^ Authorization string against Webex Teams API. + -> WebexTeamsRequest -- ^ Predefined part of 'Request' commonly used for Webex Teams API. + -> key -- ^ One of PersonId, RoomId, MembershipId, MessageId, TeamId, TeamMembershipId, + -- OrganizationId, LicenseId and RoleId. + -> m (Response (ToResponse key)) +getDetail auth base entityId = httpJSON $ makeCommonDetailReq base auth (apiPath entityId) (toIdStr entityId) + +-- | Get details of a Webex Teams entity. A Left value will be returned on an JSON parse errors. +getDetailEither :: (MonadIO m, WebexTeamsDetail key) + => Authorization + -> WebexTeamsRequest + -> key + -> m (Response (Either JSONException (ToResponse key))) +getDetailEither auth base entityId = httpJSONEither $ makeCommonDetailReq base auth (apiPath entityId) (toIdStr entityId) + + +makeCommonCreateReq :: ToJSON a => WebexTeamsRequest -> Authorization -> ByteString -> a -> Request +makeCommonCreateReq (WebexTeamsRequest base _ _) auth path body + = setRequestBodyJSON body + $ setRequestPath ("/v1/" <> path) + $ setRequestMethod "POST" + $ addAuthorizationHeader auth + $ base + +{-| + Create a Webex Teams entity with given parameters. + + Creating a new entity of Webex Teams such as space, team, membership or message. + REST API path is automatically selected by type of createParams. + A JSONException runtime exception will be thrown on an JSON parse errors. +-} +createEntity :: (MonadIO m, WebexTeamsCreate createParams) + => Authorization -- ^ Authorization string against Webex Teams API. + -> WebexTeamsRequest -- ^ Predefined part of 'Request' commonly used for Webex Teams API. + -> createParams -- ^ One of 'CreatePerson', 'CreateRoom', 'CreateMembership', 'CreateMessage', + -- 'CreateTeam' and 'CreateTeamMembership'. + -> m (Response (ToResponse createParams)) +createEntity auth base param = httpJSON $ makeCommonCreateReq base auth (apiPath param) param + +-- | Create a Webex Teams entity with given parameters. A Left value will be returned on an JSON parse errors. +createEntityEither :: (MonadIO m, WebexTeamsCreate createParams) + => Authorization + -> WebexTeamsRequest + -> createParams + -> m (Response (Either JSONException (ToResponse createParams))) +createEntityEither auth base param = httpJSONEither $ makeCommonCreateReq base auth (apiPath param) param + + +makeCommonUpdateReq :: ToJSON a => WebexTeamsRequest -> Authorization -> ByteString -> a -> Request +makeCommonUpdateReq (WebexTeamsRequest base _ _) auth path body + = setRequestBodyJSON body + $ setRequestPath ("/v1/" <> path) + $ setRequestMethod "PUT" + $ addAuthorizationHeader auth + $ base + +{-| + Update a Webex Teams entity with given parameters. + + Creating a new entity of Webex Teams such as space, team, or membership. + REST API path is automatically selected by type of updateParams. + A JSONException runtime exception will be thrown on an JSON parse errors. +-} +updateEntity :: (MonadIO m, WebexTeamsUpdate updateParams) + => Authorization -- ^ Authorization string against Webex Teams API. + -> WebexTeamsRequest -- ^ Predefined part of 'Request' commonly used for Webex Teams API. + -> updateParams -- ^ One of 'UpdatePerson', 'UpdateRoom', 'UpdateMembership', + -- 'UpdateTeam' and 'UpdateTeamMembership'. + -> m (Response (ToResponse updateParams)) +updateEntity auth base param = httpJSON $ makeCommonUpdateReq base auth (apiPath param) param + +-- | Update a Webex Teams entity with given parameters. A Left value will be returned on an JSON parse errors. +updateEntityEither :: (MonadIO m, WebexTeamsUpdate updateParams) + => Authorization + -> WebexTeamsRequest + -> updateParams + -> m (Response (Either JSONException (ToResponse updateParams))) +updateEntityEither auth base param = httpJSONEither $ makeCommonUpdateReq base auth (apiPath param) param + + +makeCommonDeleteReq + :: Authorization -- ^ Authorization string against Webex Teams API. + -> Request -- ^ Common request components. + -> ByteString -- ^ API category part of REST URL path. + -> Text -- ^ Identifier string part of REST URL path. + -> Request +makeCommonDeleteReq auth base path idStr + = setRequestPath ("/v1/" <> path <> "/" <> encodeUtf8 idStr) + $ setRequestMethod "DELETE" + $ addAuthorizationHeader auth + $ base + +-- | Polymorphic version of delete. Intentionally not exposed to outside of the module. +deleteEntity :: (MonadIO m, WebexTeamsDetail key) + => Authorization -- ^ Authorization string against Webex Teams API. + -> WebexTeamsRequest -- ^ Predefined part of 'Request' commonly used for Webex Teams API. + -> key -- ^ One of PersonId, RoomId, MembershipId, MessageId, TeamId, TeamMembershipId. + -> m (Response ()) +deleteEntity auth (WebexTeamsRequest base _ _) entityId + = httpNoBody $ makeCommonDeleteReq auth base (apiPath entityId) (toIdStr entityId) + +-- | Deletes a room, by ID. +deleteRoom :: MonadIO m + => Authorization -- ^ Authorization string against Webex Teams API. + -> WebexTeamsRequest -- ^ Predefined part of 'Request' commonly used for Webex Teams API. + -> RoomId -- ^ Identifier of a space to be deleted. + -> m (Response ()) +deleteRoom = deleteEntity + +-- | Deletes a membership, by ID. +deleteMembership :: MonadIO m + => Authorization -- ^ Authorization string against Webex Teams API. + -> WebexTeamsRequest -- ^ Predefined part of 'Request' commonly used for Webex Teams API. + -> MembershipId -- ^ Identifier of a space to be deleted. + -> m (Response ()) +deleteMembership = deleteEntity + +-- | Deletes a message, by ID. +deleteMessage :: MonadIO m + => Authorization -- ^ Authorization string against Webex Teams API. + -> WebexTeamsRequest -- ^ Predefined part of 'Request' commonly used for Webex Teams API. + -> MessageId -- ^ Identifier of a space to be deleted. + -> m (Response ()) +deleteMessage = deleteEntity + +-- | Deletes a team, by ID. +deleteTeam :: MonadIO m + => Authorization -- ^ Authorization string against Webex Teams API. + -> WebexTeamsRequest -- ^ Predefined part of 'Request' commonly used for Webex Teams API. + -> TeamId -- ^ Identifier of a space to be deleted. + -> m (Response ()) +deleteTeam = deleteEntity + +-- | Deletes a teamMembership, by ID. +deleteTeamMembership :: MonadIO m + => Authorization -- ^ Authorization string against Webex Teams API. + -> WebexTeamsRequest -- ^ Predefined part of 'Request' commonly used for Webex Teams API. + -> TeamMembershipId -- ^ Identifier of a space to be deleted. + -> m (Response ()) +deleteTeamMembership = deleteEntity diff --git a/src/Network/WebexTeams/Internal.hs b/src/Network/WebexTeams/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/WebexTeams/Internal.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Network.WebexTeams.Internal +Copyright : (c) Naoto Shimazaki 2017 +License : MIT (see the file LICENSE) + +Maintainer : https://github.com/nshimaza +Stability : experimental + +Implements some internal functions for Cisco Webex Teams API. +-} +module Network.WebexTeams.Internal where + +import Prelude hiding (concat, takeWhile) + +import Control.Applicative ((<|>)) +import Data.Attoparsec.ByteString +import Data.ByteString (ByteString, concat, pack, + singleton) +import Data.ByteString.Char8 (unpack) +import Data.Char (toLower) +import Data.Either (rights) +import Data.Maybe (listToMaybe) +import Data.Word (Word8) + +import Data.BitSetWord8 (member, rfc3986UriReference, + rfc7230QDText, rfc7230QuotedPair, + rfc7230TChar) + +import Network.HTTP.Simple (Response, getResponseHeader) +import Network.URI (URI (..), URIAuth (..), parseURI) + + +{-| + Drop given number of characters from the given 'String' then + change first character of the remaining string to lowercase. + This function is intended to be used for 'fieldLabelModifier' and 'constructorTagModifier' + argument of 'DeriveJSON' from DATA.Aeson.TH. + You can find how this function is used in 'Network.WebexTeams' source code. + +-} +dropAndLow + :: Int -- ^ Number of characters to drop + -> String -- ^ Field name to be modified to JSON field name + -> String +dropAndLow n = toLowerHead . drop n + where + toLowerHead [] = [] + toLowerHead (c:cs) = toLower c : cs + +{- + From here, defining Attoparsec parser of RFC5988 HTTP Link Header. + Link header is defined in RFC5988 https://tools.ietf.org/html/rfc5988. + This parser doesn't parse complete spec of RFC5988 but only parses rel="next" link for simple pagination. + It doesn't parse obs-fold defined in RFC7230 https://tools.ietf.org/html/rfc7230. + It assumes Header in Response never contains CRLF or LF. +-} + +-- | Parsed Link header parameter. Convert only rel param to 'Rel' and keeps other params as-is. +data LinkParam = Rel | Other ByteString deriving (Eq, Show) + +-- | Parsed entire Link header value. It keeps URI-Reference part untouched for farther processing in different way. +data LinkHeader = LinkHeader + { linkHeaderUrl :: ByteString + , linkHeaderParams :: [(LinkParam, ByteString)] + }deriving (Eq, Show) + +-- | Matches to double quote. +dQuote :: Parser Word8 +dQuote = word8 0x22 -- '"' + +-- | Matches to semicolon. +semicolon :: Parser Word8 +semicolon = word8 0x3b -- ';' + +-- | Matches to equal character. +equalChar :: Parser Word8 +equalChar = word8 0x3d -- '=' + +-- | Matches to less-than character. +lessThan :: Parser Word8 +lessThan = word8 0x3c -- '<' + +-- | Matches to greater-than character. +greaterThan :: Parser Word8 +greaterThan = word8 0x3e -- '>' + +-- | Skips white spaces. +skipSpace :: Parser () +skipSpace = skipWhile (\c -> c == 0x20 || c == 0x09) -- white space or tab + +-- | Parse RFC7230 token. +token :: Parser ByteString +token = takeWhile1 (member rfc7230TChar) + +-- | Parse RFC7230 quoted-pair. +quotedPair :: Parser Word8 +quotedPair = word8 0x5c >> satisfy (member rfc7230QuotedPair) + +-- | Parse RFC7230 quoted-string. +quotedString :: Parser ByteString +quotedString = do + dQuote + bss <- many' $ takeWhile1 (member rfc7230QDText) <|> (singleton <$> quotedPair) + dQuote + pure $ concat bss + +-- | Parse a parameter value in Link header. +paramValue :: Parser ByteString +paramValue = quotedString <|> token + +-- | Convert parameter name string to LinkParam. +paramName :: ByteString -> LinkParam +paramName "rel" = Rel +paramName x = Other x + +-- | Parse parameter part of Link header. +param :: Parser (LinkParam, ByteString) +param = do + semicolon + skipSpace + name <- paramName <$> token + skipSpace + equalChar + skipSpace + val <- paramValue + pure (name, val) + +{-| + Attoparsec parser of RFC5988 HTTP Link Header. + Link header is defined in RFC5988 https://tools.ietf.org/html/rfc5988. + This parser doesn't parse complete spec of RFC5988 but only parses rel="next" link for simple pagination. + It doesn't parse obs-fold defined in RFC7230 https://tools.ietf.org/html/rfc7230. + It assumes Header in Response never contains CRLF or LF. +-} + +linkHeader :: Parser LinkHeader +linkHeader = do + skipSpace + lessThan + uri <- takeWhile (member rfc3986UriReference) + greaterThan + skipSpace + params <- many' param + pure $ LinkHeader uri params + +-- | Accept all RFC5988 Link HTTP header, filter first header containing rel="next" param, parse URL part. +extractNextUrl :: [ByteString] -> [ByteString] +extractNextUrl = map linkHeaderUrl . filter isNextRel . rights . map (parseOnly linkHeader) + where + isNextRel = any (\(param, str) -> param == Rel && str == "next") . linkHeaderParams + +-- | Return URL for next page if it exists in given response. +getNextUrl :: Response a -> Maybe ByteString +getNextUrl = listToMaybe . extractNextUrl . getResponseHeader "Link" + +{-| + Validate extracted URL from HTTP Link Header by 'getNextUrl'. + Check if it has same scheme and URI authority as original request. +-} +validateUrl :: String -> URIAuth -> ByteString -> Maybe ByteString +validateUrl scheme uriAuth url = do + uri <- parseURI $ unpack url + auth <- uriAuthority uri + if (uriScheme uri == scheme) && (auth == uriAuth) then pure url else Nothing diff --git a/src/Network/WebexTeams/Types.hs b/src/Network/WebexTeams/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/WebexTeams/Types.hs @@ -0,0 +1,1301 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +{-| +Module : Network.WebexTeams.Types +Copyright : (c) Naoto Shimazaki 2017 +License : MIT (see the file LICENSE) + +Maintainer : https://github.com/nshimaza +Stability : experimental + +This module defines most of types and records used in webex-teams-api package. +Records used for REST communications are designed to be converted from / to JSON using Aeson package. +Those records are also designed to allow create lenses by Control.Lens.TH.makeFields. + +Following example creates overloaded accessors for 'Person', 'Room' and 'Team'. + +@ +makeFields ''Person +makeFields ''Room +makeFields ''Team +@ + +You can access 'personId', 'roomId' and 'teamId' via overloaded accessor function 'id' like this. + +@ + let yourPersonId = yourPerson ^. id + yourRoomId = yourRoom ^. id + yourTeamId = yourTeam ^. id +@ + +This package doesn't pre-generate those lenses for you because it is so easy. +Please create them by yourself as needed. +-} +module Network.WebexTeams.Types where + + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON, ToJSON (..), parseJSON, + withText) +import Data.Aeson.Encoding (string) +import Data.Aeson.TH (constructorTagModifier, + defaultOptions, deriveJSON, + fieldLabelModifier, + omitNothingFields) +import Data.ByteString (ByteString) +import Data.Default (Default (def)) +import Data.Maybe (catMaybes, maybeToList) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) + +import Network.WebexTeams.Internal + + +-- | URL path for people API. +peoplePath :: ByteString +peoplePath = "people" + +-- | URL path for rooms API. +roomsPath :: ByteString +roomsPath = "rooms" + +-- | URL path for memberships API. +membershipsPath :: ByteString +membershipsPath = "memberships" + +-- | URL path for messages API. +messagesPath :: ByteString +messagesPath = "messages" + +-- | URL path for teams API. +teamsPath :: ByteString +teamsPath = "teams" + +-- | URL path for team memberships API. +teamMembershipsPath :: ByteString +teamMembershipsPath = "team/memberships" + +-- | URL path for organizations API. +organizationsPath :: ByteString +organizationsPath = "organizations" + +-- | URL path for licenes API. +licensesPath :: ByteString +licensesPath = "licenses" + +-- | URL path for roles API. +rolesPath :: ByteString +rolesPath = "roles" + +-- | URL path for webhooks API. +webhooksPath :: ByteString +webhooksPath = "webhooks" + + +{-| + WebexTeamsListItem is a type class grouping types with following common usage. + + * It is used for return value of get-detail APIs. + * It is used for element of return value of list APIs. + + WebexTeamsListItem also associates the above type to wrapping list type (e.g. associates 'Person' to 'PersonList'). + Wrapping type (PersonList in this case) is necessary for parsing JSON from REST API but what we are + interested in is bare list such like [Person]. Type family association defined in this class + is used for type translation from type of items to type of wrapper. +-} +class FromJSON (ToList i) => WebexTeamsListItem i where + -- | Associate item type to wrapping list type. + type ToList i :: * + -- | Get bare list from wrapped type which can be parsed directly from JSON. + unwrap :: ToList i -> [i] + +-- | Type class for getting URL path of API category from given type of value. +class WebexTeamsApiPath a where + apiPath :: a -> ByteString + +-- | Type family to associate a type appears in an argument to response type. +class FromJSON (ToResponse a) => WebexTeamsResponse a where + -- | Associate response type to input parameter type such as filter criteria, entity key or create / update parameters. + type ToResponse a :: * + +-- | Extract containing entity ID string from given type of value. +class (WebexTeamsApiPath a, WebexTeamsResponse a) => WebexTeamsDetail a where + toIdStr :: a -> Text + +-- | Convert given filter condition parameter in a concrete type to HTTP query strings. +class (WebexTeamsApiPath a, WebexTeamsResponse a) => WebexTeamsFilter a where + toFilterList :: a -> [(ByteString, Maybe ByteString)] + +-- | Type class for parameter type for create entity API. +class (WebexTeamsApiPath a, WebexTeamsResponse a, ToJSON a) => WebexTeamsCreate a where + +-- | Type class for parameter type for update entity API. +class (WebexTeamsApiPath a, WebexTeamsResponse a, ToJSON a) => WebexTeamsUpdate a where + + +{- + Common type definnitions +-} +-- | Type representing timestamp. For now, it is just copied from API response JSON. +newtype Timestamp = Timestamp Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Error code for element level error potentially contained in List API responses. +newtype ErrorCode = ErrorCode Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +{-| + 'ErrorTitle' represent concrete error code and reason. It appears in 'Errors'. +-} +data ErrorTitle = ErrorTitle + { errorTitleCode :: ErrorCode -- ^ Error code of element level error in List API response. + , errorTitleReason :: Text -- ^ Reason explanation of the error. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 10, omitNothingFields = True } ''ErrorTitle) +-- ^ 'ErrorTitle' derives ToJSON and FromJSON via deriveJSON template haskell function. + +{-| + 'Errors' is used for element level error in List API. + When list API failed to retrieve an element, it returns this object for the element + and response API status as successful instead of failing entire API request. + + Refer to [API Document](https://developer.webex.com/errors.html) for more detail. +-} +newtype Errors = Errors { errorsTitle :: ErrorTitle } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 6, omitNothingFields = True } ''Errors) +-- ^ 'Errors' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- Person +-- | Identifying 'Person' describing detail of Webex Teams user or bot. +newtype PersonId = PersonId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Email address of user. +newtype Email = Email Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Display name of user. +newtype DisplayName = DisplayName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Nickname of user. +newtype NickName = NickName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | First name of user. +newtype FirstName = FirstName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Last name of user. +newtype LastName = LastName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | URL pointing to image file of Avatar. +newtype AvatarUrl = AvatarUrl Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | 'Organization' identifier which user or team belongs to. +newtype OrganizationId = OrganizationId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | 'Role' identifier which can be assigned to user. See 'Role' too. +newtype RoleId = RoleId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | 'License' identifier which can be enabled on user. See 'License' too. +newtype LicenseId = LicenseId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Timezone in timezone name. +newtype Timezone = Timezone Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +{-| + Current status of 'Person'. + It can be updated automatically by recent activity or explicitly updated by user's operation + or propagated from vacation setting on email system. +-} +data PersonStatus = PersonStatusActive -- ^ The 'Person' is currently active. Decoded from \"active\". + | PersonStatusInactive -- ^ The 'Person' is currently not active. Decoded from \"inactive\". + | PersonStatusOutOfOffice -- ^ Email system of the 'Person' currently sets vacation. Decoded from \"OutOfOffice\". + | PersonStatusDoNotDisturb -- ^ The 'Person' is explicitly indicated do-not-disturb. Decoded from \"DoNotDisturb\". + | PersonStatusUnknown -- ^ The status of the 'Person' is unknown. Decoded from \"unknown\". + deriving (Eq, Generic, Show) + +-- | 'PersonStatus' implements 'toEncoding' to encode each constructor into JSON enum value. +instance ToJSON PersonStatus where + toEncoding PersonStatusActive = string "active" + toEncoding PersonStatusInactive = string "inactive" + toEncoding PersonStatusOutOfOffice = string "OutOfOffice" + toEncoding PersonStatusDoNotDisturb = string "DoNotDisturb" + toEncoding PersonStatusUnknown = string "unknown" + +-- | 'PersonStatus' implements 'parseJSON' to decode JSON enum value to a constructor. +instance FromJSON PersonStatus where + parseJSON = withText "Pserson.Status" $ \s -> case s of + "active" -> pure PersonStatusActive + "inactive" -> pure PersonStatusInactive + "OutOfOffice" -> pure PersonStatusOutOfOffice + "DoNotDisturb" -> pure PersonStatusDoNotDisturb + "unknown" -> pure PersonStatusUnknown + _ -> fail "Parsing Person.Status value failed: expected \"active\", \"inactive\", \"OutOfOffice\", \"DoNotDisturb\" or \"unknown\"" + +-- | 'PersonType' indicates whether the Person is real human or bot. +data PersonType = PersonTypePerson -- ^ The 'Person' is a real human. Decoded from \"person\". + | PersonTypeBot -- ^ The 'Person' is a bot. Decoded from \"bot\". + deriving (Eq, Show) + +$(deriveJSON defaultOptions { constructorTagModifier = dropAndLow 10 } ''PersonType) +-- ^ 'PersonType' derives ToJSON and FromJSON via deriveJSON template haskell function. + +{-| + 'Person' is detail description of Webex Teams user or bot. + Person is decoded from response JSON of Get Person Details REST call. + It is also element type of response of List People call. +-} +data Person = Person + { personId :: PersonId -- ^ Identifier of the Person. + , personErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , personEmails :: Maybe [Email] -- ^ List of email addresses which the Person has. + , personDisplayName :: Maybe DisplayName -- ^ Display name of the Person. + , personNickName :: Maybe NickName -- ^ Nickname of the Person. + , personFirstName :: Maybe FirstName -- ^ First name of the Person. + , personLastName :: Maybe LastName -- ^ Last name of the Person. + , personAvatar :: Maybe AvatarUrl -- ^ URL pointing a image used for Avatar of the Person. + , personOrgId :: Maybe OrganizationId -- ^ 'Organization' which the Person belongs to. + , personRoles :: Maybe [RoleId] -- ^ List of roles assigned to the Person. + , personLicenses :: Maybe [LicenseId] -- ^ List of licenses effective on the Person. + , personCreated :: Maybe Timestamp -- ^ Timestamp when the Person was created. + , personTimezone :: Maybe Timezone -- ^ Timezone of the Person. + , personLastActivity :: Maybe Timestamp -- ^ Timestamp of the latest activity of the Person. + , personStatus :: Maybe PersonStatus -- ^ Current status of the Person + , personInvitePending :: Maybe Bool -- ^ True if invitation for the Person is pending. + , personLoginEnabled :: Maybe Bool -- ^ True if login of the Person is enabled. + , personType :: Maybe PersonType -- ^ Indicating if the Person is real human or bot. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 6, omitNothingFields = True } ''Person) +-- ^ 'Person' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for a person API uses 'PersonId' and path "people". +instance WebexTeamsApiPath PersonId where + apiPath _ = peoplePath + +-- | Get detail for a person API uses "PersonId' and responses 'Person'. +instance WebexTeamsResponse PersonId where + type ToResponse PersonId = Person + +-- | User can get detail of a person. +instance WebexTeamsDetail PersonId where + toIdStr (PersonId s) = s + +-- | 'PersonList' is decoded from response JSON of List People REST call. It is list of 'Person'. +newtype PersonList = PersonList { personListItems :: [Person] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 10, omitNothingFields = True } ''PersonList) +-- ^ 'PersonList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'PersonList' wraps 'Person'. +instance WebexTeamsListItem Person where + type ToList Person = PersonList + unwrap = personListItems + +-- | Optional query strings for people list API. +data PersonFilter = PersonFilter + { personFilterEmail :: Maybe Email -- ^ Find person who has given email address. + , personFilterDisplayName :: Maybe DisplayName -- ^ Find person who has given display name. + , personFilterOrgId :: Maybe OrganizationId -- ^ Find person who belongs to given organization. + } deriving (Default, Eq, Generic, Show) + +-- | List people API uses 'PersonFilter' and path "people". +instance WebexTeamsApiPath PersonFilter where + apiPath _ = peoplePath + +-- | List people API uses 'PersonFilter' and responses 'Person'. +instance WebexTeamsResponse PersonFilter where + type ToResponse PersonFilter = Person + +-- | User can list people with filter parameter. +instance WebexTeamsFilter PersonFilter where + toFilterList filter = catMaybes + [ (\(Email e) -> ("email", Just $ encodeUtf8 e)) <$> personFilterEmail filter + , (\(DisplayName n) -> ("displayName", Just (encodeUtf8 n))) <$> personFilterDisplayName filter + , (\(OrganizationId o) -> ("orgId", Just (encodeUtf8 o))) <$> personFilterOrgId filter + ] + +-- | 'CreatePerson' is encoded to request body JSON of Create a Person REST call. +data CreatePerson = CreatePerson + { createPersonEmails :: Maybe [Email] -- ^ List of email addresses which the Person has. + , createPersonDisplayName :: Maybe DisplayName -- ^ Display name of the Person. + , createPersonFirstName :: Maybe FirstName -- ^ First name of the Person. + , createPersonLastName :: Maybe LastName -- ^ Last name of the Person. + , createPersonAvatar :: Maybe AvatarUrl -- ^ URL pointing a image used for Avatar of the Person. + , createPersonOrgId :: Maybe OrganizationId -- ^ Organization which the Person belongs to. + , createPersonRoles :: Maybe [RoleId] -- ^ List of roles assigned to the person. + , createPersonLicenses :: Maybe [LicenseId] -- ^ List of licenses effective on the Person. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 12, omitNothingFields = True } ''CreatePerson) +-- ^ 'CreatePerson' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Create person API uses 'CreatePerson' and path "people". +instance WebexTeamsApiPath CreatePerson where + apiPath _ = peoplePath + +-- | Create person API uses "CreatePerson' and responses 'Person'. +instance WebexTeamsResponse CreatePerson where + type ToResponse CreatePerson = Person + +-- | User can create a person. +instance WebexTeamsCreate CreatePerson where + +-- | 'UpdatePerson' is encoded to request body JSON of Update a Person REST call. +data UpdatePerson = UpdatePerson + { updatePersonDisplayName :: Maybe DisplayName -- ^ Display name of the Person. + , updatePersonFirstName :: Maybe FirstName -- ^ First name of the Person. + , updatePersonLastName :: Maybe LastName -- ^ Last name of the Person. + , updatePersonAvatar :: Maybe AvatarUrl -- ^ URL pointing a image used for Avatar of the Person. + , updatePersonOrgId :: Maybe OrganizationId -- ^ Organization which the Person belongs to. + , updatePersonRoles :: Maybe [RoleId] -- ^ List of roles assigned to the person. + , updatePersonLicenses :: Maybe [LicenseId] -- ^ List of licenses effective on the Person. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 12, omitNothingFields = True } ''UpdatePerson) +-- ^ 'UpdatePerson' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Update person API uses 'UpdatePerson' and path "people". +instance WebexTeamsApiPath UpdatePerson where + apiPath _ = peoplePath + +-- | Update person API uses "UpdatePerson' and responses 'Person'. +instance WebexTeamsResponse UpdatePerson where + type ToResponse UpdatePerson = Person + +-- | User can update a person. +instance WebexTeamsUpdate UpdatePerson + +-- | Identifying Team. +newtype TeamId = TeamId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Name of Team +newtype TeamName = TeamName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +{-| + 'Team' is group of 'Person' and group of 'Room'. + A Person can belong to multiple Team but a Room can belong to at most one Team. + Team is decoded from response JSON of Get Team Details REST call. + It is also element type of response of List Teams call. +-} +data Team = Team + { teamId :: TeamId -- ^ Identifier of the Team. + , teamErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , teamName :: Maybe TeamName -- ^ Name of the Team. + , teamCreatorId :: Maybe PersonId -- ^ Identifier of the Person who created the Team. + , teamCreated :: Maybe Timestamp -- ^ Timestamp when the Team was created. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 4, omitNothingFields = True } ''Team) +-- ^ 'Team' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for a team API uses 'TeamId' and path "teams". +instance WebexTeamsApiPath TeamId where + apiPath _ = teamsPath + +-- | Get detail for a team API uses "TeamId' and responses 'Team'. +instance WebexTeamsResponse TeamId where + type ToResponse TeamId = Team + +-- | User can get detail of a team. +instance WebexTeamsDetail TeamId where + toIdStr (TeamId s) = s + +-- | 'TeamList' is decoded from response JSON of List Teams REST call. It is list of 'Team'. +newtype TeamList = TeamList { teamListItems :: [Team] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 8, omitNothingFields = True } ''TeamList) +-- ^ 'TeamList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'TeamList' wraps 'Team' +instance WebexTeamsListItem Team where + type ToList Team = TeamList + unwrap = teamListItems + +-- | 'CreateTeam' is encoded to request body JSON of Create a Team REST call. +newtype CreateTeam = CreateTeam { createTeamName :: TeamName } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 10, omitNothingFields = True } ''CreateTeam) +-- ^ 'CreateTeam' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Create team API uses 'CreateTeam' and path "teams". +instance WebexTeamsApiPath CreateTeam where + apiPath _ = teamsPath + +-- | Create team API uses "CreateTeam' and responses 'Team'. +instance WebexTeamsResponse CreateTeam where + type ToResponse CreateTeam = Team + +-- | User can create a team. +instance WebexTeamsCreate CreateTeam where + +-- | 'UpdateTeam' is encoded to request body JSON of Update a Team REST call. +newtype UpdateTeam = UpdateTeam { updateTeamName :: TeamName } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 10, omitNothingFields = True } ''UpdateTeam) +-- ^ 'UpdateTeam' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Update team API uses 'UpdateTeam' and path "teams". +instance WebexTeamsApiPath UpdateTeam where + apiPath _ = teamsPath + +-- | Update team API uses "UpdateTeam' and responses 'Team'. +instance WebexTeamsResponse UpdateTeam where + type ToResponse UpdateTeam = Team + +-- | User can update a team. +instance WebexTeamsUpdate UpdateTeam + + +-- | Identifying TeamMembership. +newtype TeamMembershipId = TeamMembershipId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +{-| + 'TeamMembership' is association between 'Team' and 'Person'. + It can be N:N relation. A Person can belong to multiple Team. + TeamMembership is decoded from response JSON of Get Team Membership Details REST call. + It is also element type of response of List Team Memberships call. +-} +data TeamMembership = TeamMembership + { teamMembershipId :: TeamMembershipId -- ^ Identifier of the TeamMembership entry. + , teamMembershipErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , teamMembershipTeamId :: Maybe TeamId -- ^ Identifier of the 'Team' which the Person belongs to. + , teamMembershipPersonId :: Maybe PersonId -- ^ Identifier of user who belongs to the Team. + , teamMembershipPersonEmail :: Maybe Email -- ^ Email address of the user identified by the PersonId. + , teamMembershipPersonDisplayName :: Maybe DisplayName -- ^ Display name of the user identified by the PersonId. + , teamMembershipPersonOrgId :: Maybe OrganizationId -- ^ Identifier of 'Organization' which the Team blongs to. + , teamMembershipIsModerator :: Maybe Bool -- ^ The Person is moderator of the Team when True. + , teamMembershipCreated :: Maybe Timestamp -- ^ Timestamp when the TeamMembership entry created. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 14, omitNothingFields = True } ''TeamMembership) +-- ^ 'TeamMembership' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for a team membership API uses 'TeamMembershipId' and path "team/memberships". +instance WebexTeamsApiPath TeamMembershipId where + apiPath _ = teamMembershipsPath + +-- | Get detail for a team membership API uses "TeamMembershipId' and responses 'TeamMembership'. +instance WebexTeamsResponse TeamMembershipId where + type ToResponse TeamMembershipId = TeamMembership + +-- | User can get detail of a team membership. +instance WebexTeamsDetail TeamMembershipId where + toIdStr (TeamMembershipId s) = s + +-- | 'TeamMembershipList' is decoded from response JSON of List Team Memberships REST call. It is list of 'TeamMembership'. +newtype TeamMembershipList = TeamMembershipList { teamMembershipListItems :: [TeamMembership] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 18, omitNothingFields = True } ''TeamMembershipList) +-- ^ 'TeamMembershipList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'TeamMembershipList' wraps 'TeamMembership' +instance WebexTeamsListItem TeamMembership where + type ToList TeamMembership = TeamMembershipList + unwrap = teamMembershipListItems + +-- | Optional query strings for team membership list API +newtype TeamMembershipFilter = TeamMembershipFilter + { teamMembershipFilterTeamId :: TeamId -- ^ List membership only in given team. + } deriving (Eq, Show) + +-- | List team memberships API uses 'TeamMembershipFilter' and path "team/memberships". +instance WebexTeamsApiPath TeamMembershipFilter where + apiPath _ = teamMembershipsPath + +-- | List team memberships API uses 'TeamMembershipFilter' and responses 'TeamMembership'. +instance WebexTeamsResponse TeamMembershipFilter where + type ToResponse TeamMembershipFilter = TeamMembership + +-- | User can list team membership with filter parameter. +instance WebexTeamsFilter TeamMembershipFilter where + toFilterList filter = let (TeamId t) = teamMembershipFilterTeamId filter in [("teamId", Just $ encodeUtf8 t)] + +{-| + Default value of query strings for team membership list API. + Because 'TeamId' is mandatory, user have to supply it in order to get rest of defaults. + As of writing, there is no filter parameter other than TeamId but 'TeamMembershipFilter' is + used for providing consistent API like 'streamEntityWithFilter'. +-} +defaultTeamMembershipFilter :: TeamId -> TeamMembershipFilter +defaultTeamMembershipFilter = TeamMembershipFilter + +-- | 'CreateTeamMembership' is encoded to request body JSON of Create a Team Membership REST call. +data CreateTeamMembership = CreateTeamMembership + { createTeamMembershipTeamId :: TeamId -- ^ Identifier of 'Team' which the user will be added to. + , createTeamMembershipPersonId :: Maybe PersonId -- ^ Identifier of 'Person' who will be added to the Team. + , createTeamMembershipPersonEmail :: Maybe Email -- ^ Email of the Person to be added. + , createTeamMembershipIsModerator :: Maybe Bool -- ^ The user becomes a moderator of the team if True. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 20, omitNothingFields = True } ''CreateTeamMembership) +-- ^ 'CreateTeamMembership' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Create teamMembership API uses 'CreateTeamMembership' and path "team/memberships". +instance WebexTeamsApiPath CreateTeamMembership where + apiPath _ = teamMembershipsPath + +-- | Create teamMembership API uses "CreateTeamMembership' and responses 'TeamMembership'. +instance WebexTeamsResponse CreateTeamMembership where + type ToResponse CreateTeamMembership = TeamMembership + +-- | User can create a teamMembership. +instance WebexTeamsCreate CreateTeamMembership where + +-- | 'UpdateTeamMembership' is encoded to request body JSON of Update a Team Membership REST call. +newtype UpdateTeamMembership = UpdateTeamMembership { updateTeamMembershipIsModerator :: Bool } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 20, omitNothingFields = True } ''UpdateTeamMembership) +-- ^ 'UpdateTeamMembership' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Update teamMembership API uses 'UpdateTeamMembership' and path "team/memberships". +instance WebexTeamsApiPath UpdateTeamMembership where + apiPath _ = teamMembershipsPath + +-- | Update teamMembership API uses "UpdateTeamMembership' and responses 'TeamMembership'. +instance WebexTeamsResponse UpdateTeamMembership where + type ToResponse UpdateTeamMembership = TeamMembership + +-- | User can update a teamMembership. +instance WebexTeamsUpdate UpdateTeamMembership + + +-- | Identifying 'Room'. +newtype RoomId = RoomId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Title text of 'Room'. +newtype RoomTitle = RoomTitle Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | SIP address. +newtype SipAddr = SipAddr Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +-- | 'RoomType' indicates if the 'Room' is for 1:1 user or group of users. +data RoomType = RoomTypeDirect -- ^ The Room is for 1:1. Decoded from \"direct\". + | RoomTypeGroup -- ^ The Room is for group. Decoded from \"group\". + deriving (Eq, Show) + +$(deriveJSON defaultOptions { constructorTagModifier = dropAndLow 8 } ''RoomType) +-- ^ 'RoomType' derives ToJSON and FromJSON via deriveJSON template haskell function. + +{-| + 'Room' is communication space in Webex Teams and called \"Space\" on UI. + Historically it was called Room on UI too but UI has been changed to \"Space\" in order to avoid + confusion with the concept \"Room\" associated to hardware facility of video conferencing on Webex Teams. + The name of Room is kept unchanged for backward compatibility. + + Room is decoded from response JSON of Get Room Details REST call. + It is also element type of response of List Rooms call. +-} +data Room = Room + { roomId :: RoomId -- ^ Identifier of the Room. + , roomErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , roomTitle :: Maybe RoomTitle -- ^ Title text of the Room. + , roomType :: Maybe RoomType -- ^ Indicates if the Room is for 1:1 or group. + , roomIsLocked :: Maybe Bool -- ^ True if the Room is locked. + , roomSipAddress :: Maybe SipAddr -- ^ SIP address of the Room. + , roomLastActivity :: Maybe Timestamp -- ^ Timestamp when the last activity was happen on the Room. + , roomTeamId :: Maybe TeamId -- ^ Identifier of the 'Team' which the Room belongs to. + , roomCreatorId :: Maybe PersonId -- ^ Identifier of 'Person' who created the Room. + , roomCreated :: Maybe Timestamp -- ^ Timestamp when the Room was created. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 4, omitNothingFields = True } ''Room) +-- ^ 'Room' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for a room API uses 'RoomId' and path "rooms". +instance WebexTeamsApiPath RoomId where + apiPath _ = roomsPath + +-- | Get detail for a room API uses "RoomId' and responses 'Room'. +instance WebexTeamsResponse RoomId where + type ToResponse RoomId = Room + +-- | User can get detail of a room. +instance WebexTeamsDetail RoomId where + toIdStr (RoomId s) = s + +-- | 'RoomList' is decoded from response JSON of List Rooms REST call. It is list of 'Room'. +newtype RoomList = RoomList { roomListItems :: [Room] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 8, omitNothingFields = True } ''RoomList) +-- ^ 'RoomList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'RoomList' wraps 'Room' +instance WebexTeamsListItem Room where + type ToList Room = RoomList + unwrap = roomListItems + +-- | Sorting option for room list API. +data RoomFilterSortBy = RoomFilterSortById | RoomFilterSortByLastActivity | RoomFilterSortByCreated deriving (Eq, Show) + +-- | Optional query strings for room list API +data RoomFilter = RoomFilter + { roomFilterTeamId :: Maybe TeamId -- ^ List rooms only in given team. + , roomFilterRoomType :: Maybe RoomType -- ^ List given type rooms only. + , roomFilterSortBy :: Maybe RoomFilterSortBy -- ^ Sort response by given option. + } deriving (Default, Eq, Generic, Show) + +-- | Sum type to ByteString converter for 'RoomType'. +roomTypeToFilterString :: RoomType -> ByteString +roomTypeToFilterString RoomTypeDirect = "direct" +roomTypeToFilterString RoomTypeGroup = "group" + +-- | Sum type to ByteString converter for 'RoomFilterSortBy'. +roomFilterSortByToFilterString :: RoomFilterSortBy -> ByteString +roomFilterSortByToFilterString RoomFilterSortById = "id" +roomFilterSortByToFilterString RoomFilterSortByLastActivity = "lastactivity" +roomFilterSortByToFilterString RoomFilterSortByCreated = "created" + +-- | List rooms API uses 'RoomFilter' and path "rooms". +instance WebexTeamsApiPath RoomFilter where + apiPath _ = roomsPath + +-- | List rooms API uses 'RoomFilter' and responses 'Room'. +instance WebexTeamsResponse RoomFilter where + type ToResponse RoomFilter = Room + +-- | User can list rooms with filter parameter. +instance WebexTeamsFilter RoomFilter where + toFilterList filter = catMaybes + [ (\(TeamId e) -> ("teamId", Just $ encodeUtf8 e)) <$> roomFilterTeamId filter + , (\t -> ("type", Just $ roomTypeToFilterString t)) <$> roomFilterRoomType filter + , (\o -> ("sortBy", Just $ roomFilterSortByToFilterString o)) <$> roomFilterSortBy filter + ] + +-- | 'CreateRoom' is encoded to request body JSON of Create a Room REST call. +data CreateRoom = CreateRoom + { createRoomTitle :: RoomTitle -- ^ Title text of newly created Room. + , createRoomTeamId :: Maybe TeamId -- ^ Identifier of 'Team' which the Room will belong to. If Nothing, the new Room will be standalone. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 10, omitNothingFields = True } ''CreateRoom) +-- ^ 'CreateRoom' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Create room API uses 'CreateRoom' and path "rooms". +instance WebexTeamsApiPath CreateRoom where + apiPath _ = roomsPath + +-- | Create room API uses "CreateRoom' and responses 'Room'. +instance WebexTeamsResponse CreateRoom where + type ToResponse CreateRoom = Room + +-- | User can create a room. +instance WebexTeamsCreate CreateRoom where + +-- | 'UpdateRoom' is encoded to request body JSON of Update a Room REST call. +newtype UpdateRoom = UpdateRoom { updateRoomTitle :: RoomTitle } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 10, omitNothingFields = True } ''UpdateRoom) +-- ^ 'UpdateRoom' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Update room API uses 'UpdateRoom' and path "rooms". +instance WebexTeamsApiPath UpdateRoom where + apiPath _ = roomsPath + +-- | Update room API uses "UpdateRoom' and responses 'Room'. +instance WebexTeamsResponse UpdateRoom where + type ToResponse UpdateRoom = Room + +-- | User can update a room. +instance WebexTeamsUpdate UpdateRoom + + +-- | Identifying 'Membership'. +newtype MembershipId = MembershipId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +{-| + 'Membership' is association between 'Room' and 'Person'. + It can be N:N relation. A Person can belong to multiple Room. + Membership is decoded from response JSON of Get Membership Details REST call. + It is also element type of response of List Memberships call. +-} +data Membership = Membership + { membershipId :: MembershipId -- ^ Identifier of the Membership entry. + , membershipErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , membershipRoomId :: Maybe RoomId -- ^ Identifier of the 'Room' associated to the Person + , membershipPersonId :: Maybe PersonId -- ^ Identifier of the 'Person' associated to the Room + , membershipPersonEmail :: Maybe Email -- ^ Email of the Person + , membershipPersonDisplayName :: Maybe DisplayName -- ^ Display name of the Person + , membershipPersonOrgId :: Maybe OrganizationId -- ^ Identifier of 'Organization' which the Person belongs to. + , membershipIsModerator :: Maybe Bool -- ^ True if the Person is a moderator of the room. + , membershipIsMonitor :: Maybe Bool -- ^ True if the Person is monitoring the Room. + , membershipCreated :: Maybe Timestamp -- ^ Timestamp when the Membership was created. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 10, omitNothingFields = True } ''Membership) +-- ^ 'Membership' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for a membership API uses 'MembershipId' and path "memberships". +instance WebexTeamsApiPath MembershipId where + apiPath _ = membershipsPath + +-- | Get detail for a membership API uses "MembershipId' and responses 'Membership'. +instance WebexTeamsResponse MembershipId where + type ToResponse MembershipId = Membership + +-- | User can get detail of a membership. +instance WebexTeamsDetail MembershipId where + toIdStr (MembershipId s) = s + +-- | 'MembershipList' is decoded from response JSON of List Memberships REST call. It is list of 'Membership'. +newtype MembershipList = MembershipList { membershipListItems :: [Membership] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 14, omitNothingFields = True } ''MembershipList) +-- ^ 'MembershipList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'MembershipList' wraps 'Membership' +instance WebexTeamsListItem Membership where + type ToList Membership = MembershipList + unwrap = membershipListItems + +-- | Optional query strings for room membership list API +data MembershipFilter = MembershipFilter + { membershipFilterRoomId :: Maybe RoomId -- ^ List membership only in given room. + , membershipFilterPersonId :: Maybe PersonId -- ^ List membership related to given person of personId. + , membershipFilterPersonEmail :: Maybe Email -- ^ List membership related to given person of email. + } deriving (Default, Eq, Generic, Show) + +-- | List memberships API uses 'MembershipFilter' and path "memberships". +instance WebexTeamsApiPath MembershipFilter where + apiPath _ = membershipsPath + +-- | List memberships API uses 'MembershipFilter' and responses 'Membership'. +instance WebexTeamsResponse MembershipFilter where + type ToResponse MembershipFilter = Membership + +-- | User can list memberships with filter parameter. +instance WebexTeamsFilter MembershipFilter where + toFilterList filter = catMaybes + [ (\(RoomId r) -> ("roomId", Just $ encodeUtf8 r)) <$> membershipFilterRoomId filter + , (\(PersonId p) -> ("personId", Just $ encodeUtf8 p)) <$> membershipFilterPersonId filter + , (\(Email e) -> ("personEmail", Just $ encodeUtf8 e)) <$> membershipFilterPersonEmail filter + ] + +-- | 'CreateMembership' is encoded to request body JSON of Create a Membership REST call. +data CreateMembership = CreateMembership + { createMembershipRoomId :: RoomId -- ^ Identifier of 'Room' which the Person will be added to. + , createMembershipPersonId :: Maybe PersonId -- ^ Identifier of 'Person' who will be added to the Room. + , createMembershipPersonEmail :: Maybe Email -- ^ Email of the Person to be added. + , createMembershipIsModerator :: Maybe Bool -- ^ The Person becomes a moderator of the Room if True. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 16, omitNothingFields = True } ''CreateMembership) +-- ^ 'CreateMembership' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Create membership API uses 'CreateMembership' and path "memberships". +instance WebexTeamsApiPath CreateMembership where + apiPath _ = membershipsPath + +-- | Create membership API uses "CreateMembership' and responses 'Membership'. +instance WebexTeamsResponse CreateMembership where + type ToResponse CreateMembership = Membership + +-- | User can create a membership. +instance WebexTeamsCreate CreateMembership where + +-- | 'UpdateMembership' is encoded to request body JSON of Update a Membership REST call. +newtype UpdateMembership = UpdateMembership { updateMembershipIsModerator :: Bool } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 16, omitNothingFields = True } ''UpdateMembership) +-- ^ 'UpdateMembership' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Update membership API uses 'UpdateMembership' and path "memberships". +instance WebexTeamsApiPath UpdateMembership where + apiPath _ = membershipsPath + +-- | Update membership API uses "UpdateMembership' and responses 'Membership'. +instance WebexTeamsResponse UpdateMembership where + type ToResponse UpdateMembership = Membership + +-- | User can update a membership. +instance WebexTeamsUpdate UpdateMembership + + +-- | Identifying 'Message'. +newtype MessageId = MessageId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Body of message in plain text. +newtype MessageText = MessageText Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Body of message in html. +newtype MessageHtml = MessageHtml Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Body of message in markdown. +newtype MessageMarkdown = MessageMarkdown Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | URL pointing attached file of message. +newtype FileUrl = FileUrl Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +{-| + 'Message' is a message posted to a 'Room' by some 'Person'. + Room is decoded from response JSON of Get Message Details REST call. + It is also element type of response of List Messages call. +-} +data Message = Message + { messageId :: MessageId -- ^ Identifier of the Message. + , messageErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , messageRoomId :: Maybe RoomId -- ^ Identifier of the room where the Message was sent. + , messageRoomType :: Maybe RoomType -- ^ Type of Room the message was sent to. + , messageToPersonId :: Maybe PersonId -- ^ Presents in documentation but doesn't appear in actual API response. + , messageToPersonEmail :: Maybe Email -- ^ Presents in documentation but doesn't appear in actual API response. + , messageText :: Maybe MessageText -- ^ Message body in plain text. + , messageHtml :: Maybe MessageHtml -- ^ Message body in HTML. + , messageFiles :: Maybe [FileUrl] -- ^ URL to files attached to the message. + , messagePersonId :: Maybe PersonId -- ^ Identifier of 'Person' who sent the message. + , messagePersonEmail :: Maybe Email -- ^ Email of Person who sent the message. + , messageCreated :: Maybe Timestamp -- ^ Timestamp when the massage was sent. + , messageMentionedPeople :: Maybe [PersonId] -- ^ List of identifiers of Person were mentioned in the message. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 7, omitNothingFields = True } ''Message) +-- ^ 'Message' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for message API uses 'MessageId' and path "messages". +instance WebexTeamsApiPath MessageId where + apiPath _ = messagesPath + +-- | Get detail for a message API uses "MessageId' and responses 'Message'. +instance WebexTeamsResponse MessageId where + type ToResponse MessageId = Message + +-- | User can get detail of a message. +instance WebexTeamsDetail MessageId where + toIdStr (MessageId s) = s + +-- | 'MessageList' is decoded from response JSON of List Messages REST call. It is list of 'Message'. +newtype MessageList = MessageList { messageListItems :: [Message] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 11, omitNothingFields = True } ''MessageList) +-- ^ 'MessageList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'MessageList' wraps 'Message' +instance WebexTeamsListItem Message where + type ToList Message = MessageList + unwrap = messageListItems + +-- | Sum type for mentionedPeople query string. It can be "me" or 'PersonId'. +data MentionedPeople = MentionedPeopleMe | MentionedPeople PersonId deriving (Eq, Show) + +-- | Optional query strings for message list API +data MessageFilter = MessageFilter + { messageFilterRoomId :: RoomId -- ^ Mandatory parameter which room to search. + , messageFilterMentionedPeople :: Maybe MentionedPeople -- ^ List messages only mentioned to given person. + , messageFilterBefore :: Maybe Timestamp -- ^ List messages posted before given timestamp. + , messageFilterBeforeMessage :: Maybe MessageId -- ^ List messages posted before given message. + } deriving (Eq, Show) + +{-| + Default value of query strings for message list API. + Because 'RoomId' is mandatory, user have to supply it in order to get rest of defaults. +-} +defaultMessageFilter :: RoomId -> MessageFilter +defaultMessageFilter roomId = MessageFilter roomId Nothing Nothing Nothing + +-- | Sum type to ByteString converter for mentionedPeople query string. +mentionedPeopleToFilterString :: MentionedPeople -> ByteString +mentionedPeopleToFilterString MentionedPeopleMe = "me" +mentionedPeopleToFilterString (MentionedPeople (PersonId personId)) = encodeUtf8 personId + +-- | List messages API uses 'MessageFilter' and path "messages". +instance WebexTeamsApiPath MessageFilter where + apiPath _ = messagesPath + +-- | List messages API uses 'MessageFilter' and responses 'Message'. +instance WebexTeamsResponse MessageFilter where + type ToResponse MessageFilter = Message + +-- | User can list messages with filter parameter. +instance WebexTeamsFilter MessageFilter where + toFilterList filter = ("roomId", Just $ encodeUtf8 rid) : catMaybes + [ (\p -> ("mentionedPeople", Just $ mentionedPeopleToFilterString p)) <$> messageFilterMentionedPeople filter + , (\(Timestamp t) -> ("before", Just $ encodeUtf8 t)) <$> messageFilterBefore filter + , (\(MessageId m) -> ("beforeMessage", Just $ encodeUtf8 m)) <$> messageFilterBeforeMessage filter + ] + where + (RoomId rid) = messageFilterRoomId filter + +-- | 'CreateMessage' is encoded to request body JSON of Create a Message REST call. +data CreateMessage = CreateMessage + { createMessageRoomId :: Maybe RoomId -- ^ Identifier of the 'Room' the message will be posted to. + , createMessageToPersonId :: Maybe PersonId -- ^ Identifier of the 'Person' to whom the direct message will be sent. + , createMessageToPersonEmail :: Maybe Email -- ^ Email of Person who receives the Message. + , createMessageText :: Maybe MessageText -- ^ Message body in plain text. + , createMessageMarkdown :: Maybe MessageMarkdown -- ^ Message body in markdown format. + , createMessageFiles :: Maybe [FileUrl] -- ^ URLs of Attached files to the message. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 13, omitNothingFields = True } ''CreateMessage) +-- ^ 'CreateMessage' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Create message API uses 'CreateMessage' and path "messages". +instance WebexTeamsApiPath CreateMessage where + apiPath _ = messagesPath + +-- | Create message API uses "CreateMessage' and responses 'Message'. +instance WebexTeamsResponse CreateMessage where + type ToResponse CreateMessage = Message + +-- | User can create a message. +instance WebexTeamsCreate CreateMessage where + + +-- | Display name of 'Organization' +newtype OrganizationDisplayName = OrganizationDisplayName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +{-| + 'Organization' is an administrative group of Webex Teams users. + Each 'Person' belongs to one Organization. + Organization is decoded from response JSON of Get Organization Details REST call. + It is also element type of response of List Organizations call. +-} +data Organization = Organization + { organizationId :: OrganizationId -- ^ Identifier of the Organization. + , organizationErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , organizationDisplayName :: Maybe OrganizationDisplayName -- ^ Display name of the Organization. + , organizationCreated :: Maybe Timestamp -- ^ Timestamp when the Organization was created. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 12, omitNothingFields = True } ''Organization) +-- ^ 'Organization' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for organization API uses 'OrganizationId' and path "organizations". +instance WebexTeamsApiPath OrganizationId where + apiPath _ = organizationsPath + +-- | Get detail for a organization API uses "OrganizationId' and responses 'Organization'. +instance WebexTeamsResponse OrganizationId where + type ToResponse OrganizationId = Organization + +-- | User can get detail of a organization. +instance WebexTeamsDetail OrganizationId where + toIdStr (OrganizationId s) = s + +-- | 'OrganizationList' is decoded from response JSON of List Organizations REST call. It is list of 'Organization'. +newtype OrganizationList = OrganizationList { organizationListItems :: [Organization] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 16, omitNothingFields = True } ''OrganizationList) +-- ^ 'OrganizationList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'OrganizationList' wraps 'Organization' +instance WebexTeamsListItem Organization where + type ToList Organization = OrganizationList + unwrap = organizationListItems + + +-- | Display name of License +newtype LicenseName = LicenseName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Counting number of granted or consumed License +newtype LicenseUnit = LicenseUnit Integer deriving (Eq, Show, Generic, ToJSON, FromJSON) + +{-| + 'License' is allowance for features and services of Webex Teams subscription. + License is decoded from response JSON of Get License Details REST call. + It is also element type of response of List Licenses call. +-} +data License = License + { licenseId :: LicenseId -- ^ Identifier of the License. + , licenseErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , licenseName :: Maybe LicenseName -- ^ Name of the License. + , licenseTotalUnits :: Maybe LicenseUnit -- ^ Number of granted License. + , licenseConsumedUnits :: Maybe LicenseUnit -- ^ Number of currently consumed License. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 7, omitNothingFields = True } ''License) +-- ^ 'License' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for license API uses 'LicenseId' and path "licenses". +instance WebexTeamsApiPath LicenseId where + apiPath _ = licensesPath + +-- | Get detail for a license API uses "LicenseId' and responses 'License'. +instance WebexTeamsResponse LicenseId where + type ToResponse LicenseId = License + +-- | User can get detail of a license. +instance WebexTeamsDetail LicenseId where + toIdStr (LicenseId s) = s + +-- | 'LicenseList' is decoded from response JSON of List Licenses REST call. It is list of 'License'. +newtype LicenseList = LicenseList { licenseListItems :: [License] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 11, omitNothingFields = True } ''LicenseList) +-- ^ 'LicenseList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'LicenseList' wraps 'License' +instance WebexTeamsListItem License where + type ToList License = LicenseList + unwrap = licenseListItems + +-- | Optional query strings for license list API +newtype LicenseFilter = LicenseFilter + { licenseFilterOrgId :: Maybe OrganizationId -- ^ List licenses only applicable to given organization. + } deriving (Default, Eq, Generic, Show) + +-- | List licenses API uses 'LicenseFilter' and path "licenses". +instance WebexTeamsApiPath LicenseFilter where + apiPath _ = licensesPath + +-- | List licenses API uses 'LicenseFilter' and responses 'License'. +instance WebexTeamsResponse LicenseFilter where + type ToResponse LicenseFilter = License + +-- | User can list licenses with filter parameter. +instance WebexTeamsFilter LicenseFilter where + toFilterList filter = maybeToList $ (\(OrganizationId o) -> ("orgId", Just $ encodeUtf8 o)) <$> licenseFilterOrgId filter + + +-- | Name of 'Role'. +newtype RoleName = RoleName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +{-| + A persona for an authenticated user, corresponding to a set of privileges within an organization. + Role is decoded from response JSON of Get Role Details REST call. + It is also element type of response of List Roles call. +-} +data Role = Role + { roleId :: RoleId -- ^ Identifier of the Role + , roleErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , roleName :: Maybe RoleName -- ^ Name of the Role + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 4, omitNothingFields = True } ''Role) +-- ^ 'Role' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for role API uses 'RoleId' and path "roles". +instance WebexTeamsApiPath RoleId where + apiPath _ = rolesPath + +-- | Get detail for a role API uses "RoleId' and responses 'Role'. +instance WebexTeamsResponse RoleId where + type ToResponse RoleId = Role + +-- | User can get detail of a role. +instance WebexTeamsDetail RoleId where + toIdStr (RoleId s) = s + +-- | 'RoleList' is decoded from response JSON of List Role REST call. It is list of 'Role'. +newtype RoleList = RoleList { roleListItems :: [Role] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 8, omitNothingFields = True } ''RoleList) +-- ^ 'RoleList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'RoleList' wraps 'Role' +instance WebexTeamsListItem Role where + type ToList Role = RoleList + unwrap = roleListItems + + +-- | 'Webhook' identifier which can be assigned to user. See 'Webhook' too. +newtype WebhookId = WebhookId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Name of 'Webhook'. +newtype WebhookName = WebhookName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | URL pointing to webhook target. +newtype WebhookUrl = WebhookUrl Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | URL-encoded set of webhook filtering criteria. +newtype WebhookFilter = WebhookFilter Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Shared secret supplied by user to authenticate Webex Cloud by webhook receiver. +newtype WebhookSecret = WebhookSecret Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +-- | 'WebhookResource' indicates source of event which triggered webhook access. +data WebhookResource = WebhookResourceAll + | WebhookResourceTeams + | WebhookResourceMemberships + | WebhookResourceMessages + | WebhookResourceRooms + deriving (Eq, Show) + +$(deriveJSON defaultOptions { constructorTagModifier = dropAndLow 15 } ''WebhookResource) +-- ^ 'WebhookResource' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | WebhookEvent indicates which event triggered Webhook access. +data WebhookEvent = WebhookEventAll + | WebhookEventCreated + | WebhookEventUpdated + | WebhookEventDeleted + deriving (Eq, Show) + +$(deriveJSON defaultOptions { constructorTagModifier = dropAndLow 12 } ''WebhookEvent) +-- ^ 'WebhookEvent' derives ToJSON and FromJSON via deriveJSON template haskell function. + +{-| + 'Webhook' allow your app to be notified via HTTP when a specific event occurs on Webex Teams. For example, + your app can register a webhook to be notified when a new message is posted into a specific room. +-} +data Webhook = Webhook + { webhookId :: WebhookId -- ^ Identifier of the Webhook. + , webhookErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , webhookName :: Maybe WebhookName -- ^ Name of the Webhook. + , webhookTargetUrl :: Maybe WebhookUrl -- ^ URL pointing to webhook target. + , webhookResource :: Maybe WebhookResource -- ^ Resource type where events are monitored. + , webhookEvent :: Maybe WebhookEvent -- ^ Event type which will be monitored. + , webhookFilter :: Maybe WebhookFilter -- ^ URL-encoded set of webhook filtering criteria. + , webhookSecret :: Maybe WebhookSecret -- ^ User supplied shared secret for authentication. + , webhookCreated :: Maybe Timestamp -- ^ Timestamp when the Webhook was created. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 7, omitNothingFields = True } ''Webhook) +-- ^ 'Webhook' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for webhook API uses 'WebhookId' and path "webhooks". +instance WebexTeamsApiPath WebhookId where + apiPath _ = webhooksPath + +-- | Get detail for a webhook API uses "WebhookId' and responses 'Webhook'. +instance WebexTeamsResponse WebhookId where + type ToResponse WebhookId = Webhook + +-- | User can get detail of a webhook. +instance WebexTeamsDetail WebhookId where + toIdStr (WebhookId s) = s + +-- | 'WebhookList' is decoded from response JSON of List Webhook REST call. It is list of 'Webhook'. +newtype WebhookList = WebhookList { webhookListItems :: [Webhook] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 11, omitNothingFields = True } ''WebhookList) +-- ^ 'WebhookList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'WebhookList' wraps 'Webhook' +instance WebexTeamsListItem Webhook where + type ToList Webhook = WebhookList + unwrap = webhookListItems + +-- | 'CreateWebhook' is encoded to request body JSON of Create a Webhook REST call. +data CreateWebhook = CreateWebhook + { createWebhookName :: WebhookName -- ^ Name of Webhook to be created. + , createWebhookTargetUrl :: WebhookUrl -- ^ URL pointing to webhook target. + , createWebhookResource :: WebhookResource -- ^ Resource type where events will be monitored. + , createWebhookEvent :: WebhookEvent -- ^ Event type which will be monitored. + , createWebhookFilter :: Maybe WebhookFilter -- ^ URL-encoded set of webhook filtering criteria. + , createWebhookSecret :: Maybe WebhookSecret -- ^ User supplied shared secret for authentication. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 13, omitNothingFields = True } ''CreateWebhook) +-- ^ 'CreateWebhook' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Create webhook API uses 'CreateWebhook' and path "webhooks". +instance WebexTeamsApiPath CreateWebhook where + apiPath _ = webhooksPath + +-- | Create webhook API uses "CreateWebhook' and responses 'Webhook'. +instance WebexTeamsResponse CreateWebhook where + type ToResponse CreateWebhook = Webhook + +-- | User can create a webhook. +instance WebexTeamsCreate CreateWebhook where + +-- | 'UpdateWebhook' is encoded to request body JSON of Update a Webhook REST call. +data UpdateWebhook = UpdateWebhook + { updateWebhookName :: WebhookName -- ^ Name of Webhook to be created. + , updateWebhookTargetUrl :: WebhookUrl -- ^ URL pointing to webhook target. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 13, omitNothingFields = True } ''UpdateWebhook) +-- ^ 'UpdateWebhook' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Update webhook API uses 'UpdateWebhook' and path "webhooks". +instance WebexTeamsApiPath UpdateWebhook where + apiPath _ = webhooksPath + +-- | Update webhook API uses "UpdateWebhook' and responses 'Webhook'. +instance WebexTeamsResponse UpdateWebhook where + type ToResponse UpdateWebhook = Webhook + +-- | User can update a webhook. +instance WebexTeamsUpdate UpdateWebhook + +-- | Optional query strings for membership event. +data WebhookMembershipFilter = WebhookMembershipFilter + { webhookFilterMembershipRoomId :: Maybe RoomId -- ^ Feed events only for given room. + , webhookFilterMembershipPersonId :: Maybe PersonId -- ^ Feed events only for given person. + , webhookFilterMembershipPersonEmail :: Maybe Email -- ^ Feed events only person who has given email. + , webhookFilterMembershipIsModerator :: Maybe Bool -- ^ Feed events only for moderator membership changes. + } deriving (Eq, Show) + +-- | Create webhook API accepts 'WebhookMembershipFilter' and uses path "webhooks". +instance WebexTeamsApiPath WebhookMembershipFilter where + apiPath _ = webhooksPath + +-- | List team memberships API accepts 'WebhookMembershipFilter' and responses 'Webhook'. +instance WebexTeamsResponse WebhookMembershipFilter where + type ToResponse WebhookMembershipFilter = Webhook + +-- | User can filter Webhook events from membership. +instance WebexTeamsFilter WebhookMembershipFilter where + toFilterList filter = catMaybes + [ (\(RoomId r) -> ("roomId", Just $ encodeUtf8 r)) <$> webhookFilterMembershipRoomId filter + , (\(PersonId p) -> ("personId", Just (encodeUtf8 p))) <$> webhookFilterMembershipPersonId filter + , (\(Email e) -> ("personEmail", Just (encodeUtf8 e))) <$> webhookFilterMembershipPersonEmail filter + , (\b -> ("isModerator", Just (if b then "true" else "false"))) <$> webhookFilterMembershipIsModerator filter + ] + +-- | Optional query strings for message event. +data WebhookMessageFilter = WebhookMessageFilter + { webhookFilterMessageRoomId :: Maybe RoomId -- ^ Feed events only for given room. + , webhookFilterMessageRoomType :: Maybe RoomType -- ^ Feed events only for given room type. + , webhookFilterMessagePersonId :: Maybe PersonId -- ^ Feed events only for given person. + , webhookFilterMessagePersonEmail :: Maybe Email -- ^ Feed events only person who has given email. + , webhookFilterMessagememtionedPeople :: Maybe MentionedPeople -- ^ Feed events only mentioned for given person. + , webhookFilterMessageHasFiles :: Maybe Bool -- ^ Feed events only messages with attached file. + } deriving (Eq, Show) + +-- | Create webhook API accepts 'WebhookMessageFilter' and uses path "webhooks". +instance WebexTeamsApiPath WebhookMessageFilter where + apiPath _ = webhooksPath + +-- | List team memberships API accepts 'WebhookMessageFilter' and responses 'Webhook'. +instance WebexTeamsResponse WebhookMessageFilter where + type ToResponse WebhookMessageFilter = Webhook + +-- | User can filter Webhook events from message. +instance WebexTeamsFilter WebhookMessageFilter where + toFilterList filter = catMaybes + [ (\(RoomId r) -> ("roomId", Just $ encodeUtf8 r)) <$> webhookFilterMessageRoomId filter + , (\t -> ("roomType", Just $ roomTypeToFilterString t)) <$> webhookFilterMessageRoomType filter + , (\(PersonId p) -> ("personId", Just (encodeUtf8 p))) <$> webhookFilterMessagePersonId filter + , (\(Email e) -> ("personEmail", Just (encodeUtf8 e))) <$> webhookFilterMessagePersonEmail filter + , (\p -> ("mentionedPeople", Just $ mentionedPeopleToFilterString p)) <$> webhookFilterMessagememtionedPeople filter + , (\b -> ("hasFiles", Just (if b then "true" else "false"))) <$> webhookFilterMessageHasFiles filter + ] + +-- | Optional query strings for room event. +data WebhookRoomFilter = WebhookRoomFilter + { webhookFilterRoomType :: Maybe RoomType -- ^ Feed events only for given room type. + , webhookFilterRoomIsLocked :: Maybe Bool -- ^ Feed events only locked unlocked rooms when true. + } deriving (Eq, Show) + +-- | Create webhook API accepts 'WebhookRoomFilter' and uses path "webhooks". +instance WebexTeamsApiPath WebhookRoomFilter where + apiPath _ = webhooksPath + +-- | List team memberships API accepts 'WebhookRoomFilter' and responses 'Webhook'. +instance WebexTeamsResponse WebhookRoomFilter where + type ToResponse WebhookRoomFilter = Webhook + +-- | User can filter Webhook events from room. +instance WebexTeamsFilter WebhookRoomFilter where + toFilterList filter = catMaybes + [ (\t -> ("type", Just $ roomTypeToFilterString t)) <$> webhookFilterRoomType filter + , (\b -> ("isLocked", Just (if b then "true" else "false"))) <$> webhookFilterRoomIsLocked filter + ] + + +-- | Identifier of app. +newtype AppId = AppId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +-- | 'WebhookNotifyOwnedBy' indicates if the webhook is owned by the org or the creator. +data WebhookNotifyOwnedBy = WebhookNotifyOwnedByOrg | WebhookNotifyOwnedByCreator deriving (Eq, Show) + +$(deriveJSON defaultOptions { constructorTagModifier = dropAndLow 18 } ''WebhookNotifyOwnedBy) +-- ^ 'WebhookNotifyOwnedBy' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'WebhookNotifyStatus' indicates if the webhook is active. +data WebhookNotifyStatus = WebhookNotifyStatusActive | WebhookNotifyStatusDesabled deriving (Eq, Show) + +$(deriveJSON defaultOptions { constructorTagModifier = dropAndLow 19 } ''WebhookNotifyStatus) +-- ^ 'WebhookNotifyStatus' derives ToJSON and FromJSON via deriveJSON template haskell function. + +{-| + 'Webhook' decodes webhook notification from Webex Cloud except data field. + Data field can be one of 'Membership', 'Message' or 'Room'. Type of data field is + shown as value of resource field. +-} +data WebhookNotify = WebhookNotify + { webhookNotifyId :: WebhookId + , webhookNotifyName :: WebhookName + , webhookNotifyResource :: WebhookResource + , webhookNotifyEvent :: WebhookEvent + , webhookNotifyFilter :: WebhookFilter + , webhookNotifyOrgId :: Organization + , webhookNotifyCreatedBy :: PersonId + , webhookNotifyAppId :: AppId + , webhookNotifyOwnedBy :: WebhookNotifyOwnedBy + , webhookNotifyStatus :: WebhookNotifyStatus + , webhookNotifyActorId :: PersonId + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 13, omitNothingFields = True } ''WebhookNotify) +-- ^ 'WebhookNotify' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Data part of webhook notification is decoded to 'Membership' when resource field value is "memberships". +newtype WebhookNotifyMembership = WebhookNotifyMembership { webhookNotifyMembershipData :: Membership } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 23, omitNothingFields = True } ''WebhookNotifyMembership) +-- ^ 'WebhookNotifyMembership' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Data part of webhook notification is decoded to 'Message' when resource field value is "messages". +newtype WebhookNotifyMessage = WebhookNotifyMessage { webhookNotifyMessageData :: Message } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 20, omitNothingFields = True } ''WebhookNotifyMessage) +-- ^ 'WebhookNotifyMessage' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Data part of webhook notification is decoded to 'Room' when resource field value is "rooms". +newtype WebhookNotifyRoom = WebhookNotifyRoom { webhookNotifyRoomData :: Room } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 17, omitNothingFields = True } ''WebhookNotifyRoom) +-- ^ 'WebhookNotifyRoom' derives ToJSON and FromJSON via deriveJSON template haskell function. diff --git a/test/Network/WebexTeams/InternalSpec.hs b/test/Network/WebexTeams/InternalSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/WebexTeams/InternalSpec.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.WebexTeams.InternalSpec where + +import Data.Attoparsec.ByteString +import Data.ByteString (pack) +import Data.Either (isLeft) +import Network.URI (URIAuth (..)) + +import Test.Hspec + +import Network.WebexTeams.Internal + + +spec :: Spec +spec = do + describe "Parser elements" $ do + it "decodes DQUOTE" $ do + parseOnly dQuote "\"" `shouldBe` Right 0x22 + + it "decodes quoted-pair" $ do + parseOnly quotedPair "\\\\" `shouldBe` Right 0x5c + parseOnly quotedPair "\\\"" `shouldBe` Right 0x22 + parseOnly quotedPair "no quoted pair" `shouldSatisfy` isLeft + + it "decodes quoted-string of '\"next\"' as 'next'" $ do + parseOnly quotedString "\"next\"" `shouldBe` Right "next" + + it "decodes rel parameter as a token" $ do + parseOnly token "rel" `shouldBe` Right "rel" + + it "decodes rel=\"next\" as LinkParam and its value" $ do + parseOnly param "; rel=\"next\"" `shouldBe` Right (Rel, "next") + + it "decodes rel=next as LinkParam and its value" $ do + parseOnly param "; rel=next" `shouldBe` Right (Rel, "next") + + it "decodes entire link header value" $ do + parseOnly linkHeader "; rel=\"next\"" + `shouldBe` Right (LinkHeader "https://api.ciscospark.com/v1/people?link=to&next=page" [ (Rel, "next") ]) + + describe "HTTP Link header detector" $ do + it "returns empty list from empty input" $ do + extractNextUrl [] `shouldBe` [] + + it "extracts a URL from a header value when the header has rel=next param" $ do + extractNextUrl ["; rel=\"next\""] + `shouldBe` ["https://api.ciscospark.com/v1/people?link=to&next=page"] + + it "ignores header which has no rel=next param" $ do + extractNextUrl ["; norel=next", "; rel=next"] `shouldBe` ["http://hostb"] + + it "ignores invalid header" $ do + extractNextUrl ["invalid header", "; rel=next"] `shouldBe` ["http://valid"] + + describe "HTTP Link Header validator" $ do + it "validates URL if it has same schema and URI Authority" $ do + validateUrl "https:" (URIAuth "" "api.ciscospark.com" "") + "https://api.ciscospark.com/v1/people?link=to&next=page" + `shouldBe` Just "https://api.ciscospark.com/v1/people?link=to&next=page" + + it "checks port number part too for validation" $ do + validateUrl "http:" (URIAuth "" "localhost" ":3000") + "http://localhost:3000/v1/people?link=to&next=page" + `shouldBe` Just "http://localhost:3000/v1/people?link=to&next=page" + + it "ignores path part of URL for validation" $ do + validateUrl "https:" (URIAuth "" "api.ciscospark.com" "") "https://api.ciscospark.com/abcdef" + `shouldBe` Just "https://api.ciscospark.com/abcdef" + + it "invalidates URL if scheme is different" $ do + validateUrl "https:" (URIAuth "" "api.ciscospark.com" "") "http://api.ciscospark.com/abcdef" + `shouldBe` Nothing + + it "invalidates URL if host name is different" $ do + validateUrl "https:" (URIAuth "" "api.ciscospark.com" "") "http://host.example.com/abcdef" + `shouldBe` Nothing + + it "invalidates URL if port is different" $ do + validateUrl "https:" (URIAuth "" "localhost" ":3000") "http://localhost:8888/abcdef" + `shouldBe` Nothing diff --git a/test/Network/WebexTeams/TypesSpec.hs b/test/Network/WebexTeams/TypesSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/WebexTeams/TypesSpec.hs @@ -0,0 +1,792 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.WebexTeams.TypesSpec where + +import Data.Aeson (decode, eitherDecode, encode) +import Data.Monoid ((<>)) + +import Test.Hspec + +import Network.WebexTeams.Types + +spec :: Spec +spec = do + describe "Error" $ do + let errorsJson = "{\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \}" + errors = Errors { errorsTitle = ErrorTitle { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + + it "decodes errors field in response JSON containd in List API" $ do + eitherDecode errorsJson `shouldBe` Right errors + (decode . encode) errors `shouldBe` Just errors + + describe "People" $ do + let personJson1 = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"emails\" : [ \"johnny.chang@foomail.com\", \"jchang@barmail.com\" ],\ + \ \"displayName\" : \"John Andersen\",\ + \ \"firstName\" : \"John\",\ + \ \"lastName\" : \"Andersen\",\ + \ \"avatar\" : \"https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600\",\ + \ \"orgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"roles\" : [ \"Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\" ],\ + \ \"licenses\" : [ \"Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\" ],\ + \ \"created\" : \"2015-10-18T14:26:16.000Z\",\ + \ \"timezone\" : \"America/Denver\",\ + \ \"lastActivity\" : \"2015-10-18T14:26:16.028Z\",\ + \ \"status\" : \"active\",\ + \ \"invitePending\" : false,\ + \ \"loginEnabled\" : true\ + \}" + person1 = Person { personId = PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , personErrors = Nothing + , personEmails = Just [Email "johnny.chang@foomail.com", Email "jchang@barmail.com"] + , personDisplayName = Just $ DisplayName "John Andersen" + , personNickName = Nothing + , personFirstName = Just $ FirstName "John" + , personLastName = Just $ LastName "Andersen" + , personAvatar = Just $ AvatarUrl "https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600" + , personOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , personRoles = Just [ RoleId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , RoleId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] + , personLicenses = Just [ LicenseId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , LicenseId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] + , personCreated = Just $ Timestamp "2015-10-18T14:26:16.000Z" + , personTimezone = Just $ Timezone "America/Denver" + , personLastActivity = Just $ Timestamp "2015-10-18T14:26:16.028Z" + , personStatus = Just PersonStatusActive + , personInvitePending = Just False + , personLoginEnabled = Just True + , personType = Nothing + } + personJson2 = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"emails\": [\ + \ \"sample@email.com\"\ + \ ],\ + \ \"displayName\": \"Taro Yamada\",\ + \ \"nickName\": \"Taro\",\ + \ \"firstName\": \"Taro\",\ + \ \"lastName\": \"Yamada\",\ + \ \"avatar\": \"https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600\",\ + \ \"orgId\": \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"created\": \"2012-06-15T20:35:48.682Z\",\ + \ \"lastActivity\": \"2017-06-30T15:30:20.016Z\",\ + \ \"status\": \"inactive\",\ + \ \"type\": \"person\"\ + \}" + person2 = Person { personId = PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , personErrors = Nothing + , personEmails = Just [Email "sample@email.com" ] + , personDisplayName = Just $ DisplayName "Taro Yamada" + , personNickName = Just $ NickName "Taro" + , personFirstName = Just $ FirstName "Taro" + , personLastName = Just $ LastName "Yamada" + , personAvatar = Just $ AvatarUrl "https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600" + , personOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , personRoles = Nothing + , personLicenses = Nothing + , personCreated = Just $ Timestamp "2012-06-15T20:35:48.682Z" + , personTimezone = Nothing + , personLastActivity = Just $ Timestamp "2017-06-30T15:30:20.016Z" + , personStatus = Just PersonStatusInactive + , personInvitePending = Nothing + , personLoginEnabled = Nothing + , personType = Just PersonTypePerson + } + personErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + personError = Person { personId = PersonId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , personErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + ,personEmails = Nothing + ,personDisplayName = Nothing + ,personNickName = Nothing + ,personFirstName = Nothing + ,personLastName = Nothing + ,personAvatar = Nothing + ,personOrgId = Nothing + ,personRoles = Nothing + ,personLicenses = Nothing + ,personCreated = Nothing + ,personTimezone = Nothing + ,personLastActivity = Nothing + ,personStatus = Nothing + ,personInvitePending = Nothing + ,personLoginEnabled = Nothing + ,personType = Nothing + } + personListJson = "{\"items\":[" <> personJson1 <> "," <> personJson2 <> "," <> personErrorJson <> "]}" + personList = PersonList [ person1, person2, personError ] + + it "can be unwrapped from PersonList" $ do + unwrap personList `shouldBe` [ person1, person2, personError ] + + it "decodes People API response JSON" $ do + eitherDecode personJson1 `shouldBe` Right person1 + (decode . encode) person1 `shouldBe` Just person1 + + it "decodes People API response JSON 2" $ do + eitherDecode personJson2 `shouldBe` Right person2 + (decode . encode) person2 `shouldBe` Just person2 + + it "decodes People list" $ do + eitherDecode personListJson `shouldBe` Right personList + (decode . encode) personList `shouldBe` Just personList + + it "encodes CreatePerson to JSON" $ do + let src = CreatePerson + { createPersonEmails = Just [ Email "johnny.chang@foomail.com", Email "jchang@barmail.com"] + , createPersonDisplayName = Just $ DisplayName "John Andersen" + , createPersonFirstName = Just $ FirstName "John" + , createPersonLastName = Just $ LastName "Andersen" + , createPersonAvatar = Just $ AvatarUrl "https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600" + , createPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , createPersonRoles = Just [ RoleId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , RoleId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX" ] + , createPersonLicenses = Just [ LicenseId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , LicenseId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX" ] + } + dst = "{\ + \ \"emails\" : [ \"johnny.chang@foomail.com\", \"jchang@barmail.com\" ],\ + \ \"displayName\" : \"John Andersen\",\ + \ \"firstName\" : \"John\",\ + \ \"lastName\" : \"Andersen\",\ + \ \"avatar\" : \"https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600\",\ + \ \"orgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"roles\" : [ \"Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\" ],\ + \ \"licenses\" : [ \"Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\" ]\ + \}" + eitherDecode dst `shouldBe` Right src + (decode . encode) src `shouldBe` (decode dst :: Maybe CreatePerson) + + describe "Team" $ do + let teamJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ + \ \"name\" : \"Build Squad\",\ + \ \"creatorId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"created\" : \"2015-10-18T14:26:16+00:00\"\ + \}" + team = Team { teamId = TeamId "Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" + , teamErrors = Nothing + , teamName = Just $ TeamName "Build Squad" + , teamCreatorId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , teamCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + } + teamErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + teamError = Team { teamId = TeamId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , teamErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + , teamName = Nothing + , teamCreatorId = Nothing + , teamCreated = Nothing + } + teamListJson = "{\"items\":[" <> teamJson <> "," <> teamErrorJson <> "]}" + teamList = TeamList [ team, teamError ] + + it "can be unwrapped from TeamList" $ do + unwrap teamList `shouldBe` [ team, teamError ] + + it "decodes Team API response JSON" $ do + eitherDecode teamJson `shouldBe` Right team + (decode . encode) team `shouldBe` Just team + + it "decodes Team list" $ do + eitherDecode teamListJson `shouldBe` Right teamList + (decode . encode) teamList `shouldBe` Just teamList + + it "encodes CreateTeam to JSON" $ do + let src = CreateTeam { createTeamName = TeamName "My Team" } + dst = "{\"name\":\"My Team\"}" + encode src `shouldBe` dst + (decode . encode) src `shouldBe` Just src + + it "encodes UpdateTeam to JSON" $ do + let src = UpdateTeam { updateTeamName = TeamName "New Team Name" } + dst = "{\"name\":\"New Team Name\"}" + encode src `shouldBe` dst + (decode . encode) src `shouldBe` Just src + + describe "TeamMembership" $ do + let teamMembershipJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1RFQU1fTUVNQkVSU0hJUC8wZmNmYTJiOC1hZGNjLTQ1ZWEtYTc4Mi1lNDYwNTkyZjgxZWY6MTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ + \ \"teamId\" : \"Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ + \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"personEmail\" : \"johnny.chang@foomail.com\",\ + \ \"personDisplayName\" : \"John Andersen\",\ + \ \"personOrgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"isModerator\" : true,\ + \ \"created\" : \"2015-10-18T14:26:16.057Z\"\ + \}" + teamMembership = TeamMembership { teamMembershipId = TeamMembershipId "Y2lzY29zcGFyazovL3VzL1RFQU1fTUVNQkVSU0hJUC8wZmNmYTJiOC1hZGNjLTQ1ZWEtYTc4Mi1lNDYwNTkyZjgxZWY6MTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" + , teamMembershipErrors = Nothing + , teamMembershipTeamId = Just $ TeamId "Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" + , teamMembershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , teamMembershipPersonEmail = Just $ Email "johnny.chang@foomail.com" + , teamMembershipPersonDisplayName = Just $ DisplayName "John Andersen" + , teamMembershipPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , teamMembershipIsModerator = Just True + , teamMembershipCreated = Just $ Timestamp "2015-10-18T14:26:16.057Z" + } + teamMembershipErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + teamMembershipError = TeamMembership { teamMembershipId = TeamMembershipId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , teamMembershipErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + , teamMembershipTeamId = Nothing + , teamMembershipPersonId = Nothing + , teamMembershipPersonEmail = Nothing + , teamMembershipPersonDisplayName = Nothing + , teamMembershipPersonOrgId = Nothing + , teamMembershipIsModerator = Nothing + , teamMembershipCreated = Nothing + } + teamMembershipListJson = "{\"items\":[" <> teamMembershipJson <> "," <> teamMembershipErrorJson <> "]}" + teamMembershipList = TeamMembershipList [ teamMembership, teamMembershipError ] + + it "can be unwrapped from TeamMembershipList" $ do + unwrap teamMembershipList `shouldBe` [ teamMembership, teamMembershipError ] + + it "decodes Team Membership API response JSON" $ do + eitherDecode teamMembershipJson `shouldBe` Right teamMembership + (decode . encode) teamMembership `shouldBe` Just teamMembership + + it "decodes Team Membership list" $ do + eitherDecode teamMembershipListJson `shouldBe` Right teamMembershipList + (decode . encode) teamMembershipList `shouldBe` Just teamMembershipList + + it "encodes CreateTeamMembership to JSON" $ do + let src = CreateTeamMembership + { createTeamMembershipTeamId = TeamId "Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" + , createTeamMembershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , createTeamMembershipPersonEmail = Just $ Email "johnny.chang@foomail.com" + , createTeamMembershipIsModerator = Just True + } + dst = "{\ + \ \"teamId\" : \"Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ + \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"personEmail\" : \"johnny.chang@foomail.com\",\ + \ \"isModerator\" : true\ + \}" + eitherDecode dst `shouldBe` Right src + (decode . encode) src `shouldBe` (decode dst :: Maybe CreateTeamMembership) + + it "encodes UpdateTeamMembership to JSON" $ do + let src = UpdateTeamMembership { updateTeamMembershipIsModerator = False } + dst = "{\"isModerator\":false}" + encode src `shouldBe` dst + (decode . encode) src `shouldBe` Just src + + describe "Room" $ do + let roomJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"title\" : \"Project Unicorn - Sprint 0\",\ + \ \"type\" : \"group\",\ + \ \"isLocked\" : true,\ + \ \"sipAddress\" : \"01234567890@meet.ciscospark.com\",\ + \ \"teamId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz\",\ + \ \"lastActivity\" : \"2016-04-21T19:12:48.920Z\",\ + \ \"creatorId\": \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"created\" : \"2016-04-21T19:01:55.966Z\"\ + \}" + room = Room { roomId = RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , roomErrors = Nothing + , roomTitle = Just $ RoomTitle "Project Unicorn - Sprint 0" + , roomType = Just RoomTypeGroup + , roomIsLocked = Just True + , roomSipAddress = Just $ SipAddr "01234567890@meet.ciscospark.com" + , roomLastActivity = Just $ Timestamp "2016-04-21T19:12:48.920Z" + , roomTeamId = Just $ TeamId "Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz" + , roomCreatorId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , roomCreated = Just $ Timestamp "2016-04-21T19:01:55.966Z" + } + roomErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + roomError = Room { roomId = RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , roomErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + , roomTitle = Nothing + , roomType = Nothing + , roomIsLocked = Nothing + , roomSipAddress = Nothing + , roomLastActivity = Nothing + , roomTeamId = Nothing + , roomCreatorId = Nothing + , roomCreated = Nothing + } + roomListJson = "{\"items\":[" <> roomJson <> "," <> roomErrorJson <> "]}" + roomList = RoomList [ room, roomError ] + + it "can be unwrapped from RoomList" $ do + unwrap roomList `shouldBe` [ room, roomError ] + + it "decodes Room API response JSON" $ do + eitherDecode roomJson `shouldBe` Right room + (decode . encode) room `shouldBe` Just room + + it "decodes Room list" $ do + eitherDecode roomListJson `shouldBe` Right roomList + (decode . encode) roomList `shouldBe` Just roomList + + it "encodes CreateRoom to JSON" $ do + let src = CreateRoom { createRoomTitle = RoomTitle "Project Unicorn - Sprint 0" + , createRoomTeamId = Just $ TeamId "Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz" + } + dst = "{\ + \ \"title\" : \"Project Unicorn - Sprint 0\",\ + \ \"teamId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz\"\ + \}" + eitherDecode dst `shouldBe` Right src + (decode . encode) src `shouldBe` (decode dst :: Maybe CreateRoom) + + it "encodes UpdateRoom to JSON" $ do + let src = UpdateRoom { updateRoomTitle = RoomTitle "Project Unicorn - Sprint 0" } + dst = "{\"title\":\"Project Unicorn - Sprint 0\"}" + encode src `shouldBe` dst + (decode . encode) src `shouldBe` Just src + + describe "Membership" $ do + let membershipJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL01FTUJFUlNISVAvMGQwYzkxYjYtY2U2MC00NzI1LWI2ZDAtMzQ1NWQ1ZDExZWYzOmNkZTFkZDQwLTJmMGQtMTFlNS1iYTljLTdiNjU1NmQyMjA3Yg\",\ + \ \"roomId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"personEmail\" : \"john.andersen@example.com\",\ + \ \"personDisplayName\" : \"John Andersen\",\ + \ \"personOrgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"isModerator\" : true,\ + \ \"isMonitor\" : true,\ + \ \"created\" : \"2015-10-18T14:26:16.203Z\"\ + \}" + membership = Membership { membershipId = MembershipId "Y2lzY29zcGFyazovL3VzL01FTUJFUlNISVAvMGQwYzkxYjYtY2U2MC00NzI1LWI2ZDAtMzQ1NWQ1ZDExZWYzOmNkZTFkZDQwLTJmMGQtMTFlNS1iYTljLTdiNjU1NmQyMjA3Yg" + , membershipErrors = Nothing + , membershipRoomId = Just $ RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , membershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , membershipPersonEmail = Just $ Email "john.andersen@example.com" + , membershipPersonDisplayName = Just $ DisplayName "John Andersen" + , membershipPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , membershipIsModerator = Just True + , membershipIsMonitor = Just True + , membershipCreated = Just $ Timestamp "2015-10-18T14:26:16.203Z" + } + membershipErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + membershipError = Membership { membershipId = MembershipId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , membershipErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + , membershipRoomId = Nothing + , membershipPersonId = Nothing + , membershipPersonEmail = Nothing + , membershipPersonDisplayName = Nothing + , membershipPersonOrgId = Nothing + , membershipIsModerator = Nothing + , membershipIsMonitor = Nothing + , membershipCreated = Nothing + } + membershipListJson = "{\"items\":[" <> membershipJson <> "," <> membershipErrorJson <> "]}" + membershipList = MembershipList [ membership, membershipError ] + + it "can be unwrapped from MembershipList" $ do + unwrap membershipList `shouldBe` [ membership, membershipError ] + + it "decodes Team Membership API response JSON" $ do + eitherDecode membershipJson `shouldBe` Right membership + (decode . encode) membership `shouldBe` Just membership + + it "decodes Team Membership list" $ do + eitherDecode membershipListJson `shouldBe` Right membershipList + (decode . encode) membershipList `shouldBe` Just membershipList + + it "encodes CreateMembership to JSON" $ do + let src = CreateMembership + { createMembershipRoomId = RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , createMembershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , createMembershipPersonEmail = Just $ Email "john.andersen@example.com" + , createMembershipIsModerator = Just True + } + dst = "{\ + \ \"roomId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"personEmail\" : \"john.andersen@example.com\",\ + \ \"isModerator\" : true\ + \}" + eitherDecode dst `shouldBe` Right src + (decode . encode) src `shouldBe` (decode dst :: Maybe CreateMembership) + + it "encodes UpdateMembership to JSON" $ do + let src = UpdateMembership { updateMembershipIsModerator = False } + dst = "{\"isModerator\":false}" + encode src `shouldBe` dst + (decode . encode) src `shouldBe` Just src + + describe "Message" $ do + let messageJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL01FU1NBR0UvOTJkYjNiZTAtNDNiZC0xMWU2LThhZTktZGQ1YjNkZmM1NjVk\",\ + \ \"roomId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"roomType\" : \"group\",\ + \ \"toPersonId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\",\ + \ \"toPersonEmail\" : \"julie@example.com\",\ + \ \"text\" : \"PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W.\",\ + \ \"html\" : \"

HTML formatted message goes here

when the message was posted in markdown format.

\",\ + \ \"files\" : [ \"http://www.example.com/images/media.png\" ],\ + \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"personEmail\" : \"matt@example.com\",\ + \ \"created\" : \"2015-10-18T14:26:16+00:00\",\ + \ \"mentionedPeople\" : [ \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS8yNDlmNzRkOS1kYjhhLTQzY2EtODk2Yi04NzllZDI0MGFjNTM\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS83YWYyZjcyYy0xZDk1LTQxZjAtYTcxNi00MjlmZmNmYmM0ZDg\" ]\ + \}" + message = Message { messageId = MessageId "Y2lzY29zcGFyazovL3VzL01FU1NBR0UvOTJkYjNiZTAtNDNiZC0xMWU2LThhZTktZGQ1YjNkZmM1NjVk" + , messageErrors = Nothing + , messageRoomId = Just $ RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , messageRoomType = Just $ RoomTypeGroup + , messageToPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX" + , messageToPersonEmail = Just $ Email "julie@example.com" + , messageText = Just $ MessageText "PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W." + , messageHtml = Just $ MessageHtml "

HTML formatted message goes here

when the message was posted in markdown format.

" + , messageFiles = Just [ FileUrl "http://www.example.com/images/media.png" ] + , messagePersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , messagePersonEmail = Just $ Email "matt@example.com" + , messageCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + , messageMentionedPeople = Just [ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS8yNDlmNzRkOS1kYjhhLTQzY2EtODk2Yi04NzllZDI0MGFjNTM" + , PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS83YWYyZjcyYy0xZDk1LTQxZjAtYTcxNi00MjlmZmNmYmM0ZDg" ] + } + messageErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + messageError = Message { messageId = MessageId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , messageErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + , messageRoomId = Nothing + , messageRoomType = Nothing + , messageToPersonId = Nothing + , messageToPersonEmail = Nothing + , messageText = Nothing + , messageHtml = Nothing + , messageFiles = Nothing + , messagePersonId = Nothing + , messagePersonEmail = Nothing + , messageCreated = Nothing + , messageMentionedPeople = Nothing + } + messageListJson = "{\"items\":[" <> messageJson <> "," <> messageErrorJson <> "]}" + messageList = MessageList [ message, messageError ] + + it "can be unwrapped from MessageList" $ do + unwrap messageList `shouldBe` [ message, messageError ] + + it "decodes Message API response JSON" $ do + eitherDecode messageJson `shouldBe` Right message + (decode . encode) message `shouldBe` Just message + + it "decodes Message list" $ do + eitherDecode messageListJson `shouldBe` Right messageList + (decode . encode) messageList `shouldBe` Just messageList + + it "encodes CreateMessage to JSON" $ do + let src = CreateMessage + { createMessageRoomId = Just $ RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , createMessageToPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX" + , createMessageToPersonEmail = Just $ Email "julie@example.com" + , createMessageText = Just $ MessageText "PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W." + , createMessageMarkdown = Just $ MessageMarkdown "**PROJECT UPDATE** A new project plan has been published [on Box](http://box.com/s/lf5vj). The PM for this project is <@personEmail:mike@example.com> and the Engineering Manager is <@personEmail:jane@example.com>." + , createMessageFiles = Just $ [ FileUrl "http://www.example.com/images/media.png" ] + } + dst = "{\ + \ \"roomId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"toPersonId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\",\ + \ \"toPersonEmail\" : \"julie@example.com\",\ + \ \"text\" : \"PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W.\",\ + \ \"markdown\" : \"**PROJECT UPDATE** A new project plan has been published [on Box](http://box.com/s/lf5vj). The PM for this project is <@personEmail:mike@example.com> and the Engineering Manager is <@personEmail:jane@example.com>.\",\ + \ \"files\" : [ \"http://www.example.com/images/media.png\" ]\ + \}" + eitherDecode dst `shouldBe` Right src + (decode . encode) src `shouldBe` (decode dst :: Maybe CreateMessage) + + describe "Organization" $ do + let organizationJson = "{\ + \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ + \ \"displayName\" : \"Cisco, Inc.\",\ + \ \"created\" : \"2015-10-18T14:26:16+00:00\"\ + \}" + organization = Organization { organizationId = OrganizationId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" + , organizationErrors = Nothing + , organizationDisplayName = Just $ OrganizationDisplayName "Cisco, Inc." + , organizationCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + } + organizationErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + organizationError = Organization { organizationId = OrganizationId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , organizationErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + , organizationDisplayName = Nothing + , organizationCreated = Nothing + } + organizationListJson = "{\"items\":[" <> organizationJson <> "," <> organizationErrorJson <> "]}" + organizationList = OrganizationList [ organization, organizationError ] + + it "can be unwrapped from OrganizationList" $ do + unwrap organizationList `shouldBe` [ organization, organizationError ] + + it "decodes Organization API response JSON" $ do + eitherDecode organizationJson `shouldBe` Right organization + (decode . encode) organization `shouldBe` Just organization + + it "decodes Organization list" $ do + eitherDecode organizationListJson `shouldBe` Right organizationList + (decode . encode) organizationList `shouldBe` Just organizationList + + describe "License" $ do + let licenseJson = "{\ + \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ + \ \"name\" : \"Spark Calling\",\ + \ \"totalUnits\" : 42,\ + \ \"consumedUnits\" : 8\ + \}" + license = License { licenseId = LicenseId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" + , licenseErrors = Nothing + , licenseName = Just $ LicenseName "Spark Calling" + , licenseTotalUnits = Just $ LicenseUnit 42 + , licenseConsumedUnits = Just $ LicenseUnit 8 + } + licenseErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + licenseError = License { licenseId = LicenseId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , licenseErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + , licenseName = Nothing + , licenseTotalUnits = Nothing + , licenseConsumedUnits = Nothing + } + licenseListJson = "{\"items\":[" <> licenseJson <> "," <> licenseErrorJson <> "]}" + licenseList = LicenseList [ license, licenseError ] + + it "can be unwrapped from LicenseList" $ do + unwrap licenseList `shouldBe` [ license, licenseError ] + + it "decodes License API response JSON" $ do + eitherDecode licenseJson `shouldBe` Right license + (decode . encode) license `shouldBe` Just license + + it "decodes License list" $ do + eitherDecode licenseListJson `shouldBe` Right licenseList + (decode . encode) licenseList `shouldBe` Just licenseList + + describe "Role" $ do + let roleJson = "{\ + \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ + \ \"name\" : \"Full Administrator\"\ + \}" + role = Role { roleId = RoleId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" + , roleErrors = Nothing + , roleName = Just $ RoleName "Full Administrator" + } + roleErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + roleError = Role { roleId = RoleId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , roleErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + , roleName = Nothing + } + roleListJson = "{\"items\":[" <> roleJson <> "]}" + roleList = RoleList [ role ] + + it "can be unwrapped from RoleList" $ do + unwrap roleList `shouldBe` [ role ] + + it "decodes Role API response JSON" $ do + eitherDecode roleJson `shouldBe` Right role + (decode . encode) role `shouldBe` Just role + + it "decodes Role list" $ do + eitherDecode roleListJson `shouldBe` Right roleList + (decode . encode) roleList `shouldBe` Just roleList + + describe "Webhook" $ do + let webhookJson = "{\ + \ \"id\" : \"96abc2aa-3dcc-11e5-a152-fe34819cdc9a\",\ + \ \"name\" : \"My Awesome Webhook\",\ + \ \"targetUrl\" : \"https://example.com/mywebhook\",\ + \ \"resource\" : \"messages\",\ + \ \"event\" : \"created\",\ + \ \"filter\" : \"roomId=Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"secret\" : \"86dacc007724d8ea666f88fc77d918dad9537a15\",\ + \ \"created\" : \"2015-10-18T14:26:16+00:00\"\ + \}" + webhook = Webhook { webhookId = WebhookId "96abc2aa-3dcc-11e5-a152-fe34819cdc9a" + , webhookErrors = Nothing + , webhookName = Just $ WebhookName "My Awesome Webhook" + , webhookTargetUrl = Just $ WebhookUrl "https://example.com/mywebhook" + , webhookResource = Just $ WebhookResourceMessages + , webhookEvent = Just $ WebhookEventCreated + , webhookFilter = Just $ WebhookFilter "roomId=Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , webhookSecret = Just $ WebhookSecret "86dacc007724d8ea666f88fc77d918dad9537a15" + , webhookCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + } + webhookErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + webhookError = Webhook { webhookId = WebhookId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , webhookErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + , webhookName = Nothing + , webhookTargetUrl = Nothing + , webhookResource = Nothing + , webhookEvent = Nothing + , webhookFilter = Nothing + , webhookSecret = Nothing + , webhookCreated = Nothing + } + webhookListJson = "{\"items\":[" <> webhookJson <> "," <> webhookErrorJson <> "]}" + webhookList = WebhookList [ webhook, webhookError ] + + it "can be unwrapped from WebhookList" $ do + unwrap webhookList `shouldBe` [ webhook, webhookError ] + + it "decodes Webhook API response JSON" $ do + eitherDecode webhookJson `shouldBe` Right webhook + (decode . encode) webhook `shouldBe` Just webhook + + it "decodes Webhook list" $ do + eitherDecode webhookListJson `shouldBe` Right webhookList + (decode . encode) webhookList `shouldBe` Just webhookList + + it "encodes CreateWebhook to JSON" $ do + let src = CreateWebhook { createWebhookName = WebhookName "My Awesome Webhook" + , createWebhookTargetUrl = WebhookUrl "https://example.com/mywebhook" + , createWebhookResource = WebhookResourceMessages + , createWebhookEvent = WebhookEventCreated + , createWebhookFilter = Just $ WebhookFilter "roomId=Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , createWebhookSecret = Just $ WebhookSecret "86dacc007724d8ea666f88fc77d918dad9537a15" + } + dst = "{\ + \ \"name\" : \"My Awesome Webhook\",\ + \ \"targetUrl\" : \"https://example.com/mywebhook\",\ + \ \"resource\" : \"messages\",\ + \ \"event\" : \"created\",\ + \ \"filter\" : \"roomId=Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"secret\" : \"86dacc007724d8ea666f88fc77d918dad9537a15\"\ + \}" + eitherDecode dst `shouldBe` Right src + (decode . encode) src `shouldBe` (decode dst :: Maybe CreateWebhook) + + it "encodes UpdateWebhook to JSON" $ do + let src = UpdateWebhook { updateWebhookName = WebhookName "My Awesome Webhook" + , updateWebhookTargetUrl = WebhookUrl "https://example.com/mywebhook" + } + dst = "{\"name\":\"My Awesome Webhook\",\"targetUrl\":\"https://example.com/mywebhook\"}" + encode src `shouldBe` dst + (decode . encode) src `shouldBe` Just src diff --git a/test/Network/WebexTeamsSpec.hs b/test/Network/WebexTeamsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/WebexTeamsSpec.hs @@ -0,0 +1,1598 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.WebexTeamsSpec where + +import Control.Concurrent.Async (withAsync) +import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, + takeMVar) +import Control.Monad (void) +import Data.Aeson (decode, encode) +import Data.Attoparsec.ByteString (parseOnly) +import qualified Data.ByteString as S (ByteString) +import qualified Data.ByteString.Char8 as C8 (pack, unpack) +import qualified Data.ByteString.Lazy as L (ByteString) +import Data.Default (def) +import Data.List (sort) +import Data.Maybe (fromJust) +import Data.Monoid ((<>)) +import Data.Text (pack) +import Network.HTTP.Simple as C (addRequestHeader, + defaultRequest, + getResponseBody, httpJSON, + parseRequest, setRequestHost, + setRequestMethod, + setRequestPath, + setRequestPort, + setRequestSecure) +import Network.HTTP.Types (Header, status200) +import Network.URI (URIAuth (..)) +import Network.Wai (Application, queryString, + rawPathInfo, requestHeaders, + requestMethod, responseLBS, + strictRequestBody) +import Network.Wai.Handler.Warp (defaultSettings, runSettings, + setBeforeMainLoop, setPort) + +import Test.Hspec + +import Network.WebexTeams +import Network.WebexTeams.Internal (LinkHeader (..), LinkParam (..), + getNextUrl, linkHeader) + + +import Data.Typeable (typeOf) + + +listenPort = 3000 +listenPortBS = (C8.pack . show) listenPort + +mockBaseRequestRequest + = C.addRequestHeader "Content-Type" "application/json; charset=utf-8" + $ C.setRequestPort listenPort + $ C.setRequestHost "127.0.0.1" + $ C.setRequestSecure False + $ C.defaultRequest + +mockBaseRequest :: WebexTeamsRequest +mockBaseRequest = WebexTeamsRequest mockBaseRequestRequest "http:" $ + URIAuth "" "127.0.0.1" (":" <> show listenPort) + +dummyAuth :: Authorization +dummyAuth = Authorization "dummyAuth" + +extractRight :: Show err => Either err r -> r +extractRight (Right r) = r +extractRight (Left err) = error $ show err + +withMockServer :: Application -> IO () -> IO () +withMockServer app inner = do + readyToConnect <- newEmptyMVar + let set = setBeforeMainLoop (putMVar readyToConnect ()) $ setPort listenPort defaultSettings + withAsync (runSettings set app) (\_ -> takeMVar readyToConnect >> inner) + +helloApp :: Application +helloApp _ respond = respond $ responseLBS status200 [] "hello, world" + +contentType :: Header +contentType = ("Content-Type", "application/json; charset=utf-8") + +simpleApp :: L.ByteString -> Application +simpleApp res _ respond = respond $ responseLBS status200 [contentType] res + +paginationApp :: [L.ByteString] -> Application +paginationApp ress req respond = do + let (cTypes, body) = dispatch $ rawPathInfo req + respond $ responseLBS status200 cTypes body + where + dispatch "/1" = ([contentType, ("Link", " listenPortBS <> "/2>; rel=\"next\"")], ress !! 1) + dispatch "/2" = ([contentType, ("Link", " listenPortBS <> "/3>; rel=\"next\"")], ress !! 2) + dispatch "/3" = ([contentType], ress !! 3) + dispatch _ = ([contentType, ("Link", " listenPortBS <> "/1>; rel=\"next\"")], ress !! 0) + +invalidPaginationApp :: [L.ByteString] -> Application +invalidPaginationApp ress req respond = do + let (cTypes, body) = dispatch $ rawPathInfo req + respond $ responseLBS status200 cTypes body + where + dispatch "/1" = ([contentType, ("Link", "; rel=\"next\"")], ress !! 1) + dispatch "/2" = ([contentType, ("Link", " listenPortBS <> "/3>; rel=\"next\"")], ress !! 2) + dispatch "/3" = ([contentType], ress !! 3) + dispatch _ = ([contentType, ("Link", " listenPortBS <> "/1>; rel=\"next\"")], ress !! 0) + + +teamGen :: String -> Team +teamGen i = Team { teamId = TeamId . pack $ "teamId" <> i + , teamErrors = Nothing + , teamName = Just . TeamName . pack $ "teamName" <> i + , teamCreatorId = Just . PersonId . pack $ "teamCreatorId" <> i + , teamCreated = Just . Timestamp . pack $ "teamCreated" <> i + } + +teamList :: String -> [Team] +teamList j = [ teamGen $ j <> show i | i <- [1..3] ] + +teamListList :: [[Team]] +teamListList = [ teamList [c] | c <- ['a'..'d'] ] + +readAllList :: ListReader i -> IO [i] +readAllList reader = go [] + where + go xs = reader >>= \chunk -> case chunk of + [] -> pure xs + ys -> go (xs <> ys) + +spec :: Spec +spec = do + describe "Mock Applications" $ do + it "simple mock app returns list of team" $ do + receivedReqMVar <- newEmptyMVar + let (WebexTeamsRequest baseReq _ _) = mockBaseRequest + req = setRequestPath "/v1/teams" + $ setRequestMethod "GET" + $ baseReq + testData = TeamList $ teamList ['Z'] + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode testData) req respond + ) $ do + res <- getResponseBody <$> httpJSON req + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/teams" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "pagenation mock app returns list of team and Link header" $ do + receivedReqMVar <- newEmptyMVar + let (WebexTeamsRequest baseReq _ _) = mockBaseRequest + req = setRequestPath "/v1/teams" + $ setRequestMethod "GET" + $ baseReq + testData = encode . TeamList <$> teamListList + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + paginationApp testData req respond + ) $ do + res1 <- httpJSON req + getResponseBody res1 `shouldBe` TeamList (teamListList !! 0) + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/teams" + + let path = getNextUrl res1 + path `shouldBe` (Just $ "http://127.0.0.1:" <> listenPortBS <> "/1") + + req2 <- parseRequest $ "GET " <> C8.unpack (fromJust path) + res2 <- httpJSON req2 + getResponseBody res2 `shouldBe` TeamList (teamListList !! 1) + + describe "People" $ do + let personJson1 = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"emails\" : [ \"johnny.chang@foomail.com\", \"jchang@barmail.com\" ],\ + \ \"displayName\" : \"John Andersen\",\ + \ \"firstName\" : \"John\",\ + \ \"lastName\" : \"Andersen\",\ + \ \"avatar\" : \"https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600\",\ + \ \"orgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"roles\" : [ \"Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\" ],\ + \ \"licenses\" : [ \"Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\" ],\ + \ \"created\" : \"2015-10-18T14:26:16.000Z\",\ + \ \"timezone\" : \"America/Denver\",\ + \ \"lastActivity\" : \"2015-10-18T14:26:16.028Z\",\ + \ \"status\" : \"active\",\ + \ \"invitePending\" : false,\ + \ \"loginEnabled\" : true\ + \}" + person1 = Person { personId = PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , personErrors = Nothing + , personEmails = Just [Email "johnny.chang@foomail.com", Email "jchang@barmail.com"] + , personDisplayName = Just $ DisplayName "John Andersen" + , personNickName = Nothing + , personFirstName = Just $ FirstName "John" + , personLastName = Just $ LastName "Andersen" + , personAvatar = Just $ AvatarUrl "https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600" + , personOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , personRoles = Just [ RoleId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , RoleId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] + , personLicenses = Just [ LicenseId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , LicenseId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] + , personCreated = Just $ Timestamp "2015-10-18T14:26:16.000Z" + , personTimezone = Just $ Timezone "America/Denver" + , personLastActivity = Just $ Timestamp "2015-10-18T14:26:16.028Z" + , personStatus = Just PersonStatusActive + , personInvitePending = Just False + , personLoginEnabled = Just True + , personType = Nothing + } + personGen i = Person { personId = PersonId . pack $ "PersonId" <> i + , personErrors = Nothing + , personEmails = Just [Email . pack $ "email" <> i <> "@foomail.com", Email . pack $ "email" <> i <> "@barmail.com"] + , personDisplayName = Just . DisplayName . pack $ "John Andersen" <> i + , personNickName = Nothing + , personFirstName = Just $ FirstName . pack $ "John" <> i + , personLastName = Just $ LastName . pack $ "Andersen" <> i + , personAvatar = Just $ AvatarUrl . pack $ "https://AvatarUrl" <> i + , personOrgId = Just . OrganizationId . pack $ "OrganizationId" <> i + , personRoles = Just [ RoleId . pack $ "RoleIdA" <> i + , RoleId . pack $ "RoleIdB" <> i] + , personLicenses = Just [ LicenseId . pack $ "LicenseIdX" <> i + , LicenseId . pack $ "LicenseIdY" <> i] + , personCreated = Just . Timestamp . pack $ "Created" <> i + , personTimezone = Just $ Timezone . pack $ "Timezone" <> i + , personLastActivity = Just $ Timestamp . pack $ "LastActivity" <> i + , personStatus = Just PersonStatusActive + , personInvitePending = Just False + , personLoginEnabled = Just True + , personType = Nothing + } + personList j = [ personGen $ j <> show i | i <- [1..3] ] + personListList = [ personList [c] | c <- ['a'..'d'] ] + newPerson = CreatePerson { createPersonEmails = Just $ [Email "johnny.chang@foomail.com", Email "jchang@barmail.com"] + , createPersonDisplayName = Just $ DisplayName "John Andersen" + , createPersonFirstName = Just $ FirstName "John" + , createPersonLastName = Just $ LastName "Andersen" + , createPersonAvatar = Just $ AvatarUrl "https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600" + , createPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , createPersonRoles = Just [ RoleId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , RoleId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] + , createPersonLicenses = Just [ LicenseId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , LicenseId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] + } + updatePerson = UpdatePerson { updatePersonDisplayName = Just $ DisplayName "New John Andersen" + , updatePersonFirstName = Just $ FirstName "New John" + , updatePersonLastName = Just $ LastName "New Andersen" + , updatePersonAvatar = Just $ AvatarUrl "https://example.com/newAvatarUrl" + , updatePersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , updatePersonRoles = Just $ [ RoleId "newRoleId1", RoleId "newRoleId2" ] + , updatePersonLicenses = Just $ [ LicenseId "newLicenseId1", LicenseId "newLicenseId2" ] + } + + it "getPersonList returns ListReader of Person" $ do + let testData = personList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (PersonList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/people" + queryString receivedReq `shouldBe` [] + + it "getPersonList passes query strings build from PersonFilter to server" $ do + let testData = personList ['Z'] + personFilter = PersonFilter (Just $ Email "person@filter.com") + (Just $ DisplayName "DisplayNameFilter") + (Just $ OrganizationId "OrgIdFilter") + + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (PersonList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest personFilter >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/people" + (sort . queryString) receivedReq `shouldBe` sort [ ("orgId", Just "OrgIdFilter") + , ("displayName", Just "DisplayNameFilter") + , ("email", Just "person@filter.com") ] + + it "getPersonList returns ListReader of Person performing automatic pagination" $ do + withMockServer (paginationApp $ encode . PersonList <$> personListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) >>= readAllList + res `shouldBe` concat personListList + + it "getPersonList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . PersonList <$> personListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) >>= readAllList + res `shouldBe` concat (take 2 personListList) + + it "getDetail for a person returns a Person" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp personJson1 req respond + ) $ do + resPerson <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (PersonId "testPersonId") + resPerson `shouldBe` person1 + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/people/testPersonId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a person returns a (Right Person)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp personJson1 req respond + ) $ do + (Right resPerson) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (PersonId "testPersonId") + resPerson `shouldBe` person1 + + it "createEntity for a person sends JSON encoded CreatePerson as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + ) $ do + resPerson <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newPerson + resPerson `shouldBe` person1 + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/people" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newPerson + + it "createEntityEither for a person sends JSON encoded CreatePerson as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + ) $ do + (Right resPerson) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newPerson + resPerson `shouldBe` person1 + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/people" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newPerson + + it "updateEntity for a person sends JSON encoded UpdatePerson as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + ) $ do + resPerson <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updatePerson + resPerson `shouldBe` person1 + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/people" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updatePerson + + it "updateEntityEither for a person sends JSON encoded UpdatePerson as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + ) $ do + (Right resPerson) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updatePerson + resPerson `shouldBe` person1 + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/people" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updatePerson + + describe "Team" $ do + let teamJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ + \ \"name\" : \"Build Squad\",\ + \ \"creatorId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"created\" : \"2015-10-18T14:26:16+00:00\"\ + \}" + team = Team { teamId = TeamId "Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" + , teamErrors = Nothing + , teamName = Just $ TeamName "Build Squad" + , teamCreatorId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , teamCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + } + newTeam = CreateTeam $ TeamName "Build Squad" + updateTeam = UpdateTeam $ TeamName "updatedTeamName" + + it "getTeamList returns ListReader of Team" $ do + let testData = teamList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (TeamList testData)) req respond + ) $ do + res <- getTeamList dummyAuth mockBaseRequest >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/teams" + queryString receivedReq `shouldBe` [] + + it "getTeamList returns ListReader of Team performing automatic pagination" $ do + withMockServer (paginationApp $ encode . TeamList <$> teamListList) $ do + res <- getTeamList dummyAuth mockBaseRequest >>= readAllList + res `shouldBe` concat teamListList + + it "getTeamList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . TeamList <$> teamListList) $ do + res <- getTeamList dummyAuth mockBaseRequest >>= readAllList + res `shouldBe` concat (take 2 teamListList) + + it "getDetail for a team returns a Team" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp teamJson req respond + ) $ do + resTeam <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (TeamId "testTeamId") + resTeam `shouldBe` team + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/teams/testTeamId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a team returns a (Right Team)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp teamJson req respond + ) $ do + (Right resTeam) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (TeamId "testTeamId") + resTeam `shouldBe` team + + it "createEntity for a team sends JSON encoded CreateTeam as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + ) $ do + resTeam <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newTeam + resTeam `shouldBe` team + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/teams" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newTeam + + it "createEntityEither for a team sends JSON encoded CreateTeam as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + ) $ do + (Right resTeam) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newTeam + resTeam `shouldBe` team + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/teams" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newTeam + + it "updateEntity for a team sends JSON encoded UpdateTeam as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + ) $ do + resTeam <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateTeam + resTeam `shouldBe` team + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/teams" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateTeam + + it "updateEntityEither for a team sends JSON encoded UpdateTeam as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + ) $ do + (Right resTeam) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateTeam + resTeam `shouldBe` team + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/teams" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateTeam + + it "deleteTeam sends DELETE request with teamId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + ) $ do + deleteTeam dummyAuth mockBaseRequest (TeamId "testTeamId") + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "DELETE" + rawPathInfo receivedReq `shouldBe` "/v1/teams/testTeamId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + describe "TeamMemberShip" $ do + let teamMembershipJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1RFQU1fTUVNQkVSU0hJUC8wZmNmYTJiOC1hZGNjLTQ1ZWEtYTc4Mi1lNDYwNTkyZjgxZWY6MTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ + \ \"teamId\" : \"Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ + \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"personEmail\" : \"john.andersen@example.com\",\ + \ \"personDisplayName\" : \"John Andersen\",\ + \ \"personOrgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"isModerator\" : true,\ + \ \"created\" : \"2015-10-18T14:26:16.057Z\"\ + \}" + teamMembership = TeamMembership { teamMembershipId = TeamMembershipId "Y2lzY29zcGFyazovL3VzL1RFQU1fTUVNQkVSU0hJUC8wZmNmYTJiOC1hZGNjLTQ1ZWEtYTc4Mi1lNDYwNTkyZjgxZWY6MTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" + , teamMembershipErrors = Nothing + , teamMembershipTeamId = Just $ TeamId "Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" + , teamMembershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , teamMembershipPersonEmail = Just $ Email "john.andersen@example.com" + , teamMembershipPersonDisplayName = Just $ DisplayName "John Andersen" + , teamMembershipPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , teamMembershipIsModerator = Just True + , teamMembershipCreated = Just $ Timestamp "2015-10-18T14:26:16.057Z" + } + teamMembershipGen i = TeamMembership { teamMembershipId = TeamMembershipId . pack $ "teamMembershipId" <> i + , teamMembershipErrors = Nothing + , teamMembershipTeamId = Just . TeamId . pack $ "teamId" <> i + , teamMembershipPersonId = Just . PersonId . pack $ "personId" <> i + , teamMembershipPersonEmail = Just . Email . pack $ "email" <> i <> "@example.com" + , teamMembershipPersonDisplayName = Just . DisplayName . pack $ "DisplayName" <> i + , teamMembershipPersonOrgId = Just . OrganizationId . pack $ "OrganizationId" <> i + , teamMembershipIsModerator = Just True + , teamMembershipCreated = Just . Timestamp . pack $ "Timestamp" <> i + } + teamMembershipList j = [ teamMembershipGen $ j <> show i | i <- [1..3] ] + teamMembershipListList = [ teamMembershipList [c] | c <- ['a'..'d'] ] + defFilter = defaultTeamMembershipFilter $ TeamId "dummyTeamId" + newTeamMembership = CreateTeamMembership { createTeamMembershipTeamId = TeamId "targetTeam" + , createTeamMembershipPersonId = Just $ PersonId "addedPerson" + , createTeamMembershipPersonEmail = Just $ Email "added@example.com" + , createTeamMembershipIsModerator = Just True + } + updateTeamMembership = UpdateTeamMembership False + + it "getTeamMembershipList returns ListReader of TeamMembership" $ do + let testData = teamMembershipList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (TeamMembershipList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest defFilter >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + queryString receivedReq `shouldBe` [ ("teamId", Just "dummyTeamId") ] + + it "getTeamMembershipList passes query strings build from TeamMembershipFilter to server" $ do + let testData = teamMembershipList ['Z'] + teamMembershipFilter = TeamMembershipFilter $ TeamId "DummyTeamId" + + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (TeamMembershipList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest teamMembershipFilter >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + queryString receivedReq `shouldBe` [ ("teamId", Just "DummyTeamId") ] + + it "getTeamMembershipList returns ListReader of TeamMembership performing automatic pagination" $ do + withMockServer (paginationApp $ encode . TeamMembershipList <$> teamMembershipListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest defFilter >>= readAllList + res `shouldBe` concat teamMembershipListList + + it "getTeamMembershipList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . TeamMembershipList <$> teamMembershipListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest defFilter >>= readAllList + res `shouldBe` concat (take 2 teamMembershipListList) + + it "getDetail for a team membership returns a TeamMembership" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp teamMembershipJson req respond + ) $ do + resTeamMembership <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (TeamMembershipId "testTeamMembershipId") + resTeamMembership `shouldBe` teamMembership + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships/testTeamMembershipId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a team membership returns a (Right TeamMembership)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp teamMembershipJson req respond + ) $ do + (Right resTeamMembership) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (TeamMembershipId "testTeamMembershipId") + resTeamMembership `shouldBe` teamMembership + + it "createEntity for a team membership sends JSON encoded CreateTeamMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + ) $ do + resTeamMembership <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newTeamMembership + resTeamMembership `shouldBe` teamMembership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newTeamMembership + + it "createEntityEither for a team membership sends JSON encoded CreateTeamMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + ) $ do + (Right resTeamMembership) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newTeamMembership + resTeamMembership `shouldBe` teamMembership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newTeamMembership + + it "updateEntity for a teamMembership sends JSON encoded UpdateTeamMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + ) $ do + resTeamMembership <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateTeamMembership + resTeamMembership `shouldBe` teamMembership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateTeamMembership + + it "updateEntityEither for a teamMembership sends JSON encoded UpdateTeamMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + ) $ do + (Right resTeamMembership) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateTeamMembership + resTeamMembership `shouldBe` teamMembership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateTeamMembership + + it "deleteTeamMembership sends DELETE request with teamMembershipId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + ) $ do + deleteTeamMembership dummyAuth mockBaseRequest (TeamMembershipId "testTeamMembershipId") + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "DELETE" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships/testTeamMembershipId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + describe "Room" $ do + let roomJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"title\" : \"Project Unicorn - Sprint 0\",\ + \ \"type\" : \"group\",\ + \ \"isLocked\" : true,\ + \ \"sipAddress\" : \"01234567890@meet.ciscospark.com\",\ + \ \"teamId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz\",\ + \ \"lastActivity\" : \"2016-04-21T19:12:48.920Z\",\ + \ \"creatorId\": \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"created\" : \"2016-04-21T19:01:55.966Z\"\ + \}" + room = Room { roomId = RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , roomErrors = Nothing + , roomTitle = Just $ RoomTitle "Project Unicorn - Sprint 0" + , roomType = Just RoomTypeGroup + , roomIsLocked = Just True + , roomSipAddress = Just $ SipAddr "01234567890@meet.ciscospark.com" + , roomLastActivity = Just $ Timestamp "2016-04-21T19:12:48.920Z" + , roomTeamId = Just $ TeamId "Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz" + , roomCreatorId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , roomCreated = Just $ Timestamp "2016-04-21T19:01:55.966Z" + } + roomGen i = Room { roomId = RoomId . pack $ "roomId" <> i + , roomErrors = Nothing + , roomTitle = Just . RoomTitle . pack $ "roomTitle" <> i + , roomType = Just RoomTypeGroup + , roomIsLocked = Just True + , roomSipAddress = Just $ SipAddr . pack $ "rooomSipAddress" <> i <> "@meet.ciscospark.com" + , roomLastActivity = Just . Timestamp . pack $ "roomLastActivity" <> i + , roomTeamId = Just $ TeamId . pack $ "roomTeamId" <> i + , roomCreatorId = Just . PersonId . pack $ "personId" <> i + , roomCreated = Just .Timestamp .pack $ "roomCreated" <> i + } + roomList j = [ roomGen $ j <> show i | i <- [1..3] ] + roomListList = [ roomList [c] | c <- ['a'..'d'] ] + newRoom = CreateRoom (RoomTitle "New Room") (Just $ TeamId "belongingTeam") + updateRoom = UpdateRoom $ RoomTitle "updatedRoomTitle" + + it "getRoomList returns ListReader of Room" $ do + let testData = roomList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (RoomList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + queryString receivedReq `shouldBe` [] + + it "getRoomList passes query strings build from RoomFilter to server" $ do + let testData = roomList ['Z'] + roomFilter = RoomFilter (Just $ TeamId "dummyTeamId") + (Just RoomTypeGroup) + (Just RoomFilterSortByLastActivity) + + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (RoomList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest roomFilter >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + (sort . queryString) receivedReq `shouldBe` sort [ ("type", Just "group") + , ("sortBy", Just "lastactivity") + , ("teamId", Just "dummyTeamId") ] + + it "getRoomList returns ListReader of Room performing automatic pagination" $ do + withMockServer (paginationApp $ encode . RoomList <$> roomListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) >>= readAllList + res `shouldBe` concat roomListList + + it "getRoomList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . RoomList <$> roomListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) >>= readAllList + res `shouldBe` concat (take 2 roomListList) + + it "getDetail for a room returns a Room" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp roomJson req respond + ) $ do + resRoom <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (RoomId "testRoomId") + resRoom `shouldBe` room + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/rooms/testRoomId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a room returns a (Right Room)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp roomJson req respond + ) $ do + (Right resRoom) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (RoomId "testRoomId") + resRoom `shouldBe` room + + it "createEntity for a room sends JSON encoded CreateRoom as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + ) $ do + resRoom <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newRoom + resRoom `shouldBe` room + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newRoom + + it "createEntithEither for a room sends JSON encoded CreateRoom as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + ) $ do + (Right resRoom) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newRoom + resRoom `shouldBe` room + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newRoom + + it "updateEntity for a room sends JSON encoded UpdateRoom as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + ) $ do + resRoom <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateRoom + resRoom `shouldBe` room + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateRoom + + it "updateEntityEither for a room sends JSON encoded UpdateRoom as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + ) $ do + (Right resRoom) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateRoom + resRoom `shouldBe` room + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateRoom + + it "deleteRoom sends DELETE request with roomId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + ) $ do + deleteRoom dummyAuth mockBaseRequest (RoomId "testRoomId") + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "DELETE" + rawPathInfo receivedReq `shouldBe` "/v1/rooms/testRoomId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + describe "Membership" $ do + let membershipJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL01FTUJFUlNISVAvMGQwYzkxYjYtY2U2MC00NzI1LWI2ZDAtMzQ1NWQ1ZDExZWYzOmNkZTFkZDQwLTJmMGQtMTFlNS1iYTljLTdiNjU1NmQyMjA3Yg\",\ + \ \"roomId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"personEmail\" : \"john.andersen@example.com\",\ + \ \"personDisplayName\" : \"John Andersen\",\ + \ \"personOrgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"isModerator\" : true,\ + \ \"isMonitor\" : true,\ + \ \"created\" : \"2015-10-18T14:26:16.203Z\"\ + \}" + membership = Membership { membershipId = MembershipId "Y2lzY29zcGFyazovL3VzL01FTUJFUlNISVAvMGQwYzkxYjYtY2U2MC00NzI1LWI2ZDAtMzQ1NWQ1ZDExZWYzOmNkZTFkZDQwLTJmMGQtMTFlNS1iYTljLTdiNjU1NmQyMjA3Yg" + , membershipErrors = Nothing + , membershipRoomId = Just $ RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , membershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , membershipPersonEmail = Just $ Email "john.andersen@example.com" + , membershipPersonDisplayName = Just $ DisplayName "John Andersen" + , membershipPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , membershipIsModerator = Just True + , membershipIsMonitor = Just True + , membershipCreated = Just $ Timestamp "2015-10-18T14:26:16.203Z" + } + membershipGen i = Membership { membershipId = MembershipId . pack $ "membershipId" <> i + , membershipErrors = Nothing + , membershipRoomId = Just . RoomId . pack $ "roomId" <> i + , membershipPersonId = Just . PersonId . pack $ "personId" <> i + , membershipPersonEmail = Just . Email . pack $ "email" <> i <> "@example.com" + , membershipPersonDisplayName = Just . DisplayName . pack $ "displayName" <> i + , membershipPersonOrgId = Just . OrganizationId . pack $ "orgId" <> i + , membershipIsModerator = Just True + , membershipIsMonitor = Just True + , membershipCreated = Just . Timestamp . pack $ "timestamp" <> i + } + membershipList j = [ membershipGen $ j <> show i | i <- [1..3] ] + membershipListList = [ membershipList [c] | c <- ['a'..'d'] ] + newMembership = CreateMembership { createMembershipRoomId = RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , createMembershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , createMembershipPersonEmail = Just $ Email "john.andersen@example.com" + , createMembershipIsModerator = Just $ True + } + updateMembership = UpdateMembership False + + it "getMembershipList returns ListReader of Membership" $ do + let testData = membershipList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MembershipList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + queryString receivedReq `shouldBe` [] + + it "getMembershipList passes query strings build from MembershipFilter to server" $ do + let testData = membershipList ['Z'] + membershipFilter = MembershipFilter (Just $ RoomId "dummyRoomId") + (Just $ PersonId "personIdFilter") + (Just $ Email "personEmailFilter") + + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MembershipList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest membershipFilter >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + (sort . queryString) receivedReq `shouldBe` sort [ ("personId", Just "personIdFilter") + , ("personEmail", Just "personEmailFilter") + , ("roomId", Just "dummyRoomId") ] + + it "getMembershipList returns ListReader of Membership performing automatic pagination" $ do + withMockServer (paginationApp $ encode . MembershipList <$> membershipListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) >>= readAllList + res `shouldBe` concat membershipListList + + it "getMembershipList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . MembershipList <$> membershipListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) >>= readAllList + res `shouldBe` concat (take 2 membershipListList) + + it "getDetail for a menbership returns a Membership" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp membershipJson req respond + ) $ do + resMembership <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (MembershipId "testMembershipId") + resMembership `shouldBe` membership + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/memberships/testMembershipId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a membership returns a (Right Membership)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp membershipJson req respond + ) $ do + (Right resMembership) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (MembershipId "testMembershipId") + resMembership `shouldBe` membership + + it "createEntity for a membership sends JSON encoded CreateMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + ) $ do + resMembership <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newMembership + resMembership `shouldBe` membership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newMembership + + it "createEntithEither for a membership sends JSON encoded CreateMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + ) $ do + (Right resMembership) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newMembership + resMembership `shouldBe` membership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newMembership + + it "updateEntity for a membership sends JSON encoded UpdateMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + ) $ do + resMembership <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateMembership + resMembership `shouldBe` membership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateMembership + + it "updateEntityEither for a membership sends JSON encoded UpdateMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + ) $ do + (Right resMembership) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateMembership + resMembership `shouldBe` membership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateMembership + + it "deleteMembership sends DELETE request with membershipId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + ) $ do + deleteMembership dummyAuth mockBaseRequest (MembershipId "testMembershipId") + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "DELETE" + rawPathInfo receivedReq `shouldBe` "/v1/memberships/testMembershipId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + describe "Message" $ do + let messageJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL01FU1NBR0UvOTJkYjNiZTAtNDNiZC0xMWU2LThhZTktZGQ1YjNkZmM1NjVk\",\ + \ \"roomId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"roomType\" : \"group\",\ + \ \"toPersonId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\",\ + \ \"toPersonEmail\" : \"julie@example.com\",\ + \ \"text\" : \"PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W.\",\ + \ \"html\" : \"

HTML formatted message goes here

when the message was posted in markdown format.

\",\ + \ \"files\" : [ \"http://www.example.com/images/media.png\" ],\ + \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"personEmail\" : \"matt@example.com\",\ + \ \"created\" : \"2015-10-18T14:26:16+00:00\",\ + \ \"mentionedPeople\" : [ \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS8yNDlmNzRkOS1kYjhhLTQzY2EtODk2Yi04NzllZDI0MGFjNTM\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS83YWYyZjcyYy0xZDk1LTQxZjAtYTcxNi00MjlmZmNmYmM0ZDg\" ]\ + \}" + message = Message { messageId = MessageId "Y2lzY29zcGFyazovL3VzL01FU1NBR0UvOTJkYjNiZTAtNDNiZC0xMWU2LThhZTktZGQ1YjNkZmM1NjVk" + , messageErrors = Nothing + , messageRoomId = Just $ RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , messageRoomType = Just $ RoomTypeGroup + , messageToPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX" + , messageToPersonEmail = Just $ Email "julie@example.com" + , messageText = Just $ MessageText "PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W." + , messageHtml = Just $ MessageHtml "

HTML formatted message goes here

when the message was posted in markdown format.

" + , messageFiles = Just [ FileUrl "http://www.example.com/images/media.png" ] + , messagePersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , messagePersonEmail = Just $ Email "matt@example.com" + , messageCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + , messageMentionedPeople = Just [ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS8yNDlmNzRkOS1kYjhhLTQzY2EtODk2Yi04NzllZDI0MGFjNTM" + , PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS83YWYyZjcyYy0xZDk1LTQxZjAtYTcxNi00MjlmZmNmYmM0ZDg" ] + } + messageGen i = Message { messageId = MessageId . pack $ "messageId" <> i + , messageErrors = Nothing + , messageRoomId = Just . RoomId . pack $ "roomId" <> i + , messageRoomType = Just RoomTypeGroup + , messageToPersonId = Just . PersonId . pack $ "toPersonId" <> i + , messageToPersonEmail = Just . Email . pack $ "julie" <> i <> "@example.com" + , messageText = Just . MessageText . pack $ "messageText" <> i + , messageHtml = Just . MessageHtml . pack $ "messageHtml" <> i + , messageFiles = Just [ FileUrl . pack $ "http://www.example.com/images/media" <> i <> ".png" ] + , messagePersonId = Just . PersonId . pack $ "personId" <> i + , messagePersonEmail = Just . Email . pack $ "matt" <> i <> "@example.com" + , messageCreated = Just . Timestamp . pack $ "created" <> i + , messageMentionedPeople = Just [ PersonId . pack $ "memtionedPeople1-" <> i + , PersonId . pack $ "memtionedPeople2-" <> i ] + } + messageList j = [ messageGen $ j <> show i | i <- [1..3] ] + messageListList = [ messageList [c] | c <- ['a'..'d'] ] + defFilter = defaultMessageFilter $ RoomId "dummyRoomId" + newMessage = CreateMessage { createMessageRoomId = Just $ RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , createMessageToPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX" + , createMessageToPersonEmail = Just $ Email "julie@example.com" + , createMessageText = Just $ MessageText "PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W." + , createMessageMarkdown = Just $ MessageMarkdown "**PROJECT UPDATE** A new project plan has been published [on Box](http://box.com/s/lf5vj). The PM for this project is <@personEmail:mike@example.com> and the Engineering Manager is <@personEmail:jane@example.com>." + , createMessageFiles = Just $ [ FileUrl "http://www.example.com/images/media.png" ] + } + + it "getMessageList returns ListReader of Message" $ do + let testData = messageList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MessageList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest defFilter >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/messages" + queryString receivedReq `shouldBe` [ ("roomId", Just "dummyRoomId") ] + + it "getMessageList passes query strings build from MessageFilter to server" $ do + let testData = messageList ['Z'] + messageFilter = MessageFilter (RoomId "dummyRoomId") + (Just $ MentionedPeopleMe) + (Just $ Timestamp "beforeFilter") + (Just $ MessageId "beforeMessageFilter") + + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MessageList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest messageFilter >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/messages" + (sort . queryString) receivedReq `shouldBe` sort [ ("roomId", Just "dummyRoomId") + , ("mentionedPeople", Just "me") + , ("beforeMessage", Just "beforeMessageFilter") + , ("before", Just "beforeFilter") ] + + it "getMessageList returns ListReader of Message with automatic pagination" $ do + withMockServer (paginationApp $ encode . MessageList <$> messageListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest defFilter >>= readAllList + res `shouldBe` concat messageListList + + it "getMessageList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . MessageList <$> messageListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest defFilter >>= readAllList + res `shouldBe` concat (take 2 messageListList) + + it "getDetail for a message returns a Message" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp messageJson req respond + ) $ do + resMessage <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (MessageId "testMessageId") + resMessage `shouldBe` message + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/messages/testMessageId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a message returns a (Right Message)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp messageJson req respond + ) $ do + (Right resMessage) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (MessageId "testMessageId") + resMessage `shouldBe` message + + it "createEntity for a message sends JSON encoded CreateMessage as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp messageJson req respond + ) $ do + resMessage <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newMessage + resMessage `shouldBe` message + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/messages" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newMessage + + it "createEntithEither for a message sends JSON encoded CreateMessage as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp messageJson req respond + ) $ do + (Right resMessage) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newMessage + resMessage `shouldBe` message + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/messages" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newMessage + + it "deleteMessage sends DELETE request with messageId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + ) $ do + deleteMessage dummyAuth mockBaseRequest (MessageId "testMessageId") + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "DELETE" + rawPathInfo receivedReq `shouldBe` "/v1/messages/testMessageId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + describe "Organization" $ do + let organizationJson = "{\ + \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ + \ \"displayName\" : \"Cisco, Inc.\",\ + \ \"created\" : \"2015-10-18T14:26:16+00:00\"\ + \}" + organization = Organization { organizationId = OrganizationId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" + , organizationErrors = Nothing + , organizationDisplayName = Just $ OrganizationDisplayName "Cisco, Inc." + , organizationCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + } + organizationGen i = Organization { organizationId = OrganizationId . pack $ "organizationId" <> i + , organizationErrors = Nothing + , organizationDisplayName = Just $ OrganizationDisplayName . pack $ "displayName" <> i + , organizationCreated = Just $ Timestamp . pack $ "timestamp" <> i + } + organizationList j = [ organizationGen $ j <> show i | i <- [1..3] ] + organizationListList = [ organizationList [c] | c <- ['a'..'d'] ] + + it "getOrganizationList returns ListReader of Organization" $ do + let testData = organizationList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (OrganizationList testData)) req respond + ) $ do + res <- getOrganizationList dummyAuth mockBaseRequest >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/organizations" + queryString receivedReq `shouldBe` [] + + it "getOrganizationList returns ListReader of Organization performing automatic pagination" $ do + withMockServer (paginationApp $ encode . OrganizationList <$> organizationListList) $ do + res <- getOrganizationList dummyAuth mockBaseRequest >>= readAllList + res `shouldBe` concat organizationListList + + it "getOrganizationList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . OrganizationList <$> organizationListList) $ do + res <- getOrganizationList dummyAuth mockBaseRequest >>= readAllList + res `shouldBe` concat (take 2 organizationListList) + + it "getDetail for an organization returns a Organization" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp organizationJson req respond + ) $ do + resOrganization <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (OrganizationId "testOrganizationId") + resOrganization `shouldBe` organization + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/organizations/testOrganizationId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for an organization returns a (Right Organization)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp organizationJson req respond + ) $ do + (Right resOrganization) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (OrganizationId "testOrganizationId") + resOrganization `shouldBe` organization + + describe "License" $ do + let licenseJson = "{\ + \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ + \ \"name\" : \"Spark Calling\",\ + \ \"totalUnits\" : 42,\ + \ \"consumedUnits\" : 8\ + \}" + license = License { licenseId = LicenseId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" + , licenseErrors = Nothing + , licenseName = Just $ LicenseName "Spark Calling" + , licenseTotalUnits = Just $ LicenseUnit 42 + , licenseConsumedUnits = Just $ LicenseUnit 8 + } + licenseGen i = License { licenseId = LicenseId . pack $ "licenseId" <> i + , licenseErrors = Nothing + , licenseName = Just $ LicenseName . pack $ "licenseName" <> i + , licenseTotalUnits = Just $ LicenseUnit 42 + , licenseConsumedUnits = Just $ LicenseUnit 8 + } + licenseList j = [ licenseGen $ j <> show i | i <- [1..3] ] + licenseListList = [ licenseList [c] | c <- ['a'..'d'] ] + + it "getLicenseList returns ListReader of License" $ do + let testData = licenseList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (LicenseList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/licenses" + queryString receivedReq `shouldBe` [] + + it "getLicenseList passes query strings build from LicenseFilter to server" $ do + let testData = licenseList ['Z'] + licenseFilter = LicenseFilter (Just $ OrganizationId "orgIdFilter") + + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (LicenseList testData)) req respond + ) $ do + res <- getListWithFilter dummyAuth mockBaseRequest licenseFilter >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/licenses" + queryString receivedReq `shouldBe` [ ("orgId", Just "orgIdFilter") ] + + it "getLicenseList returns ListReader of License with automatic pagination" $ do + withMockServer (paginationApp $ encode . LicenseList <$> licenseListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) >>= readAllList + res `shouldBe` concat licenseListList + + it "getLicenseList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . LicenseList <$> licenseListList) $ do + res <- getListWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) >>= readAllList + res `shouldBe` concat (take 2 licenseListList) + + it "getDetail for a license returns a License" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp licenseJson req respond + ) $ do + resLicense <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (LicenseId "testLicenseId") + resLicense `shouldBe` license + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/licenses/testLicenseId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a license returns a (Right License)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp licenseJson req respond + ) $ do + (Right resLicense) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (LicenseId "testLicenseId") + resLicense `shouldBe` license + + describe "Role" $ do + let roleJson = "{\ + \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ + \ \"name\" : \"Full Administrator\"\ + \}" + role = Role { roleId = RoleId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" + , roleErrors = Nothing + , roleName = Just $ RoleName "Full Administrator" + } + roleGen i = Role { roleId = RoleId . pack $ "roleId" <> i + , roleErrors = Nothing + , roleName = Just . RoleName . pack $ "roleName" <> i + } + roleList j = [ roleGen $ j <> show i | i <- [1..3] ] + roleListList = [ roleList [c] | c <- ['a'..'d'] ] + + it "getRoleList returns ListReader of Role" $ do + let testData = roleList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (RoleList testData)) req respond + ) $ do + res <- getRoleList dummyAuth mockBaseRequest >>= readAllList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/roles" + queryString receivedReq `shouldBe` [] + + it "getRoleList returns ListReader of Role performing automatic pagination" $ do + withMockServer (paginationApp $ encode . RoleList <$> roleListList) $ do + res <- getRoleList dummyAuth mockBaseRequest >>= readAllList + res `shouldBe` concat roleListList + + it "getRoleList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . RoleList <$> roleListList) $ do + res <- getRoleList dummyAuth mockBaseRequest >>= readAllList + res `shouldBe` concat (take 2 roleListList) + + it "getDetail for a role returns a Role" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp roleJson req respond + ) $ do + resRole <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (RoleId "testRoleId") + resRole `shouldBe` role + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/roles/testRoleId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a role returns a (Right Role)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp roleJson req respond + ) $ do + (Right resRole) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (RoleId "testRoleId") + resRole `shouldBe` role diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/webex-teams-api.cabal b/webex-teams-api.cabal new file mode 100644 --- /dev/null +++ b/webex-teams-api.cabal @@ -0,0 +1,99 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 9e72d5d863d1bf16130c57d4869335f92a9d71362fcb237febe15416af1d8c4f + +name: webex-teams-api +version: 0.2.0.0 +synopsis: A Haskell bindings for Webex Teams API +description: Please see the README on Github at +category: Web +homepage: https://github.com/nshimaza/webex-teams-api#readme +bug-reports: https://github.com/nshimaza/webex-teams-api/issues +author: Naoto Shimazaki +maintainer: Naoto.Shimazaki@gmail.com +copyright: 2017,2018 Naoto Shimazaki +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/nshimaza/webex-teams-api + +library + exposed-modules: + Network.CiscoSpark + Network.CiscoSpark.Internal + Network.CiscoSpark.Types + Network.WebexTeams + Network.WebexTeams.Internal + Network.WebexTeams.Types + other-modules: + Paths_webex_teams_api + hs-source-dirs: + src + build-depends: + aeson + , attoparsec + , base >=4.7 && <5 + , bitset-word8 + , bytestring + , conduit + , data-default + , http-conduit + , network-uri + , text + default-language: Haskell2010 + +executable webex-teams-api-exe + main-is: Main.hs + other-modules: + Paths_webex_teams_api + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson + , base >=4.7 && <5 + , bytestring + , data-default + , http-conduit + , optparse-applicative + , text + , utf8-string + , webex-teams-api + default-language: Haskell2010 + +test-suite webex-teams-api-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Network.WebexTeams.InternalSpec + Network.WebexTeams.TypesSpec + Network.WebexTeamsSpec + Paths_webex_teams_api + hs-source-dirs: + test + ghc-options: -rtsopts + build-depends: + aeson + , async + , attoparsec + , base >=4.7 && <5 + , bytestring + , data-default + , hspec + , http-conduit + , http-types + , network-uri + , text + , wai + , warp + , webex-teams-api + default-language: Haskell2010