diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## 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 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,77 @@ +# cisco-spark-api + +[![License: MIT](https://img.shields.io/badge/License-MIT-brightgreen.svg)](https://opensource.org/licenses/MIT) +[![Build Status](https://travis-ci.org/nshimaza/cisco-spark-api.svg?branch=master)](https://travis-ci.org/nshimaza/cisco-spark-api) +[![Hackage](https://img.shields.io/hackage/v/cisco-spark-api.svg?style=flat)](https://hackage.haskell.org/package/cisco-spark-api) +[![Stackage Nightly](http://stackage.org/package/cisco-spark-api/badge/nightly)](http://stackage.org/nightly/package/cisco-spark-api) +[![Stackage LTS](http://stackage.org/package/cisco-spark-api/badge/lts)](http://stackage.org/lts/package/cisco-spark-api) + +A Haskell bindings for Cisco Spark API + +Cisco-spark-api package provides types and functions for accessing Cisco Spark REST API. +The detail of Spark API is available from [developer site of Cisco Spark](https://developer.ciscospark.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 Spark 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. +Also those functions transform chunky response 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 Spark Space (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 +Spark spaces (Room) and Spark users (Person). You can extract each Membership from +Conduit pipe. The streamEntityWithFilter automatically performs pagenation when it is +asked more element and last response indicated subsequent page in HTTP Link Header. + +```haskell + let auth = Authorization "your authorization token" + filter = MembershipFilter yourRoomId Nothing Nothing + runConduit $ streamEntityWithFilter auth def filter .| takeC 200 .| mapM_C print +``` + +You can find more examples in app/Main.hs + +### Support for Lens + +This package provides many of records representing objects communicated via Cisco Spark 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 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,360 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Conduit +import Data.ByteString.Char8 as BC8 (pack) +import Data.Default (def) +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.CiscoSpark + +main :: IO () +main = do + lookupEnv "SPARK_AUTH" >>= runIfEnvFound + where + runIfEnvFound Nothing = hPutStrLn stderr "Missing SPARK_AUTH. Set Spark authorization string to SPARK_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) = + runConduit $ streamEntityWithFilter auth def filter .| takeC count .| mapM_C print + +run auth (RoomListCommand count filter) = + runConduit $ streamEntityWithFilter auth def filter .| takeC count .| mapM_C print + +run auth (MembershipListCommand count filter) = + runConduit $ streamEntityWithFilter auth def filter .| takeC count .| mapM_C print + +run auth (MessageListCommand count filter) = + runConduit $ streamEntityWithFilter auth def filter .| takeC count .| mapM_C print + +run auth (TeamMembershipListCommand count filter) = + runConduit $ streamEntityWithFilter auth def filter .| takeC count .| mapM_C print + +run auth (TeamListCommand count) = + runConduit $ streamTeamList auth def .| takeC count .| mapM_C 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 + +{- + 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 cisco-spark-api" + <> header "cisco-spark-api-exe -- Sample porgram demonstrating how to use cisco-spark-api" + ) diff --git a/cisco-spark-api.cabal b/cisco-spark-api.cabal new file mode 100644 --- /dev/null +++ b/cisco-spark-api.cabal @@ -0,0 +1,88 @@ +name: cisco-spark-api +version: 0.1.0.0 +synopsis: A Haskell bindings for Cisco Spark API +description: Cisco-spark-api package provides types and functions for accessing Cisco Spark REST API. + + 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 Spark REST API returning list of objects require HTTP Link Header based pagination. + Haskell functions abstract it. They automatically request subsequent pages as needed and + seamlessly stream returned elements rather than just return a chunk of elements in a response. + + This package also provides some sample usage in command line application style. + See source under app directory of the source package. +homepage: https://github.com/nshimaza/cisco-spark-api#readme +license: MIT +license-file: LICENSE +author: Naoto Shimazaki +maintainer: Naoto.Shimazaki@gmail.com +copyright: Copyright: (c) 2017 Naoto Shimazaki +category: Web +build-type: Simple +extra-source-files: CHANGELOG.md + , README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Network.CiscoSpark + , Network.CiscoSpark.Internal + , Network.CiscoSpark.Types + build-depends: base >= 4.7 && < 5 + , aeson + , attoparsec + , bytestring + , conduit-combinators + , data-default + , http-conduit + , network-uri + , text + , bitset-word8 + default-language: Haskell2010 + +executable cisco-spark-api-exe + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , aeson + , bytestring + , conduit-combinators + , data-default + , http-conduit + , optparse-applicative + , text + , utf8-string + , cisco-spark-api + default-language: Haskell2010 + +test-suite cisco-spark-api-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + other-modules: Network.CiscoSparkSpec + , Network.CiscoSpark.InternalSpec + , Network.CiscoSpark.TypesSpec + build-depends: base + , aeson + , attoparsec + , bytestring + , conduit-combinators + , data-default + , http-conduit + , http-types + , network-uri + , text + , wai + , warp + , hspec + , cisco-spark-api + , thread-hierarchy + ghc-options: -rtsopts + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/nshimaza/cisco-spark-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,445 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Network.CiscoSpark +Copyright : (c) Naoto Shimazaki 2017 +License : MIT (see the file LICENSE) + +Maintainer : https://github.com/nshimaza +Stability : experimental + +This module provides types and functions for accessing Cisco Spark 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 Spark 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. +Also those functions transform chunky response into seamless stream of elements. + += 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 $ streamEntityWithFilter 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 +@ + += Support for Lens + +This package provides many of records representing objects communicated via Cisco Spark 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.CiscoSpark + ( + -- * Types + -- ** Common Types + Authorization (..) + , CiscoSparkRequest (..) + , 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 + , 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 +import Data.Aeson (FromJSON, ToJSON) +import Data.ByteString (ByteString) +import Data.ByteString.Char8 as C8 (unpack) +import Data.Default (Default (def)) +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.CiscoSpark.Internal +import Network.CiscoSpark.Types + + +-- | Authorization string against Spark 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 Cisco Spark public API. +data CiscoSparkRequest = CiscoSparkRequest + { ciscoSparkRequestRequest :: Request -- ^ Holds pre-set 'Request' for REST API. + , ciscoSparkRequestScheme :: String -- ^ Should be "https:" in production. + , ciscoSparkRequestAuthority :: URIAuth -- ^ Authority part of request URI. + } deriving (Show) + +-- | Common part of 'Request' against Spark API. +ciscoSparkBaseRequest :: Request +ciscoSparkBaseRequest + = addRequestHeader "Content-Type" "application/json; charset=utf-8" + $ setRequestPort 443 + $ setRequestHost "api.ciscospark.com" + $ setRequestSecure True + $ defaultRequest + +-- | Default parameters for HTTP request to Cisco Spark REST API. +instance Default CiscoSparkRequest where + def = CiscoSparkRequest ciscoSparkBaseRequest "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 + :: CiscoSparkRequest -- ^ Common request components + -> ByteString -- ^ API category part of REST URL path + -> CiscoSparkRequest +makeCommonListReq base@(CiscoSparkRequest { ciscoSparkRequestRequest = req }) path + = base { ciscoSparkRequestRequest = 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, SparkListItem i) => Authorization -> CiscoSparkRequest -> Source m i +streamList auth (CiscoSparkRequest 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, SparkListItem i) => Authorization -> Response a -> String -> URIAuth -> Source m i +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. +streamEntityWithFilter :: (MonadIO m, SparkFilter filter, SparkListItem (ToResponse filter)) + => Authorization + -> CiscoSparkRequest + -> filter + -> Source m (ToResponse filter) +streamEntityWithFilter auth base param = + streamList auth $ setQeuryString $ makeCommonListReq base (apiPath param) + where + setQeuryString comm@(CiscoSparkRequest { ciscoSparkRequestRequest = req }) + = comm { ciscoSparkRequestRequest = setRequestQueryString (toFilterList param) req } + +-- | List of 'Team' and stream it into Conduit pipe. It automatically performs pagination. +streamTeamList :: MonadIO m => Authorization -> CiscoSparkRequest -> Source m Team +streamTeamList auth base = streamList auth $ makeCommonListReq base teamsPath + +-- | Filter list of 'Organization' and stream it into Conduit pipe. It automatically performs pagination. +streamOrganizationList :: MonadIO m => Authorization -> CiscoSparkRequest -> Source m Organization +streamOrganizationList auth base = streamList auth $ makeCommonListReq base organizationsPath + +-- | List of 'Role' and stream it into Conduit pipe. It automatically performs pagination. +streamRoleList :: MonadIO m => Authorization -> CiscoSparkRequest -> Source m Role +streamRoleList auth base = streamList auth $ makeCommonListReq base rolesPath + + +makeCommonDetailReq + :: CiscoSparkRequest -- ^ Common request components. + -> Authorization -- ^ Authorization string against Spark API. + -> ByteString -- ^ API category part of REST URL path. + -> Text -- ^ Identifier string part of REST URL path. + -> Request +makeCommonDetailReq (CiscoSparkRequest base _ _) auth path idStr + = setRequestPath ("/v1/" <> path <> "/" <> encodeUtf8 idStr) + $ setRequestMethod "GET" + $ addAuthorizationHeader auth + $ base + +{-| + Get details of a Spark 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, SparkDetail key) + => Authorization -- ^ Authorization string against Spark API. + -> CiscoSparkRequest -- ^ Predefined part of 'Request' commonly used for Cisco Spark 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 Spark entity. A Left value will be returned on an JSON parse errors. +getDetailEither :: (MonadIO m, SparkDetail key) + => Authorization + -> CiscoSparkRequest + -> key + -> m (Response (Either JSONException (ToResponse key))) +getDetailEither auth base entityId = httpJSONEither $ makeCommonDetailReq base auth (apiPath entityId) (toIdStr entityId) + + +makeCommonCreateReq :: ToJSON a => CiscoSparkRequest -> Authorization -> ByteString -> a -> Request +makeCommonCreateReq (CiscoSparkRequest base _ _) auth path body + = setRequestBodyJSON body + $ setRequestPath ("/v1/" <> path) + $ setRequestMethod "POST" + $ addAuthorizationHeader auth + $ base + +{-| + Create a Spark entity with given parameters. + + Creating a new entity of Spark 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, SparkCreate createParams) + => Authorization -- ^ Authorization string against Spark API. + -> CiscoSparkRequest -- ^ Predefined part of 'Request' commonly used for Cisco Spark 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 Spark entity with given parameters. A Left value will be returned on an JSON parse errors. +createEntityEither :: (MonadIO m, SparkCreate createParams) + => Authorization + -> CiscoSparkRequest + -> createParams + -> m (Response (Either JSONException (ToResponse createParams))) +createEntityEither auth base param = httpJSONEither $ makeCommonCreateReq base auth (apiPath param) param + + +makeCommonUpdateReq :: ToJSON a => CiscoSparkRequest -> Authorization -> ByteString -> a -> Request +makeCommonUpdateReq (CiscoSparkRequest base _ _) auth path body + = setRequestBodyJSON body + $ setRequestPath ("/v1/" <> path) + $ setRequestMethod "PUT" + $ addAuthorizationHeader auth + $ base + +{-| + Update a Spark entity with given parameters. + + Creating a new entity of Spark 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, SparkUpdate updateParams) + => Authorization -- ^ Authorization string against Spark API. + -> CiscoSparkRequest -- ^ Predefined part of 'Request' commonly used for Cisco Spark 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 Spark entity with given parameters. A Left value will be returned on an JSON parse errors. +updateEntityEither :: (MonadIO m, SparkUpdate updateParams) + => Authorization + -> CiscoSparkRequest + -> updateParams + -> m (Response (Either JSONException (ToResponse updateParams))) +updateEntityEither auth base param = httpJSONEither $ makeCommonUpdateReq base auth (apiPath param) param + + +makeCommonDeleteReq + :: Authorization -- ^ Authorization string against Spark 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, SparkDetail key) + => Authorization -- ^ Authorization string against Spark API. + -> CiscoSparkRequest -- ^ Predefined part of 'Request' commonly used for Cisco Spark API. + -> key -- ^ One of PersonId, RoomId, MembershipId, MessageId, TeamId, TeamMembershipId. + -> m (Response ()) +deleteEntity auth (CiscoSparkRequest base _ _) entityId + = httpNoBody $ makeCommonDeleteReq auth base (apiPath entityId) (toIdStr entityId) + +-- | Deletes a room, by ID. +deleteRoom :: MonadIO m + => Authorization -- ^ Authorization string against Spark API. + -> CiscoSparkRequest -- ^ Predefined part of 'Request' commonly used for Cisco Spark 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 Spark API. + -> CiscoSparkRequest -- ^ Predefined part of 'Request' commonly used for Cisco Spark 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 Spark API. + -> CiscoSparkRequest -- ^ Predefined part of 'Request' commonly used for Cisco Spark 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 Spark API. + -> CiscoSparkRequest -- ^ Predefined part of 'Request' commonly used for Cisco Spark 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 Spark API. + -> CiscoSparkRequest -- ^ Predefined part of 'Request' commonly used for Cisco Spark API. + -> TeamMembershipId -- ^ Identifier of a space to be deleted. + -> m (Response ()) +deleteTeamMembership = deleteEntity 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,166 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Network.CiscoSpark.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 Spark API. +-} +module Network.CiscoSpark.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.CiscoSpark' 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/CiscoSpark/Types.hs b/src/Network/CiscoSpark/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/CiscoSpark/Types.hs @@ -0,0 +1,1051 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +{-| +Module : Network.CiscoSpark.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 cisco-spark-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.CiscoSpark.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.CiscoSpark.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" + + +{-| + SparkListItem 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. + + SparkListItem 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) => SparkListItem 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 SparkApiPath a where + apiPath :: a -> ByteString + +-- | Type family to associate a type appears in an argument to response type. +class FromJSON (ToResponse a) => SparkResponse a where + type ToResponse a :: * + +-- | Extract containing entity ID string from given type of value. +class (SparkApiPath a, SparkResponse a) => SparkDetail a where + toIdStr :: a -> Text + +-- | Convert given filter condition parameter in a concrete type to HTTP query strings. +class (SparkApiPath a, SparkResponse a) => SparkFilter a where + toFilterList :: a -> [(ByteString, Maybe ByteString)] + +-- | Type class for parameter type for create entity API. +class (SparkApiPath a, SparkResponse a, ToJSON a) => SparkCreate a where + +-- | Type class for parameter type for update entity API. +class (SparkApiPath a, SparkResponse a, ToJSON a) => SparkUpdate 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.ciscospark.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 Cisco Spark 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, Show, Generic) + +-- | '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 Cisco Spark 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 SparkApiPath PersonId where + apiPath _ = peoplePath + +-- | Get detail for a person API uses "PersonId' and responses 'Person'. +instance SparkResponse PersonId where + type ToResponse PersonId = Person + +-- | User can get detail of a person. +instance SparkDetail 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 SparkListItem 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 SparkApiPath PersonFilter where + apiPath _ = peoplePath + +-- | List people API uses 'PersonFilter' and responses 'Person'. +instance SparkResponse PersonFilter where + type ToResponse PersonFilter = Person + +-- | User can list people with filter parameter. +instance SparkFilter 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 SparkApiPath CreatePerson where + apiPath _ = peoplePath + +-- | Create person API uses "CreatePerson' and responses 'Person'. +instance SparkResponse CreatePerson where + type ToResponse CreatePerson = Person + +-- | User can create a person. +instance SparkCreate 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 SparkApiPath UpdatePerson where + apiPath _ = peoplePath + +-- | Update person API uses "UpdatePerson' and responses 'Person'. +instance SparkResponse UpdatePerson where + type ToResponse UpdatePerson = Person + +-- | User can update a person. +instance SparkUpdate 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 SparkApiPath TeamId where + apiPath _ = teamsPath + +-- | Get detail for a team API uses "TeamId' and responses 'Team'. +instance SparkResponse TeamId where + type ToResponse TeamId = Team + +-- | User can get detail of a team. +instance SparkDetail 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 SparkListItem 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 SparkApiPath CreateTeam where + apiPath _ = teamsPath + +-- | Create team API uses "CreateTeam' and responses 'Team'. +instance SparkResponse CreateTeam where + type ToResponse CreateTeam = Team + +-- | User can create a team. +instance SparkCreate 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 SparkApiPath UpdateTeam where + apiPath _ = teamsPath + +-- | Update team API uses "UpdateTeam' and responses 'Team'. +instance SparkResponse UpdateTeam where + type ToResponse UpdateTeam = Team + +-- | User can update a team. +instance SparkUpdate 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 SparkApiPath TeamMembershipId where + apiPath _ = teamMembershipsPath + +-- | Get detail for a team membership API uses "TeamMembershipId' and responses 'TeamMembership'. +instance SparkResponse TeamMembershipId where + type ToResponse TeamMembershipId = TeamMembership + +-- | User can get detail of a team membership. +instance SparkDetail 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 SparkListItem 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 SparkApiPath TeamMembershipFilter where + apiPath _ = teamMembershipsPath + +-- | List team memberships API uses 'TeamMembershipFilter' and responses 'TeamMembership'. +instance SparkResponse TeamMembershipFilter where + type ToResponse TeamMembershipFilter = TeamMembership + +-- | User can list team membership with filter parameter. +instance SparkFilter 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 teamId = TeamMembershipFilter teamId + +-- | '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 SparkApiPath CreateTeamMembership where + apiPath _ = teamMembershipsPath + +-- | Create teamMembership API uses "CreateTeamMembership' and responses 'TeamMembership'. +instance SparkResponse CreateTeamMembership where + type ToResponse CreateTeamMembership = TeamMembership + +-- | User can create a teamMembership. +instance SparkCreate 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 SparkApiPath UpdateTeamMembership where + apiPath _ = teamMembershipsPath + +-- | Update teamMembership API uses "UpdateTeamMembership' and responses 'TeamMembership'. +instance SparkResponse UpdateTeamMembership where + type ToResponse UpdateTeamMembership = TeamMembership + +-- | User can update a teamMembership. +instance SparkUpdate 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 Cisco Spark 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 Spark. + 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 SparkApiPath RoomId where + apiPath _ = roomsPath + +-- | Get detail for a room API uses "RoomId' and responses 'Room'. +instance SparkResponse RoomId where + type ToResponse RoomId = Room + +-- | User can get detail of a room. +instance SparkDetail 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 SparkListItem 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 SparkApiPath RoomFilter where + apiPath _ = roomsPath + +-- | List rooms API uses 'RoomFilter' and responses 'Room'. +instance SparkResponse RoomFilter where + type ToResponse RoomFilter = Room + +-- | User can list rooms with filter parameter. +instance SparkFilter 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 SparkApiPath CreateRoom where + apiPath _ = roomsPath + +-- | Create room API uses "CreateRoom' and responses 'Room'. +instance SparkResponse CreateRoom where + type ToResponse CreateRoom = Room + +-- | User can create a room. +instance SparkCreate 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 SparkApiPath UpdateRoom where + apiPath _ = roomsPath + +-- | Update room API uses "UpdateRoom' and responses 'Room'. +instance SparkResponse UpdateRoom where + type ToResponse UpdateRoom = Room + +-- | User can update a room. +instance SparkUpdate 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 SparkApiPath MembershipId where + apiPath _ = membershipsPath + +-- | Get detail for a membership API uses "MembershipId' and responses 'Membership'. +instance SparkResponse MembershipId where + type ToResponse MembershipId = Membership + +-- | User can get detail of a membership. +instance SparkDetail 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 SparkListItem 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 SparkApiPath MembershipFilter where + apiPath _ = membershipsPath + +-- | List memberships API uses 'MembershipFilter' and responses 'Membership'. +instance SparkResponse MembershipFilter where + type ToResponse MembershipFilter = Membership + +-- | User can list memberships with filter parameter. +instance SparkFilter 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 SparkApiPath CreateMembership where + apiPath _ = membershipsPath + +-- | Create membership API uses "CreateMembership' and responses 'Membership'. +instance SparkResponse CreateMembership where + type ToResponse CreateMembership = Membership + +-- | User can create a membership. +instance SparkCreate 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 SparkApiPath UpdateMembership where + apiPath _ = membershipsPath + +-- | Update membership API uses "UpdateMembership' and responses 'Membership'. +instance SparkResponse UpdateMembership where + type ToResponse UpdateMembership = Membership + +-- | User can update a membership. +instance SparkUpdate 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 SparkApiPath MessageId where + apiPath _ = messagesPath + +-- | Get detail for a message API uses "MessageId' and responses 'Message'. +instance SparkResponse MessageId where + type ToResponse MessageId = Message + +-- | User can get detail of a message. +instance SparkDetail 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 SparkListItem 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 SparkApiPath MessageFilter where + apiPath _ = messagesPath + +-- | List messages API uses 'MessageFilter' and responses 'Message'. +instance SparkResponse MessageFilter where + type ToResponse MessageFilter = Message + +-- | User can list messages with filter parameter. +instance SparkFilter 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 SparkApiPath CreateMessage where + apiPath _ = messagesPath + +-- | Create message API uses "CreateMessage' and responses 'Message'. +instance SparkResponse CreateMessage where + type ToResponse CreateMessage = Message + +-- | User can create a message. +instance SparkCreate CreateMessage where + + +-- | Display name of 'Organization' +newtype OrganizationDisplayName = OrganizationDisplayName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +{-| + 'Organization' is an administrative group of Cisco Spark 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 SparkApiPath OrganizationId where + apiPath _ = organizationsPath + +-- | Get detail for a organization API uses "OrganizationId' and responses 'Organization'. +instance SparkResponse OrganizationId where + type ToResponse OrganizationId = Organization + +-- | User can get detail of a organization. +instance SparkDetail 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 SparkListItem 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 Cisco Spark 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 SparkApiPath LicenseId where + apiPath _ = licensesPath + +-- | Get detail for a license API uses "LicenseId' and responses 'License'. +instance SparkResponse LicenseId where + type ToResponse LicenseId = License + +-- | User can get detail of a license. +instance SparkDetail 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 SparkListItem 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 SparkApiPath LicenseFilter where + apiPath _ = licensesPath + +-- | List licenses API uses 'LicenseFilter' and responses 'License'. +instance SparkResponse LicenseFilter where + type ToResponse LicenseFilter = License + +-- | User can list licenses with filter parameter. +instance SparkFilter 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) +-- ^ 'RoleName' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for role API uses 'RoleId' and path "roles". +instance SparkApiPath RoleId where + apiPath _ = rolesPath + +-- | Get detail for a role API uses "RoleId' and responses 'Role'. +instance SparkResponse RoleId where + type ToResponse RoleId = Role + +-- | User can get detail of a role. +instance SparkDetail 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 SparkListItem Role where + type ToList Role = RoleList + unwrap = roleListItems diff --git a/test/Network/CiscoSpark/InternalSpec.hs b/test/Network/CiscoSpark/InternalSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/CiscoSpark/InternalSpec.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.CiscoSpark.InternalSpec where + +import Data.Attoparsec.ByteString +import Data.ByteString (pack) +import Data.Either (isLeft) +import Network.URI (URIAuth (..)) + +import Test.Hspec + +import Network.CiscoSpark.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/CiscoSpark/TypesSpec.hs b/test/Network/CiscoSpark/TypesSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/CiscoSpark/TypesSpec.hs @@ -0,0 +1,706 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.CiscoSpark.TypesSpec where + +import Data.Aeson (decode, eitherDecode, encode) +import Data.Monoid ((<>)) + +import Test.Hspec + +import Network.CiscoSpark.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 Team Message API response JSON" $ do + eitherDecode messageJson `shouldBe` Right message + (decode . encode) message `shouldBe` Just message + + it "decodes Team 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 Team Organization API response JSON" $ do + eitherDecode organizationJson `shouldBe` Right organization + (decode . encode) organization `shouldBe` Just organization + + it "decodes Team 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 Team License API response JSON" $ do + eitherDecode licenseJson `shouldBe` Right license + (decode . encode) license `shouldBe` Just license + + it "decodes Team 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 Team Role API response JSON" $ do + eitherDecode roleJson `shouldBe` Right role + (decode . encode) role `shouldBe` Just role + + it "decodes Team Role list" $ do + eitherDecode roleListJson `shouldBe` Right roleList + (decode . encode) roleList `shouldBe` Just roleList diff --git a/test/Network/CiscoSparkSpec.hs b/test/Network/CiscoSparkSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/CiscoSparkSpec.hs @@ -0,0 +1,1758 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} + +module Network.CiscoSparkSpec where + +import Conduit +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 (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 + +import Network.HTTP.Types (Header, status200) +import Network.URI (URIAuth (..)) +import Network.Wai +import Network.Wai.Handler.Warp (Settings, defaultSettings, + runSettings, setBeforeMainLoop) + +import Test.Hspec + +import Control.Concurrent.Hierarchy (ThreadMap, killThreadHierarchy, + newChild, newThreadMap) +import Network.CiscoSpark +import Network.CiscoSpark.Internal (LinkHeader (..), LinkParam (..), + getNextUrl, linkHeader) + + +import Data.Typeable (typeOf) + + +newtype MockServer = MockServer ThreadMap + +mockBaseRequestRequest + = C.addRequestHeader "Content-Type" "application/json; charset=utf-8" + $ C.setRequestPort 3000 + $ C.setRequestHost "localhost" + $ C.setRequestSecure False + $ C.defaultRequest + +mockBaseRequest :: CiscoSparkRequest +mockBaseRequest = CiscoSparkRequest mockBaseRequestRequest "http:" $ URIAuth "" "localhost" ":3000" + +dummyAuth :: Authorization +dummyAuth = Authorization "dummyAuth" + +extractRight :: Show err => Either err r -> r +extractRight (Right r) = r +extractRight (Left err) = error $ show err + +startMockServer :: Application -> IO MockServer +startMockServer app = do + readyToConnect <- newEmptyMVar + rootThreadMap <- newThreadMap + let set = setBeforeMainLoop (putMVar readyToConnect ()) defaultSettings + newChild rootThreadMap $ \_ -> runSettings set app + takeMVar readyToConnect + return $ MockServer rootThreadMap + +stopMockServer :: MockServer -> IO () +stopMockServer (MockServer rootThreadMap) = killThreadHierarchy rootThreadMap + +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", "; rel=\"next\"")], ress !! 1) + dispatch "/2" = ([contentType, ("Link", "; rel=\"next\"")], ress !! 2) + dispatch "/3" = ([contentType], ress !! 3) + dispatch _ = ([contentType, ("Link", "; 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", "; rel=\"next\"")], ress !! 2) + dispatch "/3" = ([contentType], ress !! 3) + dispatch _ = ([contentType, ("Link", "; 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'] ] + +spec :: Spec +spec = do + describe "Mock Applications" $ do + it "simple mock app returns list of team" $ do + receivedReqMVar <- newEmptyMVar + let (CiscoSparkRequest baseReq _ _) = mockBaseRequest + req = setRequestPath "/v1/teams" + $ setRequestMethod "GET" + $ baseReq + testData = TeamList $ teamList ['Z'] + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode testData) req respond + + 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" + + stopMockServer svr + + it "pagenation mock app returns list of team and Link header" $ do + receivedReqMVar <- newEmptyMVar + let (CiscoSparkRequest baseReq _ _) = mockBaseRequest + req = setRequestPath "/v1/teams" + $ setRequestMethod "GET" + $ baseReq + testData = encode . TeamList <$> teamListList + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + paginationApp testData req respond + + 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://localhost:3000/1" + + req2 <- parseRequest $ "GET " <> C8.unpack (fromJust path) + res2 <- httpJSON req2 + getResponseBody res2 `shouldBe` TeamList (teamListList !! 1) + + stopMockServer svr + + 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 "streamPersonList streams Team" $ do + let testData = personList ['Z'] + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (PersonList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/people" + queryString receivedReq `shouldBe` [] + + stopMockServer svr + + it "streamPersonList 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 + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (PersonList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest personFilter .| sinkList + 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") ] + + stopMockServer svr + + it "streamPersonList streams Team with automatic pagination" $ do + svr <- startMockServer . paginationApp $ encode . PersonList <$> personListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) .| sinkList + res `shouldBe` concat personListList + + stopMockServer svr + + it "streamPersonList stops pagination at invalid Link Header" $ do + svr <- startMockServer . invalidPaginationApp $ encode . PersonList <$> personListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) .| sinkList + res `shouldBe` concat (take 2 personListList) + + stopMockServer svr + + it "getDetail for a person returns a Person" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp personJson1 req respond + + 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" + + stopMockServer svr + + it "getDetailEither for a person returns a (Right Person)" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp personJson1 req respond + + (Right resPerson) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (PersonId "testPersonId") + resPerson `shouldBe` person1 + + stopMockServer svr + + it "createEntity for a person sends JSON encoded CreatePerson as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + + 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 + + stopMockServer svr + + it "createEntityEither for a person sends JSON encoded CreatePerson as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + + (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 + + stopMockServer svr + + it "updateEntity for a person sends JSON encoded UpdatePerson as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + + 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 + + stopMockServer svr + + it "updateEntityEither for a person sends JSON encoded UpdatePerson as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + + (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 + + stopMockServer svr + + 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 "streamTeamList streams Team" $ do + let testData = teamList ['Z'] + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (TeamList testData)) req respond + + res <- runConduit $ streamTeamList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` testData + path <- rawPathInfo <$> takeMVar receivedReqMVar + path `shouldBe` "/v1/teams" + + stopMockServer svr + + it "streamTeamList streams Team with automatic pagination" $ do + svr <- startMockServer . paginationApp $ encode . TeamList <$> teamListList + + res <- runConduit $ streamTeamList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat teamListList + + stopMockServer svr + + it "streamTeamList stops pagination at invalid Link Header" $ do + svr <- startMockServer . invalidPaginationApp $ encode . TeamList <$> teamListList + + res <- runConduit $ streamTeamList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat (take 2 teamListList) + + stopMockServer svr + + it "getDetail for a team returns a Team" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp teamJson req respond + + 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" + + stopMockServer svr + + it "getDetailEither for a team returns a (Right Team)" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp teamJson req respond + (Right resTeam) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (TeamId "testTeamId") + resTeam `shouldBe` team + + stopMockServer svr + + it "createEntity for a team sends JSON encoded CreateTeam as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + + 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 + + stopMockServer svr + + it "createEntityEither for a team sends JSON encoded CreateTeam as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + + (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 + + stopMockServer svr + + it "updateEntity for a team sends JSON encoded UpdateTeam as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + + 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 + + stopMockServer svr + + it "updateEntityEither for a team sends JSON encoded UpdateTeam as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + + (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 + + stopMockServer svr + + it "deleteTeam sends DELETE request with teamId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + + 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" + + stopMockServer svr + + 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 "streamTeamMembershipList streams TeamMembership" $ do + let testData = teamMembershipList ['Z'] + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (TeamMembershipList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + queryString receivedReq `shouldBe` [ ("teamId", Just "dummyTeamId") ] + + stopMockServer svr + + it "streamMembershipList passes query strings build from TeamMembershipFilter to server" $ do + let testData = teamMembershipList ['Z'] + teamMembershipFilter = TeamMembershipFilter $ TeamId "DummyTeamId" + + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (TeamMembershipList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest teamMembershipFilter .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + queryString receivedReq `shouldBe` [ ("teamId", Just "DummyTeamId") ] + + stopMockServer svr + + it "streamTeamMembershipList streams TeamMembership with automatic pagination" $ do + svr <- startMockServer . paginationApp $ encode . TeamMembershipList <$> teamMembershipListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` concat teamMembershipListList + + stopMockServer svr + + it "streamTeamMembershipList stops pagination at invalid Link Header" $ do + svr <- startMockServer . invalidPaginationApp $ encode . TeamMembershipList <$> teamMembershipListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` concat (take 2 teamMembershipListList) + + stopMockServer svr + + it "getDetail for a team membership returns a TeamMembership" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp teamMembershipJson req respond + + 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" + + stopMockServer svr + + it "getDetailEither for a team membership returns a (Right TeamMembership)" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp teamMembershipJson req respond + (Right resTeamMembership) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (TeamMembershipId "testTeamMembershipId") + resTeamMembership `shouldBe` teamMembership + + stopMockServer svr + + it "createEntity for a team membership sends JSON encoded CreateTeamMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + + 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 + + stopMockServer svr + + it "createEntityEither for a team membership sends JSON encoded CreateTeamMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + + (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 + + stopMockServer svr + + it "updateEntity for a teamMembership sends JSON encoded UpdateTeamMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + + 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 + + stopMockServer svr + + it "updateEntityEither for a teamMembership sends JSON encoded UpdateTeamMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + + (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 + + stopMockServer svr + + it "deleteTeamMembership sends DELETE request with teamMembershipId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + + 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" + + stopMockServer svr + + 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 "streamRoomList streams Room" $ do + let testData = roomList ['Z'] + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (RoomList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + queryString receivedReq `shouldBe` [] + + stopMockServer svr + + it "streamRoomList passes query strings build from RoomFilter to server" $ do + let testData = roomList ['Z'] + roomFilter = RoomFilter (Just $ TeamId "dummyTeamId") + (Just RoomTypeGroup) + (Just RoomFilterSortByLastActivity) + + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (RoomList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest roomFilter .| sinkList + 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") ] + + stopMockServer svr + + it "streamRoomList streams Room with automatic pagination" $ do + svr <- startMockServer . paginationApp $ encode . RoomList <$> roomListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) .| sinkList + res `shouldBe` concat roomListList + + stopMockServer svr + + it "streamRoomList stops pagination at invalid Link Header" $ do + svr <- startMockServer . invalidPaginationApp $ encode . RoomList <$> roomListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) .| sinkList + res `shouldBe` concat (take 2 roomListList) + + stopMockServer svr + + it "getDetail for a room returns a Room" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp roomJson req respond + + 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" + + stopMockServer svr + + it "getDetailEither for a room returns a (Right Room)" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp roomJson req respond + (Right resRoom) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (RoomId "testRoomId") + resRoom `shouldBe` room + + stopMockServer svr + + it "createEntity for a room sends JSON encoded CreateRoom as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + + 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 + + stopMockServer svr + + it "createEntithEither for a room sends JSON encoded CreateRoom as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + + (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 + + stopMockServer svr + + it "updateEntity for a room sends JSON encoded UpdateRoom as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + + 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 + + stopMockServer svr + + it "updateEntityEither for a room sends JSON encoded UpdateRoom as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + + (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 + + stopMockServer svr + + it "deleteRoom sends DELETE request with roomId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + + 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" + + stopMockServer svr + + 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 "streamMembershipList streams Membership" $ do + let testData = membershipList ['Z'] + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MembershipList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + queryString receivedReq `shouldBe` [] + + stopMockServer svr + + it "streamMembershipList 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 + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MembershipList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest membershipFilter .| sinkList + 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") ] + + stopMockServer svr + + it "streamMembershipList streams Membership with automatic pagination" $ do + svr <- startMockServer . paginationApp $ encode . MembershipList <$> membershipListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) .| sinkList + res `shouldBe` concat membershipListList + + stopMockServer svr + + it "streamMembershipList stops pagination at invalid Link Header" $ do + svr <- startMockServer . invalidPaginationApp $ encode . MembershipList <$> membershipListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) .| sinkList + res `shouldBe` concat (take 2 membershipListList) + + stopMockServer svr + + it "getDetail for a menbership returns a Membership" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp membershipJson req respond + + 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" + + stopMockServer svr + + it "getDetailEither for a membership returns a (Right Membership)" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp membershipJson req respond + (Right resMembership) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (MembershipId "testMembershipId") + resMembership `shouldBe` membership + + stopMockServer svr + + it "createEntity for a membership sends JSON encoded CreateMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + + 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 + + stopMockServer svr + + it "createEntithEither for a membership sends JSON encoded CreateMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + + (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 + + stopMockServer svr + + it "updateEntity for a membership sends JSON encoded UpdateMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + + 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 + + stopMockServer svr + + it "updateEntityEither for a membership sends JSON encoded UpdateMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + + (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 + + stopMockServer svr + + it "deleteMembership sends DELETE request with membershipId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + + 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" + + stopMockServer svr + + 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 "streamMessageList streams Message" $ do + let testData = messageList ['Z'] + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MessageList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/messages" + queryString receivedReq `shouldBe` [ ("roomId", Just "dummyRoomId") ] + + stopMockServer svr + + it "streamMessageList 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 + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MessageList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest messageFilter .| sinkList + 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") ] + + stopMockServer svr + + it "streamMessageList streams Message with automatic pagination" $ do + svr <- startMockServer . paginationApp $ encode . MessageList <$> messageListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` concat messageListList + + stopMockServer svr + + it "streamMessageList stops pagination at invalid Link Header" $ do + svr <- startMockServer . invalidPaginationApp $ encode . MessageList <$> messageListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` concat (take 2 messageListList) + + stopMockServer svr + + it "getDetail for a message returns a Message" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp messageJson req respond + + 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" + + stopMockServer svr + + it "getDetailEither for a message returns a (Right Message)" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp messageJson req respond + (Right resMessage) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (MessageId "testMessageId") + resMessage `shouldBe` message + + stopMockServer svr + + it "createEntity for a message sends JSON encoded CreateMessage as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp messageJson req respond + + 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 + + stopMockServer svr + + it "createEntithEither for a message sends JSON encoded CreateMessage as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp messageJson req respond + + (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 + + stopMockServer svr + + it "deleteMessage sends DELETE request with messageId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + + 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" + + stopMockServer svr + + 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 "streamOrganizationList streams Organization" $ do + let testData = organizationList ['Z'] + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (OrganizationList testData)) req respond + + res <- runConduit $ streamOrganizationList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/organizations" + queryString receivedReq `shouldBe` [] + + stopMockServer svr + + it "streamOrganizationList streams Organization with automatic pagination" $ do + svr <- startMockServer . paginationApp $ encode . OrganizationList <$> organizationListList + + res <- runConduit $ streamOrganizationList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat organizationListList + + stopMockServer svr + + it "streamOrganizationList stops pagination at invalid Link Header" $ do + svr <- startMockServer . invalidPaginationApp $ encode . OrganizationList <$> organizationListList + + res <- runConduit $ streamOrganizationList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat (take 2 organizationListList) + + stopMockServer svr + + it "getDetail for an organization returns a Organization" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp organizationJson req respond + + 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" + + stopMockServer svr + + it "getDetailEither for an organization returns a (Right Organization)" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp organizationJson req respond + (Right resOrganization) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (OrganizationId "testOrganizationId") + resOrganization `shouldBe` organization + + stopMockServer svr + + 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 "streamLicenseList streams License" $ do + let testData = licenseList ['Z'] + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (LicenseList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/licenses" + queryString receivedReq `shouldBe` [] + + stopMockServer svr + + it "streamLicenseList passes query strings build from LicenseFilter to server" $ do + let testData = licenseList ['Z'] + licenseFilter = LicenseFilter (Just $ OrganizationId "orgIdFilter") + + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (LicenseList testData)) req respond + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest licenseFilter .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/licenses" + queryString receivedReq `shouldBe` [ ("orgId", Just "orgIdFilter") ] + + stopMockServer svr + + it "streamLicenseList streams License with automatic pagination" $ do + svr <- startMockServer . paginationApp $ encode . LicenseList <$> licenseListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) .| sinkList + res `shouldBe` concat licenseListList + + stopMockServer svr + + it "streamLicenseList stops pagination at invalid Link Header" $ do + svr <- startMockServer . invalidPaginationApp $ encode . LicenseList <$> licenseListList + + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) .| sinkList + res `shouldBe` concat (take 2 licenseListList) + + stopMockServer svr + + it "getDetail for a license returns a License" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp licenseJson req respond + + 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" + + stopMockServer svr + + it "getDetailEither for a license returns a (Right License)" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp licenseJson req respond + (Right resLicense) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (LicenseId "testLicenseId") + resLicense `shouldBe` license + + stopMockServer svr + + 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 "streamRoleList streams Role" $ do + let testData = roleList ['Z'] + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (RoleList testData)) req respond + + res <- runConduit $ streamRoleList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/roles" + queryString receivedReq `shouldBe` [] + + stopMockServer svr + + it "streamRoleList streams Role with automatic pagination" $ do + svr <- startMockServer . paginationApp $ encode . RoleList <$> roleListList + + res <- runConduit $ streamRoleList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat roleListList + + stopMockServer svr + + it "streamRoleList stops pagination at invalid Link Header" $ do + svr <- startMockServer . invalidPaginationApp $ encode . RoleList <$> roleListList + + res <- runConduit $ streamRoleList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat (take 2 roleListList) + + stopMockServer svr + + it "getDetail for a role returns a Role" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp roleJson req respond + + 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" + + stopMockServer svr + + it "getDetailEither for a role returns a (Right Role)" $ do + receivedReqMVar <- newEmptyMVar + + svr <- startMockServer $ \req respond -> do + putMVar receivedReqMVar req + simpleApp roleJson req respond + (Right resRole) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (RoleId "testRoleId") + resRole `shouldBe` role + + stopMockServer svr 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 #-}