cisco-spark-api (empty) → 0.1.0.0
raw patch · 13 files changed
+4759/−0 lines, 13 filesdep +aesondep +attoparsecdep +basesetup-changed
Dependencies added: aeson, attoparsec, base, bitset-word8, bytestring, cisco-spark-api, conduit-combinators, data-default, hspec, http-conduit, http-types, network-uri, optparse-applicative, text, thread-hierarchy, utf8-string, wai, warp
Files
- CHANGELOG.md +3/−0
- LICENSE +21/−0
- README.md +77/−0
- Setup.hs +2/−0
- app/Main.hs +360/−0
- cisco-spark-api.cabal +88/−0
- src/Network/CiscoSpark.hs +445/−0
- src/Network/CiscoSpark/Internal.hs +166/−0
- src/Network/CiscoSpark/Types.hs +1051/−0
- test/Network/CiscoSpark/InternalSpec.hs +81/−0
- test/Network/CiscoSpark/TypesSpec.hs +706/−0
- test/Network/CiscoSparkSpec.hs +1758/−0
- test/Spec.hs +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## Cisco-spark-api 0.1.0.0++* Initial release.
+ LICENSE view
@@ -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.
+ README.md view
@@ -0,0 +1,77 @@+# cisco-spark-api++[](https://opensource.org/licenses/MIT)+[](https://travis-ci.org/nshimaza/cisco-spark-api)+[](https://hackage.haskell.org/package/cisco-spark-api)+[](http://stackage.org/nightly/package/cisco-spark-api)+[](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
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -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"+ )
+ cisco-spark-api.cabal view
@@ -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
+ src/Network/CiscoSpark.hs view
@@ -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
+ src/Network/CiscoSpark/Internal.hs view
@@ -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
+ src/Network/CiscoSpark/Types.hs view
@@ -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
+ test/Network/CiscoSpark/InternalSpec.hs view
@@ -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 "<https://api.ciscospark.com/v1/people?link=to&next=page>; 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 ["<https://api.ciscospark.com/v1/people?link=to&next=page>; rel=\"next\""]+ `shouldBe` ["https://api.ciscospark.com/v1/people?link=to&next=page"]++ it "ignores header which has no rel=next param" $ do+ extractNextUrl ["<http://hosta>; norel=next", "<http://hostb>; rel=next"] `shouldBe` ["http://hostb"]++ it "ignores invalid header" $ do+ extractNextUrl ["invalid header", "<http://valid>; 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
+ test/Network/CiscoSpark/TypesSpec.hs view
@@ -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\" : \"<h1>HTML formatted message goes here</h1><p>when the message was posted in markdown format.</p>\",\+ \ \"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 "<h1>HTML formatted message goes here</h1><p>when the message was posted in markdown format.</p>"+ , 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
+ test/Network/CiscoSparkSpec.hs view
@@ -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", "<http://localhost:3000/2>; rel=\"next\"")], ress !! 1)+ dispatch "/2" = ([contentType, ("Link", "<http://localhost:3000/3>; rel=\"next\"")], ress !! 2)+ dispatch "/3" = ([contentType], ress !! 3)+ dispatch _ = ([contentType, ("Link", "<http://localhost:3000/1>; rel=\"next\"")], ress !! 0)++invalidPaginationApp :: [L.ByteString] -> Application+invalidPaginationApp ress req respond = do+ let (cTypes, body) = dispatch $ rawPathInfo req+ respond $ responseLBS status200 cTypes body+ where+ dispatch "/1" = ([contentType, ("Link", "<http://localhost:8888/2>; rel=\"next\"")], ress !! 1)+ dispatch "/2" = ([contentType, ("Link", "<http://localhost:3000/3>; rel=\"next\"")], ress !! 2)+ dispatch "/3" = ([contentType], ress !! 3)+ dispatch _ = ([contentType, ("Link", "<http://localhost:3000/1>; rel=\"next\"")], ress !! 0)+++teamGen :: String -> Team+teamGen i = Team { teamId = TeamId . pack $ "teamId" <> i+ , teamErrors = Nothing+ , teamName = Just . TeamName . pack $ "teamName" <> i+ , teamCreatorId = Just . PersonId . pack $ "teamCreatorId" <> i+ , teamCreated = Just . Timestamp . pack $ "teamCreated" <> i+ }++teamList :: String -> [Team]+teamList j = [ teamGen $ j <> show i | i <- [1..3] ]++teamListList :: [[Team]]+teamListList = [ teamList [c] | c <- ['a'..'d'] ]++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\" : \"<h1>HTML formatted message goes here</h1><p>when the message was posted in markdown format.</p>\",\+ \ \"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 "<h1>HTML formatted message goes here</h1><p>when the message was posted in markdown format.</p>"+ , 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
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}