diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## Cisco-spark-api 0.1.0.1 + +* Put explicit upper bound for conduit. + ## Cisco-spark-api 0.1.0.0 * Initial release. diff --git a/cisco-spark-api.cabal b/cisco-spark-api.cabal --- a/cisco-spark-api.cabal +++ b/cisco-spark-api.cabal @@ -1,5 +1,5 @@ name: cisco-spark-api -version: 0.1.0.0 +version: 0.1.0.1 synopsis: A Haskell bindings for Cisco Spark API description: Cisco-spark-api package provides types and functions for accessing Cisco Spark REST API. @@ -34,7 +34,7 @@ , aeson , attoparsec , bytestring - , conduit-combinators + , conduit-combinators < 1.3 , data-default , http-conduit , network-uri @@ -49,7 +49,7 @@ build-depends: base , aeson , bytestring - , conduit-combinators + , conduit-combinators < 1.3 , data-default , http-conduit , optparse-applicative @@ -68,8 +68,9 @@ build-depends: base , aeson , attoparsec + , async , bytestring - , conduit-combinators + , conduit-combinators < 1.3 , data-default , http-conduit , http-types @@ -79,7 +80,6 @@ , warp , hspec , cisco-spark-api - , thread-hierarchy ghc-options: -rtsopts default-language: Haskell2010 diff --git a/src/Network/CiscoSpark.hs b/src/Network/CiscoSpark.hs --- a/src/Network/CiscoSpark.hs +++ b/src/Network/CiscoSpark.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} @@ -233,7 +232,7 @@ :: CiscoSparkRequest -- ^ Common request components -> ByteString -- ^ API category part of REST URL path -> CiscoSparkRequest -makeCommonListReq base@(CiscoSparkRequest { ciscoSparkRequestRequest = req }) path +makeCommonListReq base@CiscoSparkRequest { ciscoSparkRequestRequest = req } path = base { ciscoSparkRequestRequest = setRequestPath ("/v1/" <> path) $ setRequestMethod "GET" req } {-| @@ -250,7 +249,7 @@ -- | 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 + = case getNextUrl res >>= validateUrl scheme uriAuth >>= (\url -> parseRequest $ "GET " <> C8.unpack url) of Nothing -> pure () Just nextReq -> do nextRes <- httpJSON $ addAuthorizationHeader auth nextReq @@ -266,7 +265,7 @@ streamEntityWithFilter auth base param = streamList auth $ setQeuryString $ makeCommonListReq base (apiPath param) where - setQeuryString comm@(CiscoSparkRequest { ciscoSparkRequestRequest = req }) + setQeuryString comm@CiscoSparkRequest { ciscoSparkRequestRequest = req } = comm { ciscoSparkRequestRequest = setRequestQueryString (toFilterList param) req } -- | List of 'Team' and stream it into Conduit pipe. It automatically performs pagination. diff --git a/src/Network/CiscoSpark/Types.hs b/src/Network/CiscoSpark/Types.hs --- a/src/Network/CiscoSpark/Types.hs +++ b/src/Network/CiscoSpark/Types.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} @@ -94,7 +93,11 @@ rolesPath :: ByteString rolesPath = "roles" +-- | URL path for webhooks API. +webhooksPath :: ByteString +webhooksPath = "webhooks" + {-| SparkListItem is a type class grouping types with following common usage. @@ -199,7 +202,7 @@ | 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) + deriving (Eq, Generic, Show) -- | 'PersonStatus' implements 'toEncoding' to encode each constructor into JSON enum value. instance ToJSON PersonStatus where @@ -1011,7 +1014,7 @@ toFilterList filter = maybeToList $ (\(OrganizationId o) -> ("orgId", Just $ encodeUtf8 o)) <$> licenseFilterOrgId filter --- | Name of 'Role' +-- | Name of 'Role'. newtype RoleName = RoleName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) {-| @@ -1026,7 +1029,7 @@ } deriving (Eq, Show) $(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 4, omitNothingFields = True } ''Role) --- ^ 'RoleName' derives ToJSON and FromJSON via deriveJSON template haskell function. +-- ^ 'Role' derives ToJSON and FromJSON via deriveJSON template haskell function. -- | Get detail for role API uses 'RoleId' and path "roles". instance SparkApiPath RoleId where @@ -1049,3 +1052,249 @@ instance SparkListItem Role where type ToList Role = RoleList unwrap = roleListItems + + +-- | 'Webhook' identifier which can be assigned to user. See 'Webhook' too. +newtype WebhookId = WebhookId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Name of 'Webhook'. +newtype WebhookName = WebhookName Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | URL pointing to webhook target. +newtype WebhookUrl = WebhookUrl Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | URL-encoded set of webhook filtering criteria. +newtype WebhookFilter = WebhookFilter Text deriving (Eq, Show, Generic, ToJSON, FromJSON) +-- | Shared secret supplied by user to authenticate Spark Cloud by webhook receiver. +newtype WebhookSecret = WebhookSecret Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +-- | 'WebhookResource' indicates source of event which triggered webhook access. +data WebhookResource = WebhookResourceAll + | WebhookResourceTeams + | WebhookResourceMemberships + | WebhookResourceMessages + | WebhookResourceRooms + deriving (Eq, Show) + +$(deriveJSON defaultOptions { constructorTagModifier = dropAndLow 15 } ''WebhookResource) +-- ^ 'WebhookResource' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | WebhookEvent indicates which event triggered Webhook access. +data WebhookEvent = WebhookEventAll + | WebhookEventCreated + | WebhookEventUpdated + | WebhookEventDeleted + deriving (Eq, Show) + +$(deriveJSON defaultOptions { constructorTagModifier = dropAndLow 12 } ''WebhookEvent) +-- ^ 'WebhookEvent' derives ToJSON and FromJSON via deriveJSON template haskell function. + +{-| + 'Webhook' allow your app to be notified via HTTP when a specific event occurs on Spark. For example, + your app can register a webhook to be notified when a new message is posted into a specific room. +-} +data Webhook = Webhook + { webhookId :: WebhookId -- ^ Identifier of the Webhook. + , webhookErrors :: Maybe Errors -- ^ Element level error possibly contained in List API response. + , webhookName :: Maybe WebhookName -- ^ Name of the Webhook. + , webhookTargetUrl :: Maybe WebhookUrl -- ^ URL pointing to webhook target. + , webhookResource :: Maybe WebhookResource -- ^ Resource type where events are monitored. + , webhookEvent :: Maybe WebhookEvent -- ^ Event type which will be monitored. + , webhookFilter :: Maybe WebhookFilter -- ^ URL-encoded set of webhook filtering criteria. + , webhookSecret :: Maybe WebhookSecret -- ^ User supplied shared secret for authentication. + , webhookCreated :: Maybe Timestamp -- ^ Timestamp when the Webhook was created. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 7, omitNothingFields = True } ''Webhook) +-- ^ 'Webhook' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Get detail for webhook API uses 'WebhookId' and path "webhooks". +instance SparkApiPath WebhookId where + apiPath _ = webhooksPath + +-- | Get detail for a webhook API uses "WebhookId' and responses 'Webhook'. +instance SparkResponse WebhookId where + type ToResponse WebhookId = Webhook + +-- | User can get detail of a webhook. +instance SparkDetail WebhookId where + toIdStr (WebhookId s) = s + +-- | 'WebhookList' is decoded from response JSON of List Webhook REST call. It is list of 'Webhook'. +newtype WebhookList = WebhookList { webhookListItems :: [Webhook] } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 11, omitNothingFields = True } ''WebhookList) +-- ^ 'WebhookList' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'WebhookList' wraps 'Webhook' +instance SparkListItem Webhook where + type ToList Webhook = WebhookList + unwrap = webhookListItems + +-- | 'CreateWebhook' is encoded to request body JSON of Create a Webhook REST call. +data CreateWebhook = CreateWebhook + { createWebhookName :: WebhookName -- ^ Name of Webhook to be created. + , createWebhookTargetUrl :: WebhookUrl -- ^ URL pointing to webhook target. + , createWebhookResource :: WebhookResource -- ^ Resource type where events will be monitored. + , createWebhookEvent :: WebhookEvent -- ^ Event type which will be monitored. + , createWebhookFilter :: Maybe WebhookFilter -- ^ URL-encoded set of webhook filtering criteria. + , createWebhookSecret :: Maybe WebhookSecret -- ^ User supplied shared secret for authentication. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 13, omitNothingFields = True } ''CreateWebhook) +-- ^ 'CreateWebhook' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Create webhook API uses 'CreateWebhook' and path "webhooks". +instance SparkApiPath CreateWebhook where + apiPath _ = webhooksPath + +-- | Create webhook API uses "CreateWebhook' and responses 'Webhook'. +instance SparkResponse CreateWebhook where + type ToResponse CreateWebhook = Webhook + +-- | User can create a webhook. +instance SparkCreate CreateWebhook where + +-- | 'UpdateWebhook' is encoded to request body JSON of Update a Webhook REST call. +data UpdateWebhook = UpdateWebhook + { updateWebhookName :: WebhookName -- ^ Name of Webhook to be created. + , updateWebhookTargetUrl :: WebhookUrl -- ^ URL pointing to webhook target. + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 13, omitNothingFields = True } ''UpdateWebhook) +-- ^ 'UpdateWebhook' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Update webhook API uses 'UpdateWebhook' and path "webhooks". +instance SparkApiPath UpdateWebhook where + apiPath _ = webhooksPath + +-- | Update webhook API uses "UpdateWebhook' and responses 'Webhook'. +instance SparkResponse UpdateWebhook where + type ToResponse UpdateWebhook = Webhook + +-- | User can update a webhook. +instance SparkUpdate UpdateWebhook + +-- | Optional query strings for membership event. +data WebhookMembershipFilter = WebhookMembershipFilter + { webhookFilterMembershipRoomId :: Maybe RoomId -- ^ Feed events only for given room. + , webhookFilterMembershipPersonId :: Maybe PersonId -- ^ Feed events only for given person. + , webhookFilterMembershipPersonEmail :: Maybe Email -- ^ Feed events only person who has given email. + , webhookFilterMembershipIsModerator :: Maybe Bool -- ^ Feed events only for moderator membership changes. + } deriving (Eq, Show) + +-- | Create webhook API accepts 'WebhookMembershipFilter' and uses path "webhooks". +instance SparkApiPath WebhookMembershipFilter where + apiPath _ = webhooksPath + +-- | List team memberships API accepts 'WebhookMembershipFilter' and responses 'Webhook'. +instance SparkResponse WebhookMembershipFilter where + type ToResponse WebhookMembershipFilter = Webhook + +-- | User can filter Webhook events from membership. +instance SparkFilter WebhookMembershipFilter where + toFilterList filter = catMaybes + [ (\(RoomId r) -> ("roomId", Just $ encodeUtf8 r)) <$> webhookFilterMembershipRoomId filter + , (\(PersonId p) -> ("personId", Just (encodeUtf8 p))) <$> webhookFilterMembershipPersonId filter + , (\(Email e) -> ("personEmail", Just (encodeUtf8 e))) <$> webhookFilterMembershipPersonEmail filter + , (\b -> ("isModerator", Just (if b then "true" else "false"))) <$> webhookFilterMembershipIsModerator filter + ] + +-- | Optional query strings for message event. +data WebhookMessageFilter = WebhookMessageFilter + { webhookFilterMessageRoomId :: Maybe RoomId -- ^ Feed events only for given room. + , webhookFilterMessageRoomType :: Maybe RoomType -- ^ Feed events only for given room type. + , webhookFilterMessagePersonId :: Maybe PersonId -- ^ Feed events only for given person. + , webhookFilterMessagePersonEmail :: Maybe Email -- ^ Feed events only person who has given email. + , webhookFilterMessagememtionedPeople :: Maybe MentionedPeople -- ^ Feed events only mentioned for given person. + , webhookFilterMessageHasFiles :: Maybe Bool -- ^ Feed events only messages with attached file. + } deriving (Eq, Show) + +-- | Create webhook API accepts 'WebhookMessageFilter' and uses path "webhooks". +instance SparkApiPath WebhookMessageFilter where + apiPath _ = webhooksPath + +-- | List team memberships API accepts 'WebhookMessageFilter' and responses 'Webhook'. +instance SparkResponse WebhookMessageFilter where + type ToResponse WebhookMessageFilter = Webhook + +-- | User can filter Webhook events from message. +instance SparkFilter WebhookMessageFilter where + toFilterList filter = catMaybes + [ (\(RoomId r) -> ("roomId", Just $ encodeUtf8 r)) <$> webhookFilterMessageRoomId filter + , (\t -> ("roomType", Just $ roomTypeToFilterString t)) <$> webhookFilterMessageRoomType filter + , (\(PersonId p) -> ("personId", Just (encodeUtf8 p))) <$> webhookFilterMessagePersonId filter + , (\(Email e) -> ("personEmail", Just (encodeUtf8 e))) <$> webhookFilterMessagePersonEmail filter + , (\p -> ("mentionedPeople", Just $ mentionedPeopleToFilterString p)) <$> webhookFilterMessagememtionedPeople filter + , (\b -> ("hasFiles", Just (if b then "true" else "false"))) <$> webhookFilterMessageHasFiles filter + ] + +-- | Optional query strings for room event. +data WebhookRoomFilter = WebhookRoomFilter + { webhookFilterRoomType :: Maybe RoomType -- ^ Feed events only for given room type. + , webhookFilterRoomIsLocked :: Maybe Bool -- ^ Feed events only locked unlocked rooms when true. + } deriving (Eq, Show) + +-- | Create webhook API accepts 'WebhookRoomFilter' and uses path "webhooks". +instance SparkApiPath WebhookRoomFilter where + apiPath _ = webhooksPath + +-- | List team memberships API accepts 'WebhookRoomFilter' and responses 'Webhook'. +instance SparkResponse WebhookRoomFilter where + type ToResponse WebhookRoomFilter = Webhook + +-- | User can filter Webhook events from room. +instance SparkFilter WebhookRoomFilter where + toFilterList filter = catMaybes + [ (\t -> ("type", Just $ roomTypeToFilterString t)) <$> webhookFilterRoomType filter + , (\b -> ("isLocked", Just (if b then "true" else "false"))) <$> webhookFilterRoomIsLocked filter + ] + + +-- | Identifier of app. +newtype AppId = AppId Text deriving (Eq, Show, Generic, ToJSON, FromJSON) + +-- | 'WebhookNotifyOwnedBy' indicates if the webhook is owned by the org or the creator. +data WebhookNotifyOwnedBy = WebhookNotifyOwnedByOrg | WebhookNotifyOwnedByCreator deriving (Eq, Show) + +$(deriveJSON defaultOptions { constructorTagModifier = dropAndLow 18 } ''WebhookNotifyOwnedBy) +-- ^ 'WebhookNotifyOwnedBy' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | 'WebhookNotifyStatus' indicates if the webhook is active. +data WebhookNotifyStatus = WebhookNotifyStatusActive | WebhookNotifyStatusDesabled deriving (Eq, Show) + +$(deriveJSON defaultOptions { constructorTagModifier = dropAndLow 19 } ''WebhookNotifyStatus) +-- ^ 'WebhookNotifyStatus' derives ToJSON and FromJSON via deriveJSON template haskell function. + +{-| + 'Webhook' decodes webhook notification from Spark Cloud except data field. + Data field can be one of 'Membership', 'Message' or 'Room'. Type of data field is + shown as value of resource field. +-} +data WebhookNotify = WebhookNotify + { webhookNotifyId :: WebhookId + , webhookNotifyName :: WebhookName + , webhookNotifyResource :: WebhookResource + , webhookNotifyEvent :: WebhookEvent + , webhookNotifyFilter :: WebhookFilter + , webhookNotifyOrgId :: Organization + , webhookNotifyCreatedBy :: PersonId + , webhookNotifyAppId :: AppId + , webhookNotifyOwnedBy :: WebhookNotifyOwnedBy + , webhookNotifyStatus :: WebhookNotifyStatus + , webhookNotifyActorId :: PersonId + } deriving (Eq, Show) + +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 13, omitNothingFields = True } ''WebhookNotify) +-- ^ 'WebhookNotify' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Data part of webhook notification is decoded to 'Membership' when resource field value is "memberships". +newtype WebhookNotifyMembership = WebhookNotifyMembership { webhookNotifyMembershipData :: Membership } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 23, omitNothingFields = True } ''WebhookNotifyMembership) +-- ^ 'WebhookNotifyMembership' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Data part of webhook notification is decoded to 'Message' when resource field value is "messages". +newtype WebhookNotifyMessage = WebhookNotifyMessage { webhookNotifyMessageData :: Message } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 20, omitNothingFields = True } ''WebhookNotifyMessage) +-- ^ 'WebhookNotifyMessage' derives ToJSON and FromJSON via deriveJSON template haskell function. + +-- | Data part of webhook notification is decoded to 'Room' when resource field value is "rooms". +newtype WebhookNotifyRoom = WebhookNotifyRoom { webhookNotifyRoomData :: Room } deriving (Eq, Show) +$(deriveJSON defaultOptions { fieldLabelModifier = dropAndLow 17, omitNothingFields = True } ''WebhookNotifyRoom) +-- ^ 'WebhookNotifyRoom' derives ToJSON and FromJSON via deriveJSON template haskell function. diff --git a/test/Network/CiscoSpark/TypesSpec.hs b/test/Network/CiscoSpark/TypesSpec.hs --- a/test/Network/CiscoSpark/TypesSpec.hs +++ b/test/Network/CiscoSpark/TypesSpec.hs @@ -18,8 +18,8 @@ \ \"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" + 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" } } @@ -110,29 +110,29 @@ \ }\ \ }\ \}" - personError = Person { personId = PersonId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" - , personErrors = Just $ Errors - { errorsTitle = ErrorTitle - { errorTitleCode = ErrorCode "kms_failure" + 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 + ,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 ] @@ -200,16 +200,16 @@ \ }\ \ }\ \}" - teamError = Team { teamId = TeamId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" - , teamErrors = Just $ Errors - { errorsTitle = ErrorTitle - { errorTitleCode = ErrorCode "kms_failure" + 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 + , teamName = Nothing + , teamCreatorId = Nothing + , teamCreated = Nothing } teamListJson = "{\"items\":[" <> teamJson <> "," <> teamErrorJson <> "]}" teamList = TeamList [ team, teamError ] @@ -267,11 +267,11 @@ \ }\ \ }\ \}" - 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" + 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 @@ -350,21 +350,21 @@ \ }\ \ }\ \}" - roomError = Room { roomId = RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" - , roomErrors = Just $ Errors - { errorsTitle = ErrorTitle - { errorTitleCode = ErrorCode "kms_failure" + 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 + , roomTitle = Nothing + , roomType = Nothing + , roomIsLocked = Nothing + , roomSipAddress = Nothing + , roomLastActivity = Nothing + , roomTeamId = Nothing + , roomCreatorId = Nothing + , roomCreated = Nothing } roomListJson = "{\"items\":[" <> roomJson <> "," <> roomErrorJson <> "]}" roomList = RoomList [ room, roomError ] @@ -381,7 +381,7 @@ (decode . encode) roomList `shouldBe` Just roomList it "encodes CreateRoom to JSON" $ do - let src = CreateRoom { createRoomTitle = RoomTitle "Project Unicorn - Sprint 0" + let src = CreateRoom { createRoomTitle = RoomTitle "Project Unicorn - Sprint 0" , createRoomTeamId = Just $ TeamId "Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz" } dst = "{\ @@ -429,21 +429,21 @@ \ }\ \ }\ \}" - 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" + 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 + , membershipRoomId = Nothing + , membershipPersonId = Nothing + , membershipPersonEmail = Nothing + , membershipPersonDisplayName = Nothing + , membershipPersonOrgId = Nothing + , membershipIsModerator = Nothing + , membershipIsMonitor = Nothing + , membershipCreated = Nothing } membershipListJson = "{\"items\":[" <> membershipJson <> "," <> membershipErrorJson <> "]}" membershipList = MembershipList [ membership, membershipError ] @@ -520,24 +520,24 @@ \ }\ \ }\ \}" - 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" + 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 + , 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 ] @@ -545,11 +545,11 @@ it "can be unwrapped from MessageList" $ do unwrap messageList `shouldBe` [ message, messageError ] - it "decodes Team Message API response JSON" $ do + it "decodes Message API response JSON" $ do eitherDecode messageJson `shouldBe` Right message (decode . encode) message `shouldBe` Just message - it "decodes Team Message list" $ do + it "decodes Message list" $ do eitherDecode messageListJson `shouldBe` Right messageList (decode . encode) messageList `shouldBe` Just messageList @@ -593,15 +593,15 @@ \ }\ \ }\ \}" - organizationError = Organization { organizationId = OrganizationId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" - , organizationErrors = Just $ Errors - { errorsTitle = ErrorTitle - { errorTitleCode = ErrorCode "kms_failure" + 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 + , organizationDisplayName = Nothing + , organizationCreated = Nothing } organizationListJson = "{\"items\":[" <> organizationJson <> "," <> organizationErrorJson <> "]}" organizationList = OrganizationList [ organization, organizationError ] @@ -609,11 +609,11 @@ it "can be unwrapped from OrganizationList" $ do unwrap organizationList `shouldBe` [ organization, organizationError ] - it "decodes Team Organization API response JSON" $ do + it "decodes Organization API response JSON" $ do eitherDecode organizationJson `shouldBe` Right organization (decode . encode) organization `shouldBe` Just organization - it "decodes Team Organization list" $ do + it "decodes Organization list" $ do eitherDecode organizationListJson `shouldBe` Right organizationList (decode . encode) organizationList `shouldBe` Just organizationList @@ -631,24 +631,24 @@ , 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" + \ \"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 + , licenseName = Nothing + , licenseTotalUnits = Nothing + , licenseConsumedUnits = Nothing } licenseListJson = "{\"items\":[" <> licenseJson <> "," <> licenseErrorJson <> "]}" licenseList = LicenseList [ license, licenseError ] @@ -656,11 +656,11 @@ it "can be unwrapped from LicenseList" $ do unwrap licenseList `shouldBe` [ license, licenseError ] - it "decodes Team License API response JSON" $ do + it "decodes License API response JSON" $ do eitherDecode licenseJson `shouldBe` Right license (decode . encode) license `shouldBe` Just license - it "decodes Team License list" $ do + it "decodes License list" $ do eitherDecode licenseListJson `shouldBe` Right licenseList (decode . encode) licenseList `shouldBe` Just licenseList @@ -674,22 +674,22 @@ , 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" + \ \"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 + , roleName = Nothing } roleListJson = "{\"items\":[" <> roleJson <> "]}" roleList = RoleList [ role ] @@ -697,10 +697,96 @@ it "can be unwrapped from RoleList" $ do unwrap roleList `shouldBe` [ role ] - it "decodes Team Role API response JSON" $ do + it "decodes Role API response JSON" $ do eitherDecode roleJson `shouldBe` Right role (decode . encode) role `shouldBe` Just role - it "decodes Team Role list" $ do + it "decodes Role list" $ do eitherDecode roleListJson `shouldBe` Right roleList (decode . encode) roleList `shouldBe` Just roleList + + describe "Webhook" $ do + let webhookJson = "{\ + \ \"id\" : \"96abc2aa-3dcc-11e5-a152-fe34819cdc9a\",\ + \ \"name\" : \"My Awesome Webhook\",\ + \ \"targetUrl\" : \"https://example.com/mywebhook\",\ + \ \"resource\" : \"messages\",\ + \ \"event\" : \"created\",\ + \ \"filter\" : \"roomId=Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"secret\" : \"86dacc007724d8ea666f88fc77d918dad9537a15\",\ + \ \"created\" : \"2015-10-18T14:26:16+00:00\"\ + \}" + webhook = Webhook { webhookId = WebhookId "96abc2aa-3dcc-11e5-a152-fe34819cdc9a" + , webhookErrors = Nothing + , webhookName = Just $ WebhookName "My Awesome Webhook" + , webhookTargetUrl = Just $ WebhookUrl "https://example.com/mywebhook" + , webhookResource = Just $ WebhookResourceMessages + , webhookEvent = Just $ WebhookEventCreated + , webhookFilter = Just $ WebhookFilter "roomId=Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , webhookSecret = Just $ WebhookSecret "86dacc007724d8ea666f88fc77d918dad9537a15" + , webhookCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + } + webhookErrorJson = "{\ + \ \"id\": \"Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5\",\ + \ \"errors\": {\ + \ \"title\": {\ + \ \"code\": \"kms_failure\",\ + \ \"reason\": \"Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html\"\ + \ }\ + \ }\ + \}" + webhookError = Webhook { webhookId = WebhookId "Y2lzY29zcGFyazovL3VzL1JPT00vNTIxN0EyMzYtNDQzQi00NThELTkzNjAtRDRFOTMyMTBBNUU5" + , webhookErrors = Just $ Errors + { errorsTitle = ErrorTitle + { errorTitleCode = ErrorCode "kms_failure" + , errorTitleReason = "Key management server failed to respond appropriately. For more information: https://developer.ciscospark.com/errors.html" + } + } + , webhookName = Nothing + , webhookTargetUrl = Nothing + , webhookResource = Nothing + , webhookEvent = Nothing + , webhookFilter = Nothing + , webhookSecret = Nothing + , webhookCreated = Nothing + } + webhookListJson = "{\"items\":[" <> webhookJson <> "," <> webhookErrorJson <> "]}" + webhookList = WebhookList [ webhook, webhookError ] + + it "can be unwrapped from WebhookList" $ do + unwrap webhookList `shouldBe` [ webhook, webhookError ] + + it "decodes Webhook API response JSON" $ do + eitherDecode webhookJson `shouldBe` Right webhook + (decode . encode) webhook `shouldBe` Just webhook + + it "decodes Webhook list" $ do + eitherDecode webhookListJson `shouldBe` Right webhookList + (decode . encode) webhookList `shouldBe` Just webhookList + + it "encodes CreateWebhook to JSON" $ do + let src = CreateWebhook { createWebhookName = WebhookName "My Awesome Webhook" + , createWebhookTargetUrl = WebhookUrl "https://example.com/mywebhook" + , createWebhookResource = WebhookResourceMessages + , createWebhookEvent = WebhookEventCreated + , createWebhookFilter = Just $ WebhookFilter "roomId=Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , createWebhookSecret = Just $ WebhookSecret "86dacc007724d8ea666f88fc77d918dad9537a15" + } + dst = "{\ + \ \"name\" : \"My Awesome Webhook\",\ + \ \"targetUrl\" : \"https://example.com/mywebhook\",\ + \ \"resource\" : \"messages\",\ + \ \"event\" : \"created\",\ + \ \"filter\" : \"roomId=Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"secret\" : \"86dacc007724d8ea666f88fc77d918dad9537a15\"\ + \}" + eitherDecode dst `shouldBe` Right src + (decode . encode) src `shouldBe` (decode dst :: Maybe CreateWebhook) + + it "encodes UpdateWebhook to JSON" $ do + let src = UpdateWebhook { updateWebhookName = WebhookName "My Awesome Webhook" + , updateWebhookTargetUrl = WebhookUrl "https://example.com/mywebhook" + } + dst = "{\"name\":\"My Awesome Webhook\",\"targetUrl\":\"https://example.com/mywebhook\"}" + encode src `shouldBe` dst + (decode . encode) src `shouldBe` Just src diff --git a/test/Network/CiscoSparkSpec.hs b/test/Network/CiscoSparkSpec.hs --- a/test/Network/CiscoSparkSpec.hs +++ b/test/Network/CiscoSparkSpec.hs @@ -1,1758 +1,1578 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} - -module Network.CiscoSparkSpec where - -import Conduit -import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, - takeMVar) -import Control.Monad (void) -import Data.Aeson (decode, encode) -import Data.Attoparsec.ByteString (parseOnly) -import qualified Data.ByteString as S (ByteString) -import qualified Data.ByteString.Char8 as C8 (unpack) -import qualified Data.ByteString.Lazy as L (ByteString) -import Data.Default (def) -import Data.List (sort) -import Data.Maybe (fromJust) -import Data.Monoid ((<>)) -import Data.Text (pack) - -import Network.HTTP.Simple as C - -import Network.HTTP.Types (Header, status200) -import Network.URI (URIAuth (..)) -import Network.Wai -import Network.Wai.Handler.Warp (Settings, defaultSettings, - runSettings, setBeforeMainLoop) - -import Test.Hspec - -import Control.Concurrent.Hierarchy (ThreadMap, killThreadHierarchy, - newChild, newThreadMap) -import Network.CiscoSpark -import Network.CiscoSpark.Internal (LinkHeader (..), LinkParam (..), - getNextUrl, linkHeader) - - -import Data.Typeable (typeOf) - - -newtype MockServer = MockServer ThreadMap - -mockBaseRequestRequest - = C.addRequestHeader "Content-Type" "application/json; charset=utf-8" - $ C.setRequestPort 3000 - $ C.setRequestHost "localhost" - $ C.setRequestSecure False - $ C.defaultRequest - -mockBaseRequest :: CiscoSparkRequest -mockBaseRequest = CiscoSparkRequest mockBaseRequestRequest "http:" $ URIAuth "" "localhost" ":3000" - -dummyAuth :: Authorization -dummyAuth = Authorization "dummyAuth" - -extractRight :: Show err => Either err r -> r -extractRight (Right r) = r -extractRight (Left err) = error $ show err - -startMockServer :: Application -> IO MockServer -startMockServer app = do - readyToConnect <- newEmptyMVar - rootThreadMap <- newThreadMap - let set = setBeforeMainLoop (putMVar readyToConnect ()) defaultSettings - newChild rootThreadMap $ \_ -> runSettings set app - takeMVar readyToConnect - return $ MockServer rootThreadMap - -stopMockServer :: MockServer -> IO () -stopMockServer (MockServer rootThreadMap) = killThreadHierarchy rootThreadMap - -helloApp :: Application -helloApp _ respond = respond $ responseLBS status200 [] "hello, world" - -contentType :: Header -contentType = ("Content-Type", "application/json; charset=utf-8") - -simpleApp :: L.ByteString -> Application -simpleApp res _ respond = respond $ responseLBS status200 [contentType] res - -paginationApp :: [L.ByteString] -> Application -paginationApp ress req respond = do - let (cTypes, body) = dispatch $ rawPathInfo req - respond $ responseLBS status200 cTypes body - where - dispatch "/1" = ([contentType, ("Link", "; rel=\"next\"")], ress !! 1) - dispatch "/2" = ([contentType, ("Link", "; rel=\"next\"")], ress !! 2) - dispatch "/3" = ([contentType], ress !! 3) - dispatch _ = ([contentType, ("Link", "; rel=\"next\"")], ress !! 0) - -invalidPaginationApp :: [L.ByteString] -> Application -invalidPaginationApp ress req respond = do - let (cTypes, body) = dispatch $ rawPathInfo req - respond $ responseLBS status200 cTypes body - where - dispatch "/1" = ([contentType, ("Link", "; rel=\"next\"")], ress !! 1) - dispatch "/2" = ([contentType, ("Link", "; rel=\"next\"")], ress !! 2) - dispatch "/3" = ([contentType], ress !! 3) - dispatch _ = ([contentType, ("Link", "; rel=\"next\"")], ress !! 0) - - -teamGen :: String -> Team -teamGen i = Team { teamId = TeamId . pack $ "teamId" <> i - , teamErrors = Nothing - , teamName = Just . TeamName . pack $ "teamName" <> i - , teamCreatorId = Just . PersonId . pack $ "teamCreatorId" <> i - , teamCreated = Just . Timestamp . pack $ "teamCreated" <> i - } - -teamList :: String -> [Team] -teamList j = [ teamGen $ j <> show i | i <- [1..3] ] - -teamListList :: [[Team]] -teamListList = [ teamList [c] | c <- ['a'..'d'] ] - -spec :: Spec -spec = do - describe "Mock Applications" $ do - it "simple mock app returns list of team" $ do - receivedReqMVar <- newEmptyMVar - let (CiscoSparkRequest baseReq _ _) = mockBaseRequest - req = setRequestPath "/v1/teams" - $ setRequestMethod "GET" - $ baseReq - testData = TeamList $ teamList ['Z'] - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode testData) req respond - - res <- getResponseBody <$> httpJSON req - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "GET" - rawPathInfo receivedReq `shouldBe` "/v1/teams" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - it "pagenation mock app returns list of team and Link header" $ do - receivedReqMVar <- newEmptyMVar - let (CiscoSparkRequest baseReq _ _) = mockBaseRequest - req = setRequestPath "/v1/teams" - $ setRequestMethod "GET" - $ baseReq - testData = encode . TeamList <$> teamListList - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - paginationApp testData req respond - - res1 <- httpJSON req - getResponseBody res1 `shouldBe` TeamList (teamListList !! 0) - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/teams" - - let path = getNextUrl res1 - path `shouldBe` Just "http://localhost:3000/1" - - req2 <- parseRequest $ "GET " <> C8.unpack (fromJust path) - res2 <- httpJSON req2 - getResponseBody res2 `shouldBe` TeamList (teamListList !! 1) - - stopMockServer svr - - describe "People" $ do - let personJson1 = "{\ - \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ - \ \"emails\" : [ \"johnny.chang@foomail.com\", \"jchang@barmail.com\" ],\ - \ \"displayName\" : \"John Andersen\",\ - \ \"firstName\" : \"John\",\ - \ \"lastName\" : \"Andersen\",\ - \ \"avatar\" : \"https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600\",\ - \ \"orgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ - \ \"roles\" : [ \"Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\" ],\ - \ \"licenses\" : [ \"Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\" ],\ - \ \"created\" : \"2015-10-18T14:26:16.000Z\",\ - \ \"timezone\" : \"America/Denver\",\ - \ \"lastActivity\" : \"2015-10-18T14:26:16.028Z\",\ - \ \"status\" : \"active\",\ - \ \"invitePending\" : false,\ - \ \"loginEnabled\" : true\ - \}" - person1 = Person { personId = PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" - , personErrors = Nothing - , personEmails = Just [Email "johnny.chang@foomail.com", Email "jchang@barmail.com"] - , personDisplayName = Just $ DisplayName "John Andersen" - , personNickName = Nothing - , personFirstName = Just $ FirstName "John" - , personLastName = Just $ LastName "Andersen" - , personAvatar = Just $ AvatarUrl "https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600" - , personOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" - , personRoles = Just [ RoleId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" - , RoleId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] - , personLicenses = Just [ LicenseId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" - , LicenseId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] - , personCreated = Just $ Timestamp "2015-10-18T14:26:16.000Z" - , personTimezone = Just $ Timezone "America/Denver" - , personLastActivity = Just $ Timestamp "2015-10-18T14:26:16.028Z" - , personStatus = Just PersonStatusActive - , personInvitePending = Just False - , personLoginEnabled = Just True - , personType = Nothing - } - personGen i = Person { personId = PersonId . pack $ "PersonId" <> i - , personErrors = Nothing - , personEmails = Just [Email . pack $ "email" <> i <> "@foomail.com", Email . pack $ "email" <> i <> "@barmail.com"] - , personDisplayName = Just . DisplayName . pack $ "John Andersen" <> i - , personNickName = Nothing - , personFirstName = Just $ FirstName . pack $ "John" <> i - , personLastName = Just $ LastName . pack $ "Andersen" <> i - , personAvatar = Just $ AvatarUrl . pack $ "https://AvatarUrl" <> i - , personOrgId = Just . OrganizationId . pack $ "OrganizationId" <> i - , personRoles = Just [ RoleId . pack $ "RoleIdA" <> i - , RoleId . pack $ "RoleIdB" <> i] - , personLicenses = Just [ LicenseId . pack $ "LicenseIdX" <> i - , LicenseId . pack $ "LicenseIdY" <> i] - , personCreated = Just . Timestamp . pack $ "Created" <> i - , personTimezone = Just $ Timezone . pack $ "Timezone" <> i - , personLastActivity = Just $ Timestamp . pack $ "LastActivity" <> i - , personStatus = Just PersonStatusActive - , personInvitePending = Just False - , personLoginEnabled = Just True - , personType = Nothing - } - personList j = [ personGen $ j <> show i | i <- [1..3] ] - personListList = [ personList [c] | c <- ['a'..'d'] ] - newPerson = CreatePerson { createPersonEmails = Just $ [Email "johnny.chang@foomail.com", Email "jchang@barmail.com"] - , createPersonDisplayName = Just $ DisplayName "John Andersen" - , createPersonFirstName = Just $ FirstName "John" - , createPersonLastName = Just $ LastName "Andersen" - , createPersonAvatar = Just $ AvatarUrl "https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600" - , createPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" - , createPersonRoles = Just [ RoleId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" - , RoleId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] - , createPersonLicenses = Just [ LicenseId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" - , LicenseId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] - } - updatePerson = UpdatePerson { updatePersonDisplayName = Just $ DisplayName "New John Andersen" - , updatePersonFirstName = Just $ FirstName "New John" - , updatePersonLastName = Just $ LastName "New Andersen" - , updatePersonAvatar = Just $ AvatarUrl "https://example.com/newAvatarUrl" - , updatePersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" - , updatePersonRoles = Just $ [ RoleId "newRoleId1", RoleId "newRoleId2" ] - , updatePersonLicenses = Just $ [ LicenseId "newLicenseId1", LicenseId "newLicenseId2" ] - } - - it "streamPersonList streams Team" $ do - let testData = personList ['Z'] - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (PersonList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/people" - queryString receivedReq `shouldBe` [] - - stopMockServer svr - - it "streamPersonList passes query strings build from PersonFilter to server" $ do - let testData = personList ['Z'] - personFilter = PersonFilter (Just $ Email "person@filter.com") - (Just $ DisplayName "DisplayNameFilter") - (Just $ OrganizationId "OrgIdFilter") - - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (PersonList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest personFilter .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/people" - (sort . queryString) receivedReq `shouldBe` sort [ ("orgId", Just "OrgIdFilter") - , ("displayName", Just "DisplayNameFilter") - , ("email", Just "person@filter.com") ] - - stopMockServer svr - - it "streamPersonList streams Team with automatic pagination" $ do - svr <- startMockServer . paginationApp $ encode . PersonList <$> personListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) .| sinkList - res `shouldBe` concat personListList - - stopMockServer svr - - it "streamPersonList stops pagination at invalid Link Header" $ do - svr <- startMockServer . invalidPaginationApp $ encode . PersonList <$> personListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) .| sinkList - res `shouldBe` concat (take 2 personListList) - - stopMockServer svr - - it "getDetail for a person returns a Person" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp personJson1 req respond - - resPerson <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (PersonId "testPersonId") - resPerson `shouldBe` person1 - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "GET" - rawPathInfo receivedReq `shouldBe` "/v1/people/testPersonId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - it "getDetailEither for a person returns a (Right Person)" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp personJson1 req respond - - (Right resPerson) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (PersonId "testPersonId") - resPerson `shouldBe` person1 - - stopMockServer svr - - it "createEntity for a person sends JSON encoded CreatePerson as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp personJson1 req respond - - resPerson <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newPerson - resPerson `shouldBe` person1 - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/people" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newPerson - - stopMockServer svr - - it "createEntityEither for a person sends JSON encoded CreatePerson as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp personJson1 req respond - - (Right resPerson) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newPerson - resPerson `shouldBe` person1 - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/people" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newPerson - - stopMockServer svr - - it "updateEntity for a person sends JSON encoded UpdatePerson as its body of PUT request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp personJson1 req respond - - resPerson <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updatePerson - resPerson `shouldBe` person1 - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "PUT" - rawPathInfo receivedReq `shouldBe` "/v1/people" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just updatePerson - - stopMockServer svr - - it "updateEntityEither for a person sends JSON encoded UpdatePerson as its body of PUT request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp personJson1 req respond - - (Right resPerson) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updatePerson - resPerson `shouldBe` person1 - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "PUT" - rawPathInfo receivedReq `shouldBe` "/v1/people" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just updatePerson - - stopMockServer svr - - describe "Team" $ do - let teamJson = "{\ - \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ - \ \"name\" : \"Build Squad\",\ - \ \"creatorId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ - \ \"created\" : \"2015-10-18T14:26:16+00:00\"\ - \}" - team = Team { teamId = TeamId "Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" - , teamErrors = Nothing - , teamName = Just $ TeamName "Build Squad" - , teamCreatorId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" - , teamCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" - } - newTeam = CreateTeam $ TeamName "Build Squad" - updateTeam = UpdateTeam $ TeamName "updatedTeamName" - - it "streamTeamList streams Team" $ do - let testData = teamList ['Z'] - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (TeamList testData)) req respond - - res <- runConduit $ streamTeamList dummyAuth mockBaseRequest .| sinkList - res `shouldBe` testData - path <- rawPathInfo <$> takeMVar receivedReqMVar - path `shouldBe` "/v1/teams" - - stopMockServer svr - - it "streamTeamList streams Team with automatic pagination" $ do - svr <- startMockServer . paginationApp $ encode . TeamList <$> teamListList - - res <- runConduit $ streamTeamList dummyAuth mockBaseRequest .| sinkList - res `shouldBe` concat teamListList - - stopMockServer svr - - it "streamTeamList stops pagination at invalid Link Header" $ do - svr <- startMockServer . invalidPaginationApp $ encode . TeamList <$> teamListList - - res <- runConduit $ streamTeamList dummyAuth mockBaseRequest .| sinkList - res `shouldBe` concat (take 2 teamListList) - - stopMockServer svr - - it "getDetail for a team returns a Team" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp teamJson req respond - - resTeam <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (TeamId "testTeamId") - resTeam `shouldBe` team - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "GET" - rawPathInfo receivedReq `shouldBe` "/v1/teams/testTeamId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - it "getDetailEither for a team returns a (Right Team)" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp teamJson req respond - (Right resTeam) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (TeamId "testTeamId") - resTeam `shouldBe` team - - stopMockServer svr - - it "createEntity for a team sends JSON encoded CreateTeam as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp teamJson req respond - - resTeam <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newTeam - resTeam `shouldBe` team - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/teams" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newTeam - - stopMockServer svr - - it "createEntityEither for a team sends JSON encoded CreateTeam as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp teamJson req respond - - (Right resTeam) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newTeam - resTeam `shouldBe` team - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/teams" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newTeam - - stopMockServer svr - - it "updateEntity for a team sends JSON encoded UpdateTeam as its body of PUT request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp teamJson req respond - - resTeam <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateTeam - resTeam `shouldBe` team - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "PUT" - rawPathInfo receivedReq `shouldBe` "/v1/teams" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just updateTeam - - stopMockServer svr - - it "updateEntityEither for a team sends JSON encoded UpdateTeam as its body of PUT request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp teamJson req respond - - (Right resTeam) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateTeam - resTeam `shouldBe` team - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "PUT" - rawPathInfo receivedReq `shouldBe` "/v1/teams" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just updateTeam - - stopMockServer svr - - it "deleteTeam sends DELETE request with teamId on URL path" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp "" req respond - - deleteTeam dummyAuth mockBaseRequest (TeamId "testTeamId") - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "DELETE" - rawPathInfo receivedReq `shouldBe` "/v1/teams/testTeamId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - describe "TeamMemberShip" $ do - let teamMembershipJson = "{\ - \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1RFQU1fTUVNQkVSU0hJUC8wZmNmYTJiOC1hZGNjLTQ1ZWEtYTc4Mi1lNDYwNTkyZjgxZWY6MTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ - \ \"teamId\" : \"Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ - \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ - \ \"personEmail\" : \"john.andersen@example.com\",\ - \ \"personDisplayName\" : \"John Andersen\",\ - \ \"personOrgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ - \ \"isModerator\" : true,\ - \ \"created\" : \"2015-10-18T14:26:16.057Z\"\ - \}" - teamMembership = TeamMembership { teamMembershipId = TeamMembershipId "Y2lzY29zcGFyazovL3VzL1RFQU1fTUVNQkVSU0hJUC8wZmNmYTJiOC1hZGNjLTQ1ZWEtYTc4Mi1lNDYwNTkyZjgxZWY6MTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" - , teamMembershipErrors = Nothing - , teamMembershipTeamId = Just $ TeamId "Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" - , teamMembershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" - , teamMembershipPersonEmail = Just $ Email "john.andersen@example.com" - , teamMembershipPersonDisplayName = Just $ DisplayName "John Andersen" - , teamMembershipPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" - , teamMembershipIsModerator = Just True - , teamMembershipCreated = Just $ Timestamp "2015-10-18T14:26:16.057Z" - } - teamMembershipGen i = TeamMembership { teamMembershipId = TeamMembershipId . pack $ "teamMembershipId" <> i - , teamMembershipErrors = Nothing - , teamMembershipTeamId = Just . TeamId . pack $ "teamId" <> i - , teamMembershipPersonId = Just . PersonId . pack $ "personId" <> i - , teamMembershipPersonEmail = Just . Email . pack $ "email" <> i <> "@example.com" - , teamMembershipPersonDisplayName = Just . DisplayName . pack $ "DisplayName" <> i - , teamMembershipPersonOrgId = Just . OrganizationId . pack $ "OrganizationId" <> i - , teamMembershipIsModerator = Just True - , teamMembershipCreated = Just . Timestamp . pack $ "Timestamp" <> i - } - teamMembershipList j = [ teamMembershipGen $ j <> show i | i <- [1..3] ] - teamMembershipListList = [ teamMembershipList [c] | c <- ['a'..'d'] ] - defFilter = defaultTeamMembershipFilter $ TeamId "dummyTeamId" - newTeamMembership = CreateTeamMembership { createTeamMembershipTeamId = TeamId "targetTeam" - , createTeamMembershipPersonId = Just $ PersonId "addedPerson" - , createTeamMembershipPersonEmail = Just $ Email "added@example.com" - , createTeamMembershipIsModerator = Just True - } - updateTeamMembership = UpdateTeamMembership False - - it "streamTeamMembershipList streams TeamMembership" $ do - let testData = teamMembershipList ['Z'] - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (TeamMembershipList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" - queryString receivedReq `shouldBe` [ ("teamId", Just "dummyTeamId") ] - - stopMockServer svr - - it "streamMembershipList passes query strings build from TeamMembershipFilter to server" $ do - let testData = teamMembershipList ['Z'] - teamMembershipFilter = TeamMembershipFilter $ TeamId "DummyTeamId" - - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (TeamMembershipList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest teamMembershipFilter .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" - queryString receivedReq `shouldBe` [ ("teamId", Just "DummyTeamId") ] - - stopMockServer svr - - it "streamTeamMembershipList streams TeamMembership with automatic pagination" $ do - svr <- startMockServer . paginationApp $ encode . TeamMembershipList <$> teamMembershipListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList - res `shouldBe` concat teamMembershipListList - - stopMockServer svr - - it "streamTeamMembershipList stops pagination at invalid Link Header" $ do - svr <- startMockServer . invalidPaginationApp $ encode . TeamMembershipList <$> teamMembershipListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList - res `shouldBe` concat (take 2 teamMembershipListList) - - stopMockServer svr - - it "getDetail for a team membership returns a TeamMembership" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp teamMembershipJson req respond - - resTeamMembership <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (TeamMembershipId "testTeamMembershipId") - resTeamMembership `shouldBe` teamMembership - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "GET" - rawPathInfo receivedReq `shouldBe` "/v1/team/memberships/testTeamMembershipId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - it "getDetailEither for a team membership returns a (Right TeamMembership)" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp teamMembershipJson req respond - (Right resTeamMembership) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (TeamMembershipId "testTeamMembershipId") - resTeamMembership `shouldBe` teamMembership - - stopMockServer svr - - it "createEntity for a team membership sends JSON encoded CreateTeamMembership as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp teamMembershipJson req respond - - resTeamMembership <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newTeamMembership - resTeamMembership `shouldBe` teamMembership - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newTeamMembership - - stopMockServer svr - - it "createEntityEither for a team membership sends JSON encoded CreateTeamMembership as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp teamMembershipJson req respond - - (Right resTeamMembership) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newTeamMembership - resTeamMembership `shouldBe` teamMembership - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newTeamMembership - - stopMockServer svr - - it "updateEntity for a teamMembership sends JSON encoded UpdateTeamMembership as its body of PUT request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp teamMembershipJson req respond - - resTeamMembership <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateTeamMembership - resTeamMembership `shouldBe` teamMembership - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "PUT" - rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just updateTeamMembership - - stopMockServer svr - - it "updateEntityEither for a teamMembership sends JSON encoded UpdateTeamMembership as its body of PUT request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp teamMembershipJson req respond - - (Right resTeamMembership) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateTeamMembership - resTeamMembership `shouldBe` teamMembership - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "PUT" - rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just updateTeamMembership - - stopMockServer svr - - it "deleteTeamMembership sends DELETE request with teamMembershipId on URL path" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp "" req respond - - deleteTeamMembership dummyAuth mockBaseRequest (TeamMembershipId "testTeamMembershipId") - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "DELETE" - rawPathInfo receivedReq `shouldBe` "/v1/team/memberships/testTeamMembershipId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - describe "Room" $ do - let roomJson = "{\ - \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ - \ \"title\" : \"Project Unicorn - Sprint 0\",\ - \ \"type\" : \"group\",\ - \ \"isLocked\" : true,\ - \ \"sipAddress\" : \"01234567890@meet.ciscospark.com\",\ - \ \"teamId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz\",\ - \ \"lastActivity\" : \"2016-04-21T19:12:48.920Z\",\ - \ \"creatorId\": \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ - \ \"created\" : \"2016-04-21T19:01:55.966Z\"\ - \}" - room = Room { roomId = RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" - , roomErrors = Nothing - , roomTitle = Just $ RoomTitle "Project Unicorn - Sprint 0" - , roomType = Just RoomTypeGroup - , roomIsLocked = Just True - , roomSipAddress = Just $ SipAddr "01234567890@meet.ciscospark.com" - , roomLastActivity = Just $ Timestamp "2016-04-21T19:12:48.920Z" - , roomTeamId = Just $ TeamId "Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz" - , roomCreatorId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" - , roomCreated = Just $ Timestamp "2016-04-21T19:01:55.966Z" - } - roomGen i = Room { roomId = RoomId . pack $ "roomId" <> i - , roomErrors = Nothing - , roomTitle = Just . RoomTitle . pack $ "roomTitle" <> i - , roomType = Just RoomTypeGroup - , roomIsLocked = Just True - , roomSipAddress = Just $ SipAddr . pack $ "rooomSipAddress" <> i <> "@meet.ciscospark.com" - , roomLastActivity = Just . Timestamp . pack $ "roomLastActivity" <> i - , roomTeamId = Just $ TeamId . pack $ "roomTeamId" <> i - , roomCreatorId = Just . PersonId . pack $ "personId" <> i - , roomCreated = Just .Timestamp .pack $ "roomCreated" <> i - } - roomList j = [ roomGen $ j <> show i | i <- [1..3] ] - roomListList = [ roomList [c] | c <- ['a'..'d'] ] - newRoom = CreateRoom (RoomTitle "New Room") (Just $ TeamId "belongingTeam") - updateRoom = UpdateRoom $ RoomTitle "updatedRoomTitle" - - it "streamRoomList streams Room" $ do - let testData = roomList ['Z'] - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (RoomList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/rooms" - queryString receivedReq `shouldBe` [] - - stopMockServer svr - - it "streamRoomList passes query strings build from RoomFilter to server" $ do - let testData = roomList ['Z'] - roomFilter = RoomFilter (Just $ TeamId "dummyTeamId") - (Just RoomTypeGroup) - (Just RoomFilterSortByLastActivity) - - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (RoomList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest roomFilter .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/rooms" - (sort . queryString) receivedReq `shouldBe` sort [ ("type", Just "group") - , ("sortBy", Just "lastactivity") - , ("teamId", Just "dummyTeamId") ] - - stopMockServer svr - - it "streamRoomList streams Room with automatic pagination" $ do - svr <- startMockServer . paginationApp $ encode . RoomList <$> roomListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) .| sinkList - res `shouldBe` concat roomListList - - stopMockServer svr - - it "streamRoomList stops pagination at invalid Link Header" $ do - svr <- startMockServer . invalidPaginationApp $ encode . RoomList <$> roomListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) .| sinkList - res `shouldBe` concat (take 2 roomListList) - - stopMockServer svr - - it "getDetail for a room returns a Room" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp roomJson req respond - - resRoom <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (RoomId "testRoomId") - resRoom `shouldBe` room - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "GET" - rawPathInfo receivedReq `shouldBe` "/v1/rooms/testRoomId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - it "getDetailEither for a room returns a (Right Room)" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp roomJson req respond - (Right resRoom) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (RoomId "testRoomId") - resRoom `shouldBe` room - - stopMockServer svr - - it "createEntity for a room sends JSON encoded CreateRoom as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp roomJson req respond - - resRoom <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newRoom - resRoom `shouldBe` room - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/rooms" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newRoom - - stopMockServer svr - - it "createEntithEither for a room sends JSON encoded CreateRoom as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp roomJson req respond - - (Right resRoom) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newRoom - resRoom `shouldBe` room - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/rooms" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newRoom - - stopMockServer svr - - it "updateEntity for a room sends JSON encoded UpdateRoom as its body of PUT request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp roomJson req respond - - resRoom <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateRoom - resRoom `shouldBe` room - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "PUT" - rawPathInfo receivedReq `shouldBe` "/v1/rooms" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just updateRoom - - stopMockServer svr - - it "updateEntityEither for a room sends JSON encoded UpdateRoom as its body of PUT request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp roomJson req respond - - (Right resRoom) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateRoom - resRoom `shouldBe` room - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "PUT" - rawPathInfo receivedReq `shouldBe` "/v1/rooms" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just updateRoom - - stopMockServer svr - - it "deleteRoom sends DELETE request with roomId on URL path" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp "" req respond - - deleteRoom dummyAuth mockBaseRequest (RoomId "testRoomId") - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "DELETE" - rawPathInfo receivedReq `shouldBe` "/v1/rooms/testRoomId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - describe "Membership" $ do - let membershipJson = "{\ - \ \"id\" : \"Y2lzY29zcGFyazovL3VzL01FTUJFUlNISVAvMGQwYzkxYjYtY2U2MC00NzI1LWI2ZDAtMzQ1NWQ1ZDExZWYzOmNkZTFkZDQwLTJmMGQtMTFlNS1iYTljLTdiNjU1NmQyMjA3Yg\",\ - \ \"roomId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ - \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ - \ \"personEmail\" : \"john.andersen@example.com\",\ - \ \"personDisplayName\" : \"John Andersen\",\ - \ \"personOrgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ - \ \"isModerator\" : true,\ - \ \"isMonitor\" : true,\ - \ \"created\" : \"2015-10-18T14:26:16.203Z\"\ - \}" - membership = Membership { membershipId = MembershipId "Y2lzY29zcGFyazovL3VzL01FTUJFUlNISVAvMGQwYzkxYjYtY2U2MC00NzI1LWI2ZDAtMzQ1NWQ1ZDExZWYzOmNkZTFkZDQwLTJmMGQtMTFlNS1iYTljLTdiNjU1NmQyMjA3Yg" - , membershipErrors = Nothing - , membershipRoomId = Just $ RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" - , membershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" - , membershipPersonEmail = Just $ Email "john.andersen@example.com" - , membershipPersonDisplayName = Just $ DisplayName "John Andersen" - , membershipPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" - , membershipIsModerator = Just True - , membershipIsMonitor = Just True - , membershipCreated = Just $ Timestamp "2015-10-18T14:26:16.203Z" - } - membershipGen i = Membership { membershipId = MembershipId . pack $ "membershipId" <> i - , membershipErrors = Nothing - , membershipRoomId = Just . RoomId . pack $ "roomId" <> i - , membershipPersonId = Just . PersonId . pack $ "personId" <> i - , membershipPersonEmail = Just . Email . pack $ "email" <> i <> "@example.com" - , membershipPersonDisplayName = Just . DisplayName . pack $ "displayName" <> i - , membershipPersonOrgId = Just . OrganizationId . pack $ "orgId" <> i - , membershipIsModerator = Just True - , membershipIsMonitor = Just True - , membershipCreated = Just . Timestamp . pack $ "timestamp" <> i - } - membershipList j = [ membershipGen $ j <> show i | i <- [1..3] ] - membershipListList = [ membershipList [c] | c <- ['a'..'d'] ] - newMembership = CreateMembership { createMembershipRoomId = RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" - , createMembershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" - , createMembershipPersonEmail = Just $ Email "john.andersen@example.com" - , createMembershipIsModerator = Just $ True - } - updateMembership = UpdateMembership False - - it "streamMembershipList streams Membership" $ do - let testData = membershipList ['Z'] - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (MembershipList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/memberships" - queryString receivedReq `shouldBe` [] - - stopMockServer svr - - it "streamMembershipList passes query strings build from MembershipFilter to server" $ do - let testData = membershipList ['Z'] - membershipFilter = MembershipFilter (Just $ RoomId "dummyRoomId") - (Just $ PersonId "personIdFilter") - (Just $ Email "personEmailFilter") - - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (MembershipList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest membershipFilter .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/memberships" - (sort . queryString) receivedReq `shouldBe` sort [ ("personId", Just "personIdFilter") - , ("personEmail", Just "personEmailFilter") - , ("roomId", Just "dummyRoomId") ] - - stopMockServer svr - - it "streamMembershipList streams Membership with automatic pagination" $ do - svr <- startMockServer . paginationApp $ encode . MembershipList <$> membershipListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) .| sinkList - res `shouldBe` concat membershipListList - - stopMockServer svr - - it "streamMembershipList stops pagination at invalid Link Header" $ do - svr <- startMockServer . invalidPaginationApp $ encode . MembershipList <$> membershipListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) .| sinkList - res `shouldBe` concat (take 2 membershipListList) - - stopMockServer svr - - it "getDetail for a menbership returns a Membership" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp membershipJson req respond - - resMembership <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (MembershipId "testMembershipId") - resMembership `shouldBe` membership - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "GET" - rawPathInfo receivedReq `shouldBe` "/v1/memberships/testMembershipId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - it "getDetailEither for a membership returns a (Right Membership)" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp membershipJson req respond - (Right resMembership) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (MembershipId "testMembershipId") - resMembership `shouldBe` membership - - stopMockServer svr - - it "createEntity for a membership sends JSON encoded CreateMembership as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp membershipJson req respond - - resMembership <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newMembership - resMembership `shouldBe` membership - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/memberships" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newMembership - - stopMockServer svr - - it "createEntithEither for a membership sends JSON encoded CreateMembership as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp membershipJson req respond - - (Right resMembership) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newMembership - resMembership `shouldBe` membership - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/memberships" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newMembership - - stopMockServer svr - - it "updateEntity for a membership sends JSON encoded UpdateMembership as its body of PUT request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp membershipJson req respond - - resMembership <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateMembership - resMembership `shouldBe` membership - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "PUT" - rawPathInfo receivedReq `shouldBe` "/v1/memberships" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just updateMembership - - stopMockServer svr - - it "updateEntityEither for a membership sends JSON encoded UpdateMembership as its body of PUT request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp membershipJson req respond - - (Right resMembership) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateMembership - resMembership `shouldBe` membership - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "PUT" - rawPathInfo receivedReq `shouldBe` "/v1/memberships" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just updateMembership - - stopMockServer svr - - it "deleteMembership sends DELETE request with membershipId on URL path" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp "" req respond - - deleteMembership dummyAuth mockBaseRequest (MembershipId "testMembershipId") - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "DELETE" - rawPathInfo receivedReq `shouldBe` "/v1/memberships/testMembershipId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - describe "Message" $ do - let messageJson = "{\ - \ \"id\" : \"Y2lzY29zcGFyazovL3VzL01FU1NBR0UvOTJkYjNiZTAtNDNiZC0xMWU2LThhZTktZGQ1YjNkZmM1NjVk\",\ - \ \"roomId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ - \ \"roomType\" : \"group\",\ - \ \"toPersonId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\",\ - \ \"toPersonEmail\" : \"julie@example.com\",\ - \ \"text\" : \"PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W.\",\ - \ \"html\" : \"

HTML formatted message goes here

when the message was posted in markdown format.

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

HTML formatted message goes here

when the message was posted in markdown format.

" - , messageFiles = Just [ FileUrl "http://www.example.com/images/media.png" ] - , messagePersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" - , messagePersonEmail = Just $ Email "matt@example.com" - , messageCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" - , messageMentionedPeople = Just [ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS8yNDlmNzRkOS1kYjhhLTQzY2EtODk2Yi04NzllZDI0MGFjNTM" - , PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS83YWYyZjcyYy0xZDk1LTQxZjAtYTcxNi00MjlmZmNmYmM0ZDg" ] - } - messageGen i = Message { messageId = MessageId . pack $ "messageId" <> i - , messageErrors = Nothing - , messageRoomId = Just . RoomId . pack $ "roomId" <> i - , messageRoomType = Just RoomTypeGroup - , messageToPersonId = Just . PersonId . pack $ "toPersonId" <> i - , messageToPersonEmail = Just . Email . pack $ "julie" <> i <> "@example.com" - , messageText = Just . MessageText . pack $ "messageText" <> i - , messageHtml = Just . MessageHtml . pack $ "messageHtml" <> i - , messageFiles = Just [ FileUrl . pack $ "http://www.example.com/images/media" <> i <> ".png" ] - , messagePersonId = Just . PersonId . pack $ "personId" <> i - , messagePersonEmail = Just . Email . pack $ "matt" <> i <> "@example.com" - , messageCreated = Just . Timestamp . pack $ "created" <> i - , messageMentionedPeople = Just [ PersonId . pack $ "memtionedPeople1-" <> i - , PersonId . pack $ "memtionedPeople2-" <> i ] - } - messageList j = [ messageGen $ j <> show i | i <- [1..3] ] - messageListList = [ messageList [c] | c <- ['a'..'d'] ] - defFilter = defaultMessageFilter $ RoomId "dummyRoomId" - newMessage = CreateMessage { createMessageRoomId = Just $ RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" - , createMessageToPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX" - , createMessageToPersonEmail = Just $ Email "julie@example.com" - , createMessageText = Just $ MessageText "PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W." - , createMessageMarkdown = Just $ MessageMarkdown "**PROJECT UPDATE** A new project plan has been published [on Box](http://box.com/s/lf5vj). The PM for this project is <@personEmail:mike@example.com> and the Engineering Manager is <@personEmail:jane@example.com>." - , createMessageFiles = Just $ [ FileUrl "http://www.example.com/images/media.png" ] - } - - it "streamMessageList streams Message" $ do - let testData = messageList ['Z'] - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (MessageList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/messages" - queryString receivedReq `shouldBe` [ ("roomId", Just "dummyRoomId") ] - - stopMockServer svr - - it "streamMessageList passes query strings build from MessageFilter to server" $ do - let testData = messageList ['Z'] - messageFilter = MessageFilter (RoomId "dummyRoomId") - (Just $ MentionedPeopleMe) - (Just $ Timestamp "beforeFilter") - (Just $ MessageId "beforeMessageFilter") - - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (MessageList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest messageFilter .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/messages" - (sort . queryString) receivedReq `shouldBe` sort [ ("roomId", Just "dummyRoomId") - , ("mentionedPeople", Just "me") - , ("beforeMessage", Just "beforeMessageFilter") - , ("before", Just "beforeFilter") ] - - stopMockServer svr - - it "streamMessageList streams Message with automatic pagination" $ do - svr <- startMockServer . paginationApp $ encode . MessageList <$> messageListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList - res `shouldBe` concat messageListList - - stopMockServer svr - - it "streamMessageList stops pagination at invalid Link Header" $ do - svr <- startMockServer . invalidPaginationApp $ encode . MessageList <$> messageListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList - res `shouldBe` concat (take 2 messageListList) - - stopMockServer svr - - it "getDetail for a message returns a Message" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp messageJson req respond - - resMessage <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (MessageId "testMessageId") - resMessage `shouldBe` message - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "GET" - rawPathInfo receivedReq `shouldBe` "/v1/messages/testMessageId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - it "getDetailEither for a message returns a (Right Message)" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp messageJson req respond - (Right resMessage) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (MessageId "testMessageId") - resMessage `shouldBe` message - - stopMockServer svr - - it "createEntity for a message sends JSON encoded CreateMessage as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp messageJson req respond - - resMessage <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newMessage - resMessage `shouldBe` message - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/messages" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newMessage - - stopMockServer svr - - it "createEntithEither for a message sends JSON encoded CreateMessage as its body of POST request" $ do - receivedReqMVar <- newEmptyMVar - receivedBodyMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - strictRequestBody req >>= putMVar receivedBodyMVar - simpleApp messageJson req respond - - (Right resMessage) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newMessage - resMessage `shouldBe` message - - receivedReq <- takeMVar receivedReqMVar - receivedBody <- takeMVar receivedBodyMVar - requestMethod receivedReq `shouldBe` "POST" - rawPathInfo receivedReq `shouldBe` "/v1/messages" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - decode receivedBody `shouldBe` Just newMessage - - stopMockServer svr - - it "deleteMessage sends DELETE request with messageId on URL path" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp "" req respond - - deleteMessage dummyAuth mockBaseRequest (MessageId "testMessageId") - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "DELETE" - rawPathInfo receivedReq `shouldBe` "/v1/messages/testMessageId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - describe "Organization" $ do - let organizationJson = "{\ - \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ - \ \"displayName\" : \"Cisco, Inc.\",\ - \ \"created\" : \"2015-10-18T14:26:16+00:00\"\ - \}" - organization = Organization { organizationId = OrganizationId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" - , organizationErrors = Nothing - , organizationDisplayName = Just $ OrganizationDisplayName "Cisco, Inc." - , organizationCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" - } - organizationGen i = Organization { organizationId = OrganizationId . pack $ "organizationId" <> i - , organizationErrors = Nothing - , organizationDisplayName = Just $ OrganizationDisplayName . pack $ "displayName" <> i - , organizationCreated = Just $ Timestamp . pack $ "timestamp" <> i - } - organizationList j = [ organizationGen $ j <> show i | i <- [1..3] ] - organizationListList = [ organizationList [c] | c <- ['a'..'d'] ] - - it "streamOrganizationList streams Organization" $ do - let testData = organizationList ['Z'] - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (OrganizationList testData)) req respond - - res <- runConduit $ streamOrganizationList dummyAuth mockBaseRequest .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/organizations" - queryString receivedReq `shouldBe` [] - - stopMockServer svr - - it "streamOrganizationList streams Organization with automatic pagination" $ do - svr <- startMockServer . paginationApp $ encode . OrganizationList <$> organizationListList - - res <- runConduit $ streamOrganizationList dummyAuth mockBaseRequest .| sinkList - res `shouldBe` concat organizationListList - - stopMockServer svr - - it "streamOrganizationList stops pagination at invalid Link Header" $ do - svr <- startMockServer . invalidPaginationApp $ encode . OrganizationList <$> organizationListList - - res <- runConduit $ streamOrganizationList dummyAuth mockBaseRequest .| sinkList - res `shouldBe` concat (take 2 organizationListList) - - stopMockServer svr - - it "getDetail for an organization returns a Organization" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp organizationJson req respond - - resOrganization <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (OrganizationId "testOrganizationId") - resOrganization `shouldBe` organization - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "GET" - rawPathInfo receivedReq `shouldBe` "/v1/organizations/testOrganizationId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - it "getDetailEither for an organization returns a (Right Organization)" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp organizationJson req respond - (Right resOrganization) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (OrganizationId "testOrganizationId") - resOrganization `shouldBe` organization - - stopMockServer svr - - describe "License" $ do - let licenseJson = "{\ - \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ - \ \"name\" : \"Spark Calling\",\ - \ \"totalUnits\" : 42,\ - \ \"consumedUnits\" : 8\ - \}" - license = License { licenseId = LicenseId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" - , licenseErrors = Nothing - , licenseName = Just $ LicenseName "Spark Calling" - , licenseTotalUnits = Just $ LicenseUnit 42 - , licenseConsumedUnits = Just $ LicenseUnit 8 - } - licenseGen i = License { licenseId = LicenseId . pack $ "licenseId" <> i - , licenseErrors = Nothing - , licenseName = Just $ LicenseName . pack $ "licenseName" <> i - , licenseTotalUnits = Just $ LicenseUnit 42 - , licenseConsumedUnits = Just $ LicenseUnit 8 - } - licenseList j = [ licenseGen $ j <> show i | i <- [1..3] ] - licenseListList = [ licenseList [c] | c <- ['a'..'d'] ] - - it "streamLicenseList streams License" $ do - let testData = licenseList ['Z'] - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (LicenseList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/licenses" - queryString receivedReq `shouldBe` [] - - stopMockServer svr - - it "streamLicenseList passes query strings build from LicenseFilter to server" $ do - let testData = licenseList ['Z'] - licenseFilter = LicenseFilter (Just $ OrganizationId "orgIdFilter") - - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (LicenseList testData)) req respond - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest licenseFilter .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/licenses" - queryString receivedReq `shouldBe` [ ("orgId", Just "orgIdFilter") ] - - stopMockServer svr - - it "streamLicenseList streams License with automatic pagination" $ do - svr <- startMockServer . paginationApp $ encode . LicenseList <$> licenseListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) .| sinkList - res `shouldBe` concat licenseListList - - stopMockServer svr - - it "streamLicenseList stops pagination at invalid Link Header" $ do - svr <- startMockServer . invalidPaginationApp $ encode . LicenseList <$> licenseListList - - res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) .| sinkList - res `shouldBe` concat (take 2 licenseListList) - - stopMockServer svr - - it "getDetail for a license returns a License" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp licenseJson req respond - - resLicense <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (LicenseId "testLicenseId") - resLicense `shouldBe` license - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "GET" - rawPathInfo receivedReq `shouldBe` "/v1/licenses/testLicenseId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - it "getDetailEither for a license returns a (Right License)" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp licenseJson req respond - (Right resLicense) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (LicenseId "testLicenseId") - resLicense `shouldBe` license - - stopMockServer svr - - describe "Role" $ do - let roleJson = "{\ - \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ - \ \"name\" : \"Full Administrator\"\ - \}" - role = Role { roleId = RoleId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" - , roleErrors = Nothing - , roleName = Just $ RoleName "Full Administrator" - } - roleGen i = Role { roleId = RoleId . pack $ "roleId" <> i - , roleErrors = Nothing - , roleName = Just . RoleName . pack $ "roleName" <> i - } - roleList j = [ roleGen $ j <> show i | i <- [1..3] ] - roleListList = [ roleList [c] | c <- ['a'..'d'] ] - - it "streamRoleList streams Role" $ do - let testData = roleList ['Z'] - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp (encode (RoleList testData)) req respond - - res <- runConduit $ streamRoleList dummyAuth mockBaseRequest .| sinkList - res `shouldBe` testData - - receivedReq <- takeMVar receivedReqMVar - rawPathInfo receivedReq `shouldBe` "/v1/roles" - queryString receivedReq `shouldBe` [] - - stopMockServer svr - - it "streamRoleList streams Role with automatic pagination" $ do - svr <- startMockServer . paginationApp $ encode . RoleList <$> roleListList - - res <- runConduit $ streamRoleList dummyAuth mockBaseRequest .| sinkList - res `shouldBe` concat roleListList - - stopMockServer svr - - it "streamRoleList stops pagination at invalid Link Header" $ do - svr <- startMockServer . invalidPaginationApp $ encode . RoleList <$> roleListList - - res <- runConduit $ streamRoleList dummyAuth mockBaseRequest .| sinkList - res `shouldBe` concat (take 2 roleListList) - - stopMockServer svr - - it "getDetail for a role returns a Role" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp roleJson req respond - - resRole <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (RoleId "testRoleId") - resRole `shouldBe` role - - receivedReq <- takeMVar receivedReqMVar - requestMethod receivedReq `shouldBe` "GET" - rawPathInfo receivedReq `shouldBe` "/v1/roles/testRoleId" - (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" - (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" - - stopMockServer svr - - it "getDetailEither for a role returns a (Right Role)" $ do - receivedReqMVar <- newEmptyMVar - - svr <- startMockServer $ \req respond -> do - putMVar receivedReqMVar req - simpleApp roleJson req respond - (Right resRole) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (RoleId "testRoleId") - resRole `shouldBe` role - - stopMockServer svr +{-# LANGUAGE OverloadedStrings #-} + +module Network.CiscoSparkSpec where + +import Conduit +import Control.Concurrent.Async (withAsync) +import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, + takeMVar) +import Control.Monad (void) +import Data.Aeson (decode, encode) +import Data.Attoparsec.ByteString (parseOnly) +import qualified Data.ByteString as S (ByteString) +import qualified Data.ByteString.Char8 as C8 (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 Network.CiscoSpark +import Network.CiscoSpark.Internal (LinkHeader (..), LinkParam (..), + getNextUrl, linkHeader) + + +import Data.Typeable (typeOf) + + +mockBaseRequestRequest + = C.addRequestHeader "Content-Type" "application/json; charset=utf-8" + $ C.setRequestPort 3000 + $ C.setRequestHost "127.0.0.1" + $ C.setRequestSecure False + $ C.defaultRequest + +mockBaseRequest :: CiscoSparkRequest +mockBaseRequest = CiscoSparkRequest mockBaseRequestRequest "http:" $ URIAuth "" "127.0.0.1" ":3000" + +dummyAuth :: Authorization +dummyAuth = Authorization "dummyAuth" + +extractRight :: Show err => Either err r -> r +extractRight (Right r) = r +extractRight (Left err) = error $ show err + +withMockServer :: Application -> IO () -> IO () +withMockServer app inner = do + readyToConnect <- newEmptyMVar + let set = setBeforeMainLoop (putMVar readyToConnect ()) defaultSettings + withAsync (runSettings set app) (\_ -> takeMVar readyToConnect >> inner) + +helloApp :: Application +helloApp _ respond = respond $ responseLBS status200 [] "hello, world" + +contentType :: Header +contentType = ("Content-Type", "application/json; charset=utf-8") + +simpleApp :: L.ByteString -> Application +simpleApp res _ respond = respond $ responseLBS status200 [contentType] res + +paginationApp :: [L.ByteString] -> Application +paginationApp ress req respond = do + let (cTypes, body) = dispatch $ rawPathInfo req + respond $ responseLBS status200 cTypes body + where + dispatch "/1" = ([contentType, ("Link", "; rel=\"next\"")], ress !! 1) + dispatch "/2" = ([contentType, ("Link", "; rel=\"next\"")], ress !! 2) + dispatch "/3" = ([contentType], ress !! 3) + dispatch _ = ([contentType, ("Link", "; rel=\"next\"")], ress !! 0) + +invalidPaginationApp :: [L.ByteString] -> Application +invalidPaginationApp ress req respond = do + let (cTypes, body) = dispatch $ rawPathInfo req + respond $ responseLBS status200 cTypes body + where + dispatch "/1" = ([contentType, ("Link", "; rel=\"next\"")], ress !! 1) + dispatch "/2" = ([contentType, ("Link", "; rel=\"next\"")], ress !! 2) + dispatch "/3" = ([contentType], ress !! 3) + dispatch _ = ([contentType, ("Link", "; rel=\"next\"")], ress !! 0) + + +teamGen :: String -> Team +teamGen i = Team { teamId = TeamId . pack $ "teamId" <> i + , teamErrors = Nothing + , teamName = Just . TeamName . pack $ "teamName" <> i + , teamCreatorId = Just . PersonId . pack $ "teamCreatorId" <> i + , teamCreated = Just . Timestamp . pack $ "teamCreated" <> i + } + +teamList :: String -> [Team] +teamList j = [ teamGen $ j <> show i | i <- [1..3] ] + +teamListList :: [[Team]] +teamListList = [ teamList [c] | c <- ['a'..'d'] ] + +spec :: Spec +spec = do + describe "Mock Applications" $ do + it "simple mock app returns list of team" $ do + receivedReqMVar <- newEmptyMVar + let (CiscoSparkRequest baseReq _ _) = mockBaseRequest + req = setRequestPath "/v1/teams" + $ setRequestMethod "GET" + $ baseReq + testData = TeamList $ teamList ['Z'] + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode testData) req respond + ) $ do + res <- getResponseBody <$> httpJSON req + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/teams" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "pagenation mock app returns list of team and Link header" $ do + receivedReqMVar <- newEmptyMVar + let (CiscoSparkRequest baseReq _ _) = mockBaseRequest + req = setRequestPath "/v1/teams" + $ setRequestMethod "GET" + $ baseReq + testData = encode . TeamList <$> teamListList + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + paginationApp testData req respond + ) $ do + res1 <- httpJSON req + getResponseBody res1 `shouldBe` TeamList (teamListList !! 0) + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/teams" + + let path = getNextUrl res1 + path `shouldBe` Just "http://127.0.0.1:3000/1" + + req2 <- parseRequest $ "GET " <> C8.unpack (fromJust path) + res2 <- httpJSON req2 + getResponseBody res2 `shouldBe` TeamList (teamListList !! 1) + + describe "People" $ do + let personJson1 = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"emails\" : [ \"johnny.chang@foomail.com\", \"jchang@barmail.com\" ],\ + \ \"displayName\" : \"John Andersen\",\ + \ \"firstName\" : \"John\",\ + \ \"lastName\" : \"Andersen\",\ + \ \"avatar\" : \"https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600\",\ + \ \"orgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"roles\" : [ \"Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\" ],\ + \ \"licenses\" : [ \"Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy\", \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\" ],\ + \ \"created\" : \"2015-10-18T14:26:16.000Z\",\ + \ \"timezone\" : \"America/Denver\",\ + \ \"lastActivity\" : \"2015-10-18T14:26:16.028Z\",\ + \ \"status\" : \"active\",\ + \ \"invitePending\" : false,\ + \ \"loginEnabled\" : true\ + \}" + person1 = Person { personId = PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , personErrors = Nothing + , personEmails = Just [Email "johnny.chang@foomail.com", Email "jchang@barmail.com"] + , personDisplayName = Just $ DisplayName "John Andersen" + , personNickName = Nothing + , personFirstName = Just $ FirstName "John" + , personLastName = Just $ LastName "Andersen" + , personAvatar = Just $ AvatarUrl "https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600" + , personOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , personRoles = Just [ RoleId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , RoleId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] + , personLicenses = Just [ LicenseId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , LicenseId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] + , personCreated = Just $ Timestamp "2015-10-18T14:26:16.000Z" + , personTimezone = Just $ Timezone "America/Denver" + , personLastActivity = Just $ Timestamp "2015-10-18T14:26:16.028Z" + , personStatus = Just PersonStatusActive + , personInvitePending = Just False + , personLoginEnabled = Just True + , personType = Nothing + } + personGen i = Person { personId = PersonId . pack $ "PersonId" <> i + , personErrors = Nothing + , personEmails = Just [Email . pack $ "email" <> i <> "@foomail.com", Email . pack $ "email" <> i <> "@barmail.com"] + , personDisplayName = Just . DisplayName . pack $ "John Andersen" <> i + , personNickName = Nothing + , personFirstName = Just $ FirstName . pack $ "John" <> i + , personLastName = Just $ LastName . pack $ "Andersen" <> i + , personAvatar = Just $ AvatarUrl . pack $ "https://AvatarUrl" <> i + , personOrgId = Just . OrganizationId . pack $ "OrganizationId" <> i + , personRoles = Just [ RoleId . pack $ "RoleIdA" <> i + , RoleId . pack $ "RoleIdB" <> i] + , personLicenses = Just [ LicenseId . pack $ "LicenseIdX" <> i + , LicenseId . pack $ "LicenseIdY" <> i] + , personCreated = Just . Timestamp . pack $ "Created" <> i + , personTimezone = Just $ Timezone . pack $ "Timezone" <> i + , personLastActivity = Just $ Timestamp . pack $ "LastActivity" <> i + , personStatus = Just PersonStatusActive + , personInvitePending = Just False + , personLoginEnabled = Just True + , personType = Nothing + } + personList j = [ personGen $ j <> show i | i <- [1..3] ] + personListList = [ personList [c] | c <- ['a'..'d'] ] + newPerson = CreatePerson { createPersonEmails = Just $ [Email "johnny.chang@foomail.com", Email "jchang@barmail.com"] + , createPersonDisplayName = Just $ DisplayName "John Andersen" + , createPersonFirstName = Just $ FirstName "John" + , createPersonLastName = Just $ LastName "Andersen" + , createPersonAvatar = Just $ AvatarUrl "https://1efa7a94ed21783e352-c62266528714497a17239ececf39e9e2.ssl.cf1.rackcdn.com/V1~54c844c89e678e5a7b16a306bc2897b9~wx29yGtlTpilEFlYzqPKag==~1600" + , createPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , createPersonRoles = Just [ RoleId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , RoleId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] + , createPersonLicenses = Just [ LicenseId "Y2lzY29zcGFyazovL3VzL1JPT00vOGNkYzQwYzQtZjA5ZS0zY2JhLThjMjYtZGQwZTcwYWRlY2Iy" + , LicenseId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX"] + } + updatePerson = UpdatePerson { updatePersonDisplayName = Just $ DisplayName "New John Andersen" + , updatePersonFirstName = Just $ FirstName "New John" + , updatePersonLastName = Just $ LastName "New Andersen" + , updatePersonAvatar = Just $ AvatarUrl "https://example.com/newAvatarUrl" + , updatePersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , updatePersonRoles = Just $ [ RoleId "newRoleId1", RoleId "newRoleId2" ] + , updatePersonLicenses = Just $ [ LicenseId "newLicenseId1", LicenseId "newLicenseId2" ] + } + + it "streamPersonList streams Team" $ do + let testData = personList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (PersonList testData)) req respond + ) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/people" + queryString receivedReq `shouldBe` [] + + 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 + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (PersonList testData)) req respond + ) $ do + 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") ] + + it "streamPersonList streams Team with automatic pagination" $ do + withMockServer (paginationApp $ encode . PersonList <$> personListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) .| sinkList + res `shouldBe` concat personListList + + it "streamPersonList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . PersonList <$> personListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: PersonFilter) .| sinkList + res `shouldBe` concat (take 2 personListList) + + it "getDetail for a person returns a Person" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp personJson1 req respond + ) $ do + resPerson <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (PersonId "testPersonId") + resPerson `shouldBe` person1 + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/people/testPersonId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a person returns a (Right Person)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp personJson1 req respond + ) $ do + (Right resPerson) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (PersonId "testPersonId") + resPerson `shouldBe` person1 + + it "createEntity for a person sends JSON encoded CreatePerson as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + ) $ do + resPerson <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newPerson + resPerson `shouldBe` person1 + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/people" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newPerson + + it "createEntityEither for a person sends JSON encoded CreatePerson as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + ) $ do + (Right resPerson) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newPerson + resPerson `shouldBe` person1 + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/people" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newPerson + + it "updateEntity for a person sends JSON encoded UpdatePerson as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + ) $ do + resPerson <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updatePerson + resPerson `shouldBe` person1 + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/people" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updatePerson + + it "updateEntityEither for a person sends JSON encoded UpdatePerson as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp personJson1 req respond + ) $ do + (Right resPerson) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updatePerson + resPerson `shouldBe` person1 + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/people" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updatePerson + + describe "Team" $ do + let teamJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ + \ \"name\" : \"Build Squad\",\ + \ \"creatorId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"created\" : \"2015-10-18T14:26:16+00:00\"\ + \}" + team = Team { teamId = TeamId "Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" + , teamErrors = Nothing + , teamName = Just $ TeamName "Build Squad" + , teamCreatorId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , teamCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + } + newTeam = CreateTeam $ TeamName "Build Squad" + updateTeam = UpdateTeam $ TeamName "updatedTeamName" + + it "streamTeamList streams Team" $ do + let testData = teamList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (TeamList testData)) req respond + ) $ do + res <- runConduit $ streamTeamList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` testData + path <- rawPathInfo <$> takeMVar receivedReqMVar + path `shouldBe` "/v1/teams" + + it "streamTeamList streams Team with automatic pagination" $ do + withMockServer (paginationApp $ encode . TeamList <$> teamListList) $ do + res <- runConduit $ streamTeamList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat teamListList + + it "streamTeamList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . TeamList <$> teamListList) $ do + res <- runConduit $ streamTeamList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat (take 2 teamListList) + + it "getDetail for a team returns a Team" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp teamJson req respond + ) $ do + resTeam <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (TeamId "testTeamId") + resTeam `shouldBe` team + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/teams/testTeamId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a team returns a (Right Team)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp teamJson req respond + ) $ do + (Right resTeam) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (TeamId "testTeamId") + resTeam `shouldBe` team + + it "createEntity for a team sends JSON encoded CreateTeam as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + ) $ do + resTeam <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newTeam + resTeam `shouldBe` team + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/teams" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newTeam + + it "createEntityEither for a team sends JSON encoded CreateTeam as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + ) $ do + (Right resTeam) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newTeam + resTeam `shouldBe` team + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/teams" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newTeam + + it "updateEntity for a team sends JSON encoded UpdateTeam as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + ) $ do + resTeam <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateTeam + resTeam `shouldBe` team + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/teams" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateTeam + + it "updateEntityEither for a team sends JSON encoded UpdateTeam as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamJson req respond + ) $ do + (Right resTeam) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateTeam + resTeam `shouldBe` team + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/teams" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateTeam + + it "deleteTeam sends DELETE request with teamId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + ) $ do + deleteTeam dummyAuth mockBaseRequest (TeamId "testTeamId") + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "DELETE" + rawPathInfo receivedReq `shouldBe` "/v1/teams/testTeamId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + describe "TeamMemberShip" $ do + let teamMembershipJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1RFQU1fTUVNQkVSU0hJUC8wZmNmYTJiOC1hZGNjLTQ1ZWEtYTc4Mi1lNDYwNTkyZjgxZWY6MTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ + \ \"teamId\" : \"Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5\",\ + \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"personEmail\" : \"john.andersen@example.com\",\ + \ \"personDisplayName\" : \"John Andersen\",\ + \ \"personOrgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"isModerator\" : true,\ + \ \"created\" : \"2015-10-18T14:26:16.057Z\"\ + \}" + teamMembership = TeamMembership { teamMembershipId = TeamMembershipId "Y2lzY29zcGFyazovL3VzL1RFQU1fTUVNQkVSU0hJUC8wZmNmYTJiOC1hZGNjLTQ1ZWEtYTc4Mi1lNDYwNTkyZjgxZWY6MTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" + , teamMembershipErrors = Nothing + , teamMembershipTeamId = Just $ TeamId "Y2lzY29zcGFyazovL3VzL1RFQU0vMTNlMThmNDAtNDJmYy0xMWU2LWE5ZDgtMjExYTBkYzc5NzY5" + , teamMembershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , teamMembershipPersonEmail = Just $ Email "john.andersen@example.com" + , teamMembershipPersonDisplayName = Just $ DisplayName "John Andersen" + , teamMembershipPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , teamMembershipIsModerator = Just True + , teamMembershipCreated = Just $ Timestamp "2015-10-18T14:26:16.057Z" + } + teamMembershipGen i = TeamMembership { teamMembershipId = TeamMembershipId . pack $ "teamMembershipId" <> i + , teamMembershipErrors = Nothing + , teamMembershipTeamId = Just . TeamId . pack $ "teamId" <> i + , teamMembershipPersonId = Just . PersonId . pack $ "personId" <> i + , teamMembershipPersonEmail = Just . Email . pack $ "email" <> i <> "@example.com" + , teamMembershipPersonDisplayName = Just . DisplayName . pack $ "DisplayName" <> i + , teamMembershipPersonOrgId = Just . OrganizationId . pack $ "OrganizationId" <> i + , teamMembershipIsModerator = Just True + , teamMembershipCreated = Just . Timestamp . pack $ "Timestamp" <> i + } + teamMembershipList j = [ teamMembershipGen $ j <> show i | i <- [1..3] ] + teamMembershipListList = [ teamMembershipList [c] | c <- ['a'..'d'] ] + defFilter = defaultTeamMembershipFilter $ TeamId "dummyTeamId" + newTeamMembership = CreateTeamMembership { createTeamMembershipTeamId = TeamId "targetTeam" + , createTeamMembershipPersonId = Just $ PersonId "addedPerson" + , createTeamMembershipPersonEmail = Just $ Email "added@example.com" + , createTeamMembershipIsModerator = Just True + } + updateTeamMembership = UpdateTeamMembership False + + it "streamTeamMembershipList streams TeamMembership" $ do + let testData = teamMembershipList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (TeamMembershipList testData)) req respond + ) $ do + 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") ] + + it "streamMembershipList passes query strings build from TeamMembershipFilter to server" $ do + let testData = teamMembershipList ['Z'] + teamMembershipFilter = TeamMembershipFilter $ TeamId "DummyTeamId" + + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (TeamMembershipList testData)) req respond + ) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest teamMembershipFilter .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + queryString receivedReq `shouldBe` [ ("teamId", Just "DummyTeamId") ] + + it "streamTeamMembershipList streams TeamMembership with automatic pagination" $ do + withMockServer (paginationApp $ encode . TeamMembershipList <$> teamMembershipListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` concat teamMembershipListList + + it "streamTeamMembershipList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . TeamMembershipList <$> teamMembershipListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` concat (take 2 teamMembershipListList) + + it "getDetail for a team membership returns a TeamMembership" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp teamMembershipJson req respond + ) $ do + resTeamMembership <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (TeamMembershipId "testTeamMembershipId") + resTeamMembership `shouldBe` teamMembership + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships/testTeamMembershipId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a team membership returns a (Right TeamMembership)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp teamMembershipJson req respond + ) $ do + (Right resTeamMembership) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (TeamMembershipId "testTeamMembershipId") + resTeamMembership `shouldBe` teamMembership + + it "createEntity for a team membership sends JSON encoded CreateTeamMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + ) $ do + resTeamMembership <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newTeamMembership + resTeamMembership `shouldBe` teamMembership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newTeamMembership + + it "createEntityEither for a team membership sends JSON encoded CreateTeamMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + ) $ do + (Right resTeamMembership) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newTeamMembership + resTeamMembership `shouldBe` teamMembership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newTeamMembership + + it "updateEntity for a teamMembership sends JSON encoded UpdateTeamMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + ) $ do + resTeamMembership <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateTeamMembership + resTeamMembership `shouldBe` teamMembership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateTeamMembership + + it "updateEntityEither for a teamMembership sends JSON encoded UpdateTeamMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp teamMembershipJson req respond + ) $ do + (Right resTeamMembership) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateTeamMembership + resTeamMembership `shouldBe` teamMembership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateTeamMembership + + it "deleteTeamMembership sends DELETE request with teamMembershipId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + ) $ do + deleteTeamMembership dummyAuth mockBaseRequest (TeamMembershipId "testTeamMembershipId") + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "DELETE" + rawPathInfo receivedReq `shouldBe` "/v1/team/memberships/testTeamMembershipId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + describe "Room" $ do + let roomJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"title\" : \"Project Unicorn - Sprint 0\",\ + \ \"type\" : \"group\",\ + \ \"isLocked\" : true,\ + \ \"sipAddress\" : \"01234567890@meet.ciscospark.com\",\ + \ \"teamId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz\",\ + \ \"lastActivity\" : \"2016-04-21T19:12:48.920Z\",\ + \ \"creatorId\": \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"created\" : \"2016-04-21T19:01:55.966Z\"\ + \}" + room = Room { roomId = RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , roomErrors = Nothing + , roomTitle = Just $ RoomTitle "Project Unicorn - Sprint 0" + , roomType = Just RoomTypeGroup + , roomIsLocked = Just True + , roomSipAddress = Just $ SipAddr "01234567890@meet.ciscospark.com" + , roomLastActivity = Just $ Timestamp "2016-04-21T19:12:48.920Z" + , roomTeamId = Just $ TeamId "Y2lzY29zcGFyazovL3VzL1JPT00vNjRlNDVhZTAtYzQ2Yi0xMWU1LTlkZjktMGQ0MWUzNDIxOTcz" + , roomCreatorId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , roomCreated = Just $ Timestamp "2016-04-21T19:01:55.966Z" + } + roomGen i = Room { roomId = RoomId . pack $ "roomId" <> i + , roomErrors = Nothing + , roomTitle = Just . RoomTitle . pack $ "roomTitle" <> i + , roomType = Just RoomTypeGroup + , roomIsLocked = Just True + , roomSipAddress = Just $ SipAddr . pack $ "rooomSipAddress" <> i <> "@meet.ciscospark.com" + , roomLastActivity = Just . Timestamp . pack $ "roomLastActivity" <> i + , roomTeamId = Just $ TeamId . pack $ "roomTeamId" <> i + , roomCreatorId = Just . PersonId . pack $ "personId" <> i + , roomCreated = Just .Timestamp .pack $ "roomCreated" <> i + } + roomList j = [ roomGen $ j <> show i | i <- [1..3] ] + roomListList = [ roomList [c] | c <- ['a'..'d'] ] + newRoom = CreateRoom (RoomTitle "New Room") (Just $ TeamId "belongingTeam") + updateRoom = UpdateRoom $ RoomTitle "updatedRoomTitle" + + it "streamRoomList streams Room" $ do + let testData = roomList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (RoomList testData)) req respond + ) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + queryString receivedReq `shouldBe` [] + + 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 + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (RoomList testData)) req respond + ) $ do + 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") ] + + it "streamRoomList streams Room with automatic pagination" $ do + withMockServer (paginationApp $ encode . RoomList <$> roomListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) .| sinkList + res `shouldBe` concat roomListList + + it "streamRoomList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . RoomList <$> roomListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: RoomFilter) .| sinkList + res `shouldBe` concat (take 2 roomListList) + + it "getDetail for a room returns a Room" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp roomJson req respond + ) $ do + resRoom <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (RoomId "testRoomId") + resRoom `shouldBe` room + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/rooms/testRoomId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a room returns a (Right Room)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp roomJson req respond + ) $ do + (Right resRoom) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (RoomId "testRoomId") + resRoom `shouldBe` room + + it "createEntity for a room sends JSON encoded CreateRoom as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + ) $ do + resRoom <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newRoom + resRoom `shouldBe` room + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newRoom + + it "createEntithEither for a room sends JSON encoded CreateRoom as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + ) $ do + (Right resRoom) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newRoom + resRoom `shouldBe` room + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newRoom + + it "updateEntity for a room sends JSON encoded UpdateRoom as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + ) $ do + resRoom <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateRoom + resRoom `shouldBe` room + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateRoom + + it "updateEntityEither for a room sends JSON encoded UpdateRoom as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp roomJson req respond + ) $ do + (Right resRoom) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateRoom + resRoom `shouldBe` room + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/rooms" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateRoom + + it "deleteRoom sends DELETE request with roomId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + ) $ do + deleteRoom dummyAuth mockBaseRequest (RoomId "testRoomId") + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "DELETE" + rawPathInfo receivedReq `shouldBe` "/v1/rooms/testRoomId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + describe "Membership" $ do + let membershipJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL01FTUJFUlNISVAvMGQwYzkxYjYtY2U2MC00NzI1LWI2ZDAtMzQ1NWQ1ZDExZWYzOmNkZTFkZDQwLTJmMGQtMTFlNS1iYTljLTdiNjU1NmQyMjA3Yg\",\ + \ \"roomId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"personId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY\",\ + \ \"personEmail\" : \"john.andersen@example.com\",\ + \ \"personDisplayName\" : \"John Andersen\",\ + \ \"personOrgId\" : \"Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE\",\ + \ \"isModerator\" : true,\ + \ \"isMonitor\" : true,\ + \ \"created\" : \"2015-10-18T14:26:16.203Z\"\ + \}" + membership = Membership { membershipId = MembershipId "Y2lzY29zcGFyazovL3VzL01FTUJFUlNISVAvMGQwYzkxYjYtY2U2MC00NzI1LWI2ZDAtMzQ1NWQ1ZDExZWYzOmNkZTFkZDQwLTJmMGQtMTFlNS1iYTljLTdiNjU1NmQyMjA3Yg" + , membershipErrors = Nothing + , membershipRoomId = Just $ RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , membershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , membershipPersonEmail = Just $ Email "john.andersen@example.com" + , membershipPersonDisplayName = Just $ DisplayName "John Andersen" + , membershipPersonOrgId = Just $ OrganizationId "Y2lzY29zcGFyazovL3VzL09SR0FOSVpBVElPTi85NmFiYzJhYS0zZGNjLTExZTUtYTE1Mi1mZTM0ODE5Y2RjOWE" + , membershipIsModerator = Just True + , membershipIsMonitor = Just True + , membershipCreated = Just $ Timestamp "2015-10-18T14:26:16.203Z" + } + membershipGen i = Membership { membershipId = MembershipId . pack $ "membershipId" <> i + , membershipErrors = Nothing + , membershipRoomId = Just . RoomId . pack $ "roomId" <> i + , membershipPersonId = Just . PersonId . pack $ "personId" <> i + , membershipPersonEmail = Just . Email . pack $ "email" <> i <> "@example.com" + , membershipPersonDisplayName = Just . DisplayName . pack $ "displayName" <> i + , membershipPersonOrgId = Just . OrganizationId . pack $ "orgId" <> i + , membershipIsModerator = Just True + , membershipIsMonitor = Just True + , membershipCreated = Just . Timestamp . pack $ "timestamp" <> i + } + membershipList j = [ membershipGen $ j <> show i | i <- [1..3] ] + membershipListList = [ membershipList [c] | c <- ['a'..'d'] ] + newMembership = CreateMembership { createMembershipRoomId = RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , createMembershipPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , createMembershipPersonEmail = Just $ Email "john.andersen@example.com" + , createMembershipIsModerator = Just $ True + } + updateMembership = UpdateMembership False + + it "streamMembershipList streams Membership" $ do + let testData = membershipList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MembershipList testData)) req respond + ) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + queryString receivedReq `shouldBe` [] + + 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 + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MembershipList testData)) req respond + ) $ do + 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") ] + + it "streamMembershipList streams Membership with automatic pagination" $ do + withMockServer (paginationApp $ encode . MembershipList <$> membershipListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) .| sinkList + res `shouldBe` concat membershipListList + + it "streamMembershipList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . MembershipList <$> membershipListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: MembershipFilter) .| sinkList + res `shouldBe` concat (take 2 membershipListList) + + it "getDetail for a menbership returns a Membership" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp membershipJson req respond + ) $ do + resMembership <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (MembershipId "testMembershipId") + resMembership `shouldBe` membership + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/memberships/testMembershipId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a membership returns a (Right Membership)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp membershipJson req respond + ) $ do + (Right resMembership) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (MembershipId "testMembershipId") + resMembership `shouldBe` membership + + it "createEntity for a membership sends JSON encoded CreateMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + ) $ do + resMembership <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newMembership + resMembership `shouldBe` membership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newMembership + + it "createEntithEither for a membership sends JSON encoded CreateMembership as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + ) $ do + (Right resMembership) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newMembership + resMembership `shouldBe` membership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newMembership + + it "updateEntity for a membership sends JSON encoded UpdateMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + ) $ do + resMembership <- getResponseBody <$> updateEntity dummyAuth mockBaseRequest updateMembership + resMembership `shouldBe` membership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateMembership + + it "updateEntityEither for a membership sends JSON encoded UpdateMembership as its body of PUT request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp membershipJson req respond + ) $ do + (Right resMembership) <- getResponseBody <$> updateEntityEither dummyAuth mockBaseRequest updateMembership + resMembership `shouldBe` membership + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "PUT" + rawPathInfo receivedReq `shouldBe` "/v1/memberships" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just updateMembership + + it "deleteMembership sends DELETE request with membershipId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + ) $ do + deleteMembership dummyAuth mockBaseRequest (MembershipId "testMembershipId") + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "DELETE" + rawPathInfo receivedReq `shouldBe` "/v1/memberships/testMembershipId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + describe "Message" $ do + let messageJson = "{\ + \ \"id\" : \"Y2lzY29zcGFyazovL3VzL01FU1NBR0UvOTJkYjNiZTAtNDNiZC0xMWU2LThhZTktZGQ1YjNkZmM1NjVk\",\ + \ \"roomId\" : \"Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0\",\ + \ \"roomType\" : \"group\",\ + \ \"toPersonId\" : \"Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX\",\ + \ \"toPersonEmail\" : \"julie@example.com\",\ + \ \"text\" : \"PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W.\",\ + \ \"html\" : \"

HTML formatted message goes here

when the message was posted in markdown format.

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

HTML formatted message goes here

when the message was posted in markdown format.

" + , messageFiles = Just [ FileUrl "http://www.example.com/images/media.png" ] + , messagePersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mNWIzNjE4Ny1jOGRkLTQ3MjctOGIyZi1mOWM0NDdmMjkwNDY" + , messagePersonEmail = Just $ Email "matt@example.com" + , messageCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + , messageMentionedPeople = Just [ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS8yNDlmNzRkOS1kYjhhLTQzY2EtODk2Yi04NzllZDI0MGFjNTM" + , PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS83YWYyZjcyYy0xZDk1LTQxZjAtYTcxNi00MjlmZmNmYmM0ZDg" ] + } + messageGen i = Message { messageId = MessageId . pack $ "messageId" <> i + , messageErrors = Nothing + , messageRoomId = Just . RoomId . pack $ "roomId" <> i + , messageRoomType = Just RoomTypeGroup + , messageToPersonId = Just . PersonId . pack $ "toPersonId" <> i + , messageToPersonEmail = Just . Email . pack $ "julie" <> i <> "@example.com" + , messageText = Just . MessageText . pack $ "messageText" <> i + , messageHtml = Just . MessageHtml . pack $ "messageHtml" <> i + , messageFiles = Just [ FileUrl . pack $ "http://www.example.com/images/media" <> i <> ".png" ] + , messagePersonId = Just . PersonId . pack $ "personId" <> i + , messagePersonEmail = Just . Email . pack $ "matt" <> i <> "@example.com" + , messageCreated = Just . Timestamp . pack $ "created" <> i + , messageMentionedPeople = Just [ PersonId . pack $ "memtionedPeople1-" <> i + , PersonId . pack $ "memtionedPeople2-" <> i ] + } + messageList j = [ messageGen $ j <> show i | i <- [1..3] ] + messageListList = [ messageList [c] | c <- ['a'..'d'] ] + defFilter = defaultMessageFilter $ RoomId "dummyRoomId" + newMessage = CreateMessage { createMessageRoomId = Just $ RoomId "Y2lzY29zcGFyazovL3VzL1JPT00vYmJjZWIxYWQtNDNmMS0zYjU4LTkxNDctZjE0YmIwYzRkMTU0" + , createMessageToPersonId = Just $ PersonId "Y2lzY29zcGFyazovL3VzL1BFT1BMRS9mMDZkNzFhNS0wODMzLTRmYTUtYTcyYS1jYzg5YjI1ZWVlMmX" + , createMessageToPersonEmail = Just $ Email "julie@example.com" + , createMessageText = Just $ MessageText "PROJECT UPDATE - A new project plan has been published on Box: http://box.com/s/lf5vj. The PM for this project is Mike C. and the Engineering Manager is Jane W." + , createMessageMarkdown = Just $ MessageMarkdown "**PROJECT UPDATE** A new project plan has been published [on Box](http://box.com/s/lf5vj). The PM for this project is <@personEmail:mike@example.com> and the Engineering Manager is <@personEmail:jane@example.com>." + , createMessageFiles = Just $ [ FileUrl "http://www.example.com/images/media.png" ] + } + + it "streamMessageList streams Message" $ do + let testData = messageList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MessageList testData)) req respond + ) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/messages" + queryString receivedReq `shouldBe` [ ("roomId", Just "dummyRoomId") ] + + 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 + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (MessageList testData)) req respond + ) $ do + 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") ] + + it "streamMessageList streams Message with automatic pagination" $ do + withMockServer (paginationApp $ encode . MessageList <$> messageListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` concat messageListList + + it "streamMessageList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . MessageList <$> messageListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest defFilter .| sinkList + res `shouldBe` concat (take 2 messageListList) + + it "getDetail for a message returns a Message" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp messageJson req respond + ) $ do + resMessage <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (MessageId "testMessageId") + resMessage `shouldBe` message + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/messages/testMessageId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a message returns a (Right Message)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp messageJson req respond + ) $ do + (Right resMessage) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (MessageId "testMessageId") + resMessage `shouldBe` message + + it "createEntity for a message sends JSON encoded CreateMessage as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp messageJson req respond + ) $ do + resMessage <- getResponseBody <$> createEntity dummyAuth mockBaseRequest newMessage + resMessage `shouldBe` message + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/messages" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newMessage + + it "createEntithEither for a message sends JSON encoded CreateMessage as its body of POST request" $ do + receivedReqMVar <- newEmptyMVar + receivedBodyMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + strictRequestBody req >>= putMVar receivedBodyMVar + simpleApp messageJson req respond + ) $ do + (Right resMessage) <- getResponseBody <$> createEntityEither dummyAuth mockBaseRequest newMessage + resMessage `shouldBe` message + + receivedReq <- takeMVar receivedReqMVar + receivedBody <- takeMVar receivedBodyMVar + requestMethod receivedReq `shouldBe` "POST" + rawPathInfo receivedReq `shouldBe` "/v1/messages" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + decode receivedBody `shouldBe` Just newMessage + + it "deleteMessage sends DELETE request with messageId on URL path" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp "" req respond + ) $ do + deleteMessage dummyAuth mockBaseRequest (MessageId "testMessageId") + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "DELETE" + rawPathInfo receivedReq `shouldBe` "/v1/messages/testMessageId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + describe "Organization" $ do + let organizationJson = "{\ + \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ + \ \"displayName\" : \"Cisco, Inc.\",\ + \ \"created\" : \"2015-10-18T14:26:16+00:00\"\ + \}" + organization = Organization { organizationId = OrganizationId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" + , organizationErrors = Nothing + , organizationDisplayName = Just $ OrganizationDisplayName "Cisco, Inc." + , organizationCreated = Just $ Timestamp "2015-10-18T14:26:16+00:00" + } + organizationGen i = Organization { organizationId = OrganizationId . pack $ "organizationId" <> i + , organizationErrors = Nothing + , organizationDisplayName = Just $ OrganizationDisplayName . pack $ "displayName" <> i + , organizationCreated = Just $ Timestamp . pack $ "timestamp" <> i + } + organizationList j = [ organizationGen $ j <> show i | i <- [1..3] ] + organizationListList = [ organizationList [c] | c <- ['a'..'d'] ] + + it "streamOrganizationList streams Organization" $ do + let testData = organizationList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (OrganizationList testData)) req respond + ) $ do + res <- runConduit $ streamOrganizationList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/organizations" + queryString receivedReq `shouldBe` [] + + it "streamOrganizationList streams Organization with automatic pagination" $ do + withMockServer (paginationApp $ encode . OrganizationList <$> organizationListList) $ do + res <- runConduit $ streamOrganizationList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat organizationListList + + it "streamOrganizationList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . OrganizationList <$> organizationListList) $ do + res <- runConduit $ streamOrganizationList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat (take 2 organizationListList) + + it "getDetail for an organization returns a Organization" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp organizationJson req respond + ) $ do + resOrganization <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (OrganizationId "testOrganizationId") + resOrganization `shouldBe` organization + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/organizations/testOrganizationId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for an organization returns a (Right Organization)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp organizationJson req respond + ) $ do + (Right resOrganization) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (OrganizationId "testOrganizationId") + resOrganization `shouldBe` organization + + describe "License" $ do + let licenseJson = "{\ + \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ + \ \"name\" : \"Spark Calling\",\ + \ \"totalUnits\" : 42,\ + \ \"consumedUnits\" : 8\ + \}" + license = License { licenseId = LicenseId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" + , licenseErrors = Nothing + , licenseName = Just $ LicenseName "Spark Calling" + , licenseTotalUnits = Just $ LicenseUnit 42 + , licenseConsumedUnits = Just $ LicenseUnit 8 + } + licenseGen i = License { licenseId = LicenseId . pack $ "licenseId" <> i + , licenseErrors = Nothing + , licenseName = Just $ LicenseName . pack $ "licenseName" <> i + , licenseTotalUnits = Just $ LicenseUnit 42 + , licenseConsumedUnits = Just $ LicenseUnit 8 + } + licenseList j = [ licenseGen $ j <> show i | i <- [1..3] ] + licenseListList = [ licenseList [c] | c <- ['a'..'d'] ] + + it "streamLicenseList streams License" $ do + let testData = licenseList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (LicenseList testData)) req respond + ) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/licenses" + queryString receivedReq `shouldBe` [] + + it "streamLicenseList passes query strings build from LicenseFilter to server" $ do + let testData = licenseList ['Z'] + licenseFilter = LicenseFilter (Just $ OrganizationId "orgIdFilter") + + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (LicenseList testData)) req respond + ) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest licenseFilter .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/licenses" + queryString receivedReq `shouldBe` [ ("orgId", Just "orgIdFilter") ] + + it "streamLicenseList streams License with automatic pagination" $ do + withMockServer (paginationApp $ encode . LicenseList <$> licenseListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) .| sinkList + res `shouldBe` concat licenseListList + + it "streamLicenseList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . LicenseList <$> licenseListList) $ do + res <- runConduit $ streamEntityWithFilter dummyAuth mockBaseRequest (def :: LicenseFilter) .| sinkList + res `shouldBe` concat (take 2 licenseListList) + + it "getDetail for a license returns a License" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp licenseJson req respond + ) $ do + resLicense <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (LicenseId "testLicenseId") + resLicense `shouldBe` license + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/licenses/testLicenseId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a license returns a (Right License)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp licenseJson req respond + ) $ do + (Right resLicense) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (LicenseId "testLicenseId") + resLicense `shouldBe` license + + describe "Role" $ do + let roleJson = "{\ + \ \"id\" : \"OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh\",\ + \ \"name\" : \"Full Administrator\"\ + \}" + role = Role { roleId = RoleId "OTZhYmMyYWEtM2RjYy0xMWU1LWExNTItZmUzNDgxOWNkYzlh" + , roleErrors = Nothing + , roleName = Just $ RoleName "Full Administrator" + } + roleGen i = Role { roleId = RoleId . pack $ "roleId" <> i + , roleErrors = Nothing + , roleName = Just . RoleName . pack $ "roleName" <> i + } + roleList j = [ roleGen $ j <> show i | i <- [1..3] ] + roleListList = [ roleList [c] | c <- ['a'..'d'] ] + + it "streamRoleList streams Role" $ do + let testData = roleList ['Z'] + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp (encode (RoleList testData)) req respond + ) $ do + res <- runConduit $ streamRoleList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` testData + + receivedReq <- takeMVar receivedReqMVar + rawPathInfo receivedReq `shouldBe` "/v1/roles" + queryString receivedReq `shouldBe` [] + + it "streamRoleList streams Role with automatic pagination" $ do + withMockServer (paginationApp $ encode . RoleList <$> roleListList) $ do + res <- runConduit $ streamRoleList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat roleListList + + it "streamRoleList stops pagination at invalid Link Header" $ do + withMockServer (invalidPaginationApp $ encode . RoleList <$> roleListList) $ do + res <- runConduit $ streamRoleList dummyAuth mockBaseRequest .| sinkList + res `shouldBe` concat (take 2 roleListList) + + it "getDetail for a role returns a Role" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp roleJson req respond + ) $ do + resRole <- getResponseBody <$> getDetail dummyAuth mockBaseRequest (RoleId "testRoleId") + resRole `shouldBe` role + + receivedReq <- takeMVar receivedReqMVar + requestMethod receivedReq `shouldBe` "GET" + rawPathInfo receivedReq `shouldBe` "/v1/roles/testRoleId" + (lookup "Authorization" . requestHeaders) receivedReq `shouldBe` Just "Bearer dummyAuth" + (lookup "Content-Type" . requestHeaders) receivedReq `shouldBe` Just "application/json; charset=utf-8" + + it "getDetailEither for a role returns a (Right Role)" $ do + receivedReqMVar <- newEmptyMVar + + withMockServer (\req respond -> do + putMVar receivedReqMVar req + simpleApp roleJson req respond + ) $ do + (Right resRole) <- getResponseBody <$> getDetailEither dummyAuth mockBaseRequest (RoleId "testRoleId") + resRole `shouldBe` role