{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

-- | A bunch of hspec acceptance tests that assert that your SCIM
-- implementation is compatible with popular SCIM 2.0 providers
module Web.Scim.Test.Acceptance
  ( module Web.Scim.Test.Acceptance,
    module Web.Scim.Test.Util,
  )
where

import Control.Monad.IO.Class (liftIO)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
import Data.String.Conversions (cs)
import Data.Text (Text)
import Network.HTTP.Types.Status
import Network.Wai.Test
import Servant.API as Servant
import Test.Hspec (Spec, beforeAll, describe, it, pending, pendingWith, shouldBe, shouldSatisfy)
import Test.Hspec.Wai (matchStatus)
import Test.Hspec.Wai.Internal (runWaiSession)
import Web.Scim.Class.User
import Web.Scim.Schema.Common as Hscim
import qualified Web.Scim.Schema.ListResponse as ListResponse
import Web.Scim.Schema.Meta
import Web.Scim.Schema.UserTypes
import Web.Scim.Test.Util

ignore :: (Monad m) => m a -> m ()
ignore :: forall (m :: * -> *) a. Monad m => m a -> m ()
ignore m a
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- https://docs.microsoft.com/en-us/azure/active-directory/manage-apps/use-scim-to-provision-users-and-groups#step-2-understand-the-azure-ad-scim-implementation
microsoftAzure :: forall tag. (Aeson.FromJSON (UserId tag), Aeson.FromJSON (UserExtra tag), ToHttpApiData (UserId tag)) => AcceptanceConfig tag -> Spec
microsoftAzure :: forall tag.
(FromJSON (UserId tag), FromJSON (UserExtra tag),
 ToHttpApiData (UserId tag)) =>
AcceptanceConfig tag -> Spec
microsoftAzure AcceptanceConfig {Bool
IO (Application, AcceptanceQueryConfig tag)
IO Text
scimAppAndConfig :: IO (Application, AcceptanceQueryConfig tag)
genUserName :: IO Text
responsesFullyKnown :: Bool
scimAppAndConfig :: forall tag.
AcceptanceConfig tag -> IO (Application, AcceptanceQueryConfig tag)
genUserName :: forall tag. AcceptanceConfig tag -> IO Text
responsesFullyKnown :: forall tag. AcceptanceConfig tag -> Bool
..} = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Within the SCIM 2.0 protocol specification, your application must meet these requirements:" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Supports creating users, and optionally also groups, as per section 3.3 of the SCIM protocol." (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Expectation
HasCallStack => Expectation
pending -- TODO(arianvp): Write test
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Supports modifying users or groups with PATCH requests, as per section 3.5.2 of the SCIM protocol." (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Expectation
HasCallStack => Expectation
pending -- TODO(arianvp): Write test
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Supports retrieving a known resource for a user or group created earlier, as per section 3.4.1 of the SCIM protocol." (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Expectation
HasCallStack => Expectation
pending -- TODO(arianvp): Write test
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Supports querying users or groups, as per section 3.4.2 of the SCIM protocol. By default, users are retrieved by their id and queried by their username and externalid, and groups are queried by displayName." (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Expectation
HasCallStack => Expectation
pending
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Supports querying user by ID and by manager, as per section 3.4.2 of the SCIM protocol." (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"query by id" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Expectation
HasCallStack => Expectation
pending -- TODO(arianvp): Write test
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"query by manager" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Expectation
HasCallStack => Expectation
pending -- TODO(arianvp): Implement support for enterprise extension
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Supports querying groups by ID and by member, as per section 3.4.2 of the SCIM protocol." (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Expectation
HasCallStack => Expectation
pending -- TODO(arianvp): Implement groups
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Accepts a single bearer token for authentication and authorization of Azure AD to your application." (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
      -- This is provided by the library
      Bool
True Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
True
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Follow these general guidelines when implementing a SCIM endpoint to ensure compatibility with Azure AD:" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"id is a required property for all the resources. Every response that returns a resource should ensure each resource has this property, except for ListResponse with zero members." (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
      -- NOTE: This is guaranteed by the type-system. No need for a test
      Bool
True Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
True
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Response to a query/filter request should always be a ListResponse." (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
      -- NOTE: This is guaranteed by the type-system. No need for a test
      Bool
True Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
True
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Groups are optional, but only supported if the SCIM implementation supports PATCH requests." (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
      -- TODO(arianvp): Implement groups
      Bool
True Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
True
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Don't require a case-sensitive match on structural elements in SCIM, in particular PATCH op operation values, as defined in https://tools.ietf.org/html/rfc7644#section-3.5.2. Azure AD emits the values of 'op' as Add, " (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
      -- TODO(arianvp): Write test
      Expectation
HasCallStack => Expectation
pending
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Microsoft Azure AD only uses the following operators: eq and" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      -- TODO(arianvp): Write test
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"eq" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Expectation
HasCallStack => Expectation
pending
      -- TODO(arianvp): Implement 'and' as Azure needs it
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"and" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Expectation
HasCallStack => Expectation
pending
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"good errors" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    -- (we may touch servant for this?)
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"surfaces parse errors of the user id path segment" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => String -> Expectation
String -> Expectation
pendingWith String
"should contain the offending id and the error; currently contains neither"
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"same for user id in query" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ do
      Expectation
HasCallStack => Expectation
pending
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"same for all other things parsed in path, query, body, ..." (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ do
      Expectation
HasCallStack => Expectation
pending
  IO (Application, AcceptanceQueryConfig tag)
-> SpecWith (Application, AcceptanceQueryConfig tag) -> Spec
forall a. HasCallStack => IO a -> SpecWith a -> Spec
beforeAll IO (Application, AcceptanceQueryConfig tag)
scimAppAndConfig (SpecWith (Application, AcceptanceQueryConfig tag) -> Spec)
-> SpecWith (Application, AcceptanceQueryConfig tag) -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String
-> ((Application, AcceptanceQueryConfig tag) -> Expectation)
-> SpecWith
     (Arg ((Application, AcceptanceQueryConfig tag) -> Expectation))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"User Operations" (((Application, AcceptanceQueryConfig tag) -> Expectation)
 -> SpecWith
      (Arg ((Application, AcceptanceQueryConfig tag) -> Expectation)))
-> ((Application, AcceptanceQueryConfig tag) -> Expectation)
-> SpecWith
     (Arg ((Application, AcceptanceQueryConfig tag) -> Expectation))
forall a b. (a -> b) -> a -> b
$ \(Application
app, AcceptanceQueryConfig tag
queryConfig) -> (WaiSession () () -> Application -> Expectation)
-> Application -> WaiSession () () -> Expectation
forall a b c. (a -> b -> c) -> b -> a -> c
flip WaiSession () () -> Application -> Expectation
forall a. WaiSession () a -> Application -> IO a
runWaiSession Application
app (WaiSession () () -> Expectation)
-> WaiSession () () -> Expectation
forall a b. (a -> b) -> a -> b
$ do
      Text
userName1 <- IO Text -> WaiSession () Text
forall a. IO a -> WaiSession () a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
genUserName
      Text
userName2 <- IO Text -> WaiSession () Text
forall a. IO a -> WaiSession () a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
genUserName
      -- POST /Users
      SResponse
resp :: SResponse <- AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession st SResponse
post' AcceptanceQueryConfig tag
queryConfig ByteString
"/Users" (Text -> ByteString
sampleUser1 Text
userName1)
      Expectation -> WaiSession () ()
forall a. IO a -> WaiSession () a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Expectation -> WaiSession () ())
-> Expectation -> WaiSession () ()
forall a b. (a -> b) -> a -> b
$ SResponse -> Status
simpleStatus SResponse
resp Status -> Status -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Status
status201
      let testuid :: BS.ByteString
          testuid :: ByteString
testuid =
            (String -> ByteString)
-> (WithMeta (WithId (UserId tag) (User tag)) -> ByteString)
-> Either String (WithMeta (WithId (UserId tag) (User tag)))
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString)
-> (String -> String) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, SResponse) -> String
forall a. Show a => a -> String
show ((String, SResponse) -> String)
-> (String -> (String, SResponse)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,SResponse
resp)) (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> ByteString)
-> (WithMeta (WithId (UserId tag) (User tag)) -> Text)
-> WithMeta (WithId (UserId tag) (User tag))
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId tag -> Text
forall a. ToHttpApiData a => a -> Text
Servant.toUrlPiece (UserId tag -> Text)
-> (WithMeta (WithId (UserId tag) (User tag)) -> UserId tag)
-> WithMeta (WithId (UserId tag) (User tag))
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithId (UserId tag) (User tag) -> UserId tag
forall id a. WithId id a -> id
Hscim.id (WithId (UserId tag) (User tag) -> UserId tag)
-> (WithMeta (WithId (UserId tag) (User tag))
    -> WithId (UserId tag) (User tag))
-> WithMeta (WithId (UserId tag) (User tag))
-> UserId tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithMeta (WithId (UserId tag) (User tag))
-> WithId (UserId tag) (User tag)
forall a. WithMeta a -> a
thing) (Either String (WithMeta (WithId (UserId tag) (User tag)))
 -> ByteString)
-> Either String (WithMeta (WithId (UserId tag) (User tag)))
-> ByteString
forall a b. (a -> b) -> a -> b
$
              forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' @(StoredUser tag) (SResponse -> ByteString
simpleBody SResponse
resp)
      -- Get users without query
      AcceptanceQueryConfig tag -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag -> ByteString -> WaiSession st SResponse
get' AcceptanceQueryConfig tag
queryConfig ByteString
"/Users" WaiSession () SResponse
-> (SResponse -> WaiSession () ()) -> WaiSession () ()
forall a b.
WaiSession () a -> (a -> WaiSession () b) -> WaiSession () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SResponse
rsp -> Expectation -> WaiSession () ()
forall a. IO a -> WaiSession () a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Expectation -> WaiSession () ())
-> Expectation -> WaiSession () ()
forall a b. (a -> b) -> a -> b
$ do
        SResponse -> Status
simpleStatus SResponse
rsp Status -> (Status -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (Status -> [Status] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Status
status200, Status
status400])
      -- Get single user by query
      AcceptanceQueryConfig tag -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag -> ByteString -> WaiSession st SResponse
get' AcceptanceQueryConfig tag
queryConfig (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/Users?filter=userName eq " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
userName1) WaiSession () SResponse
-> (SResponse -> WaiSession () ()) -> WaiSession () ()
forall a b.
WaiSession () a -> (a -> WaiSession () b) -> WaiSession () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SResponse
rsp -> Expectation -> WaiSession () ()
forall a. IO a -> WaiSession () a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Expectation -> WaiSession () ())
-> Expectation -> WaiSession () ()
forall a b. (a -> b) -> a -> b
$ do
        SResponse -> Status
simpleStatus SResponse
rsp Status -> Status -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Status
status200
        ListResponse (WithMeta (WithId (UserId tag) (User tag))) -> Int
forall a. ListResponse a -> Int
ListResponse.totalResults (ListResponse (WithMeta (WithId (UserId tag) (User tag))) -> Int)
-> Either
     String (ListResponse (WithMeta (WithId (UserId tag) (User tag))))
-> Either String Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' @(ListResponse.ListResponse (StoredUser tag)) (SResponse -> ByteString
simpleBody SResponse
rsp) Either String Int -> Either String Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int -> Either String Int
forall a b. b -> Either a b
Right Int
1
      -- Get single user by query, zero results
      AcceptanceQueryConfig tag -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag -> ByteString -> WaiSession st SResponse
get' AcceptanceQueryConfig tag
queryConfig (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"/Users?filter=userName eq " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
userName2)
        WaiSession () SResponse -> ResponseMatcher -> WaiSession () ()
forall st.
HasCallStack =>
WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st
`shouldRespondWith` [scim|
          {
            "schemas": ["urn:ietf:params:scim:api:messages:2.0:ListResponse"],
            "totalResults": 0,
            "Resources": [],
            "startIndex": 1,
            "itemsPerPage": 0
          }
        |]
          { matchStatus = 200
          }
      -- Get single user by externalId works
      WaiSession () () -> WaiSession () ()
forall (m :: * -> *) a. Monad m => m a -> m ()
ignore (WaiSession () () -> WaiSession () ())
-> WaiSession () () -> WaiSession () ()
forall a b. (a -> b) -> a -> b
$ do
        AcceptanceQueryConfig tag -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag -> ByteString -> WaiSession st SResponse
get' AcceptanceQueryConfig tag
queryConfig ByteString
"/Users?filter=externalId eq \"0a21f0f2-8d2a-4f8e-479e-a20b-2d77186b5dd1\"" WaiSession () SResponse
-> (SResponse -> WaiSession () ()) -> WaiSession () ()
forall a b.
WaiSession () a -> (a -> WaiSession () b) -> WaiSession () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SResponse
rsp -> Expectation -> WaiSession () ()
forall a. IO a -> WaiSession () a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Expectation -> WaiSession () ())
-> Expectation -> WaiSession () ()
forall a b. (a -> b) -> a -> b
$ do
          SResponse -> Status
simpleStatus SResponse
rsp Status -> Status -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Status
status200
          ListResponse (WithMeta (WithId (UserId tag) (User tag))) -> Int
forall a. ListResponse a -> Int
ListResponse.totalResults (ListResponse (WithMeta (WithId (UserId tag) (User tag))) -> Int)
-> Either
     String (ListResponse (WithMeta (WithId (UserId tag) (User tag))))
-> Either String Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' @(ListResponse.ListResponse (StoredUser tag)) (SResponse -> ByteString
simpleBody SResponse
rsp) Either String Int -> Either String Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int -> Either String Int
forall a b. b -> Either a b
Right Int
1
      -- Update user [Multi-valued properties]
      WaiSession () () -> WaiSession () ()
forall (m :: * -> *) a. Monad m => m a -> m ()
ignore (WaiSession () () -> WaiSession () ())
-> WaiSession () () -> WaiSession () ()
forall a b. (a -> b) -> a -> b
$
        AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession st SResponse
patch'
          AcceptanceQueryConfig tag
queryConfig
          ByteString
"/Users/0"
          [scim|
            {
              "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
              "Operations": [
                  {
                      "op": "Replace",
                      "path": "emails[type eq \"work\"].value",
                      "value": "updatedEmail@microsoft.com"
                  },
                  {
                      "op": "Replace",
                      "path": "name.familyName",
                      "value": "updatedFamilyName"
                  }
              ]
            }
        |]
          WaiSession () SResponse -> ResponseMatcher -> WaiSession () ()
forall st.
HasCallStack =>
WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st
`shouldRespondWith` ResponseMatcher
200
      -- update user [single-valued properties]
      -- replace userName
      let ops1 :: ByteString
ops1 =
            [scim|
                   {
                         "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
                         "Operations": [{
                                 "op": "Replace",
                                 "path": "userName",
                                 "value": #{userName2}
                         }]
                   }
                 |]
      AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession st SResponse
patch' AcceptanceQueryConfig tag
queryConfig (ByteString
"/Users/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
testuid) ByteString
ops1 WaiSession () SResponse -> ResponseMatcher -> WaiSession () ()
forall st.
HasCallStack =>
WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st
`shouldRespondWith` ResponseMatcher
200
      -- replace displayName
      let ops2 :: ByteString
ops2 =
            [scim|
                   {
                           "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
                           "Operations": [{
                                   "op": "Replace",
                                   "path": "displayName",
                                   "value": "newDisplayName"
                           }]
                   }
                 |]
          exactResult :: ResponseMatcher
exactResult =
            [scim|
                     {
                       "schemas": [
                         "urn:ietf:params:scim:schemas:core:2.0:User",
                         "urn:ietf:params:scim:schemas:extension:enterprise:2.0:User"
                       ],
                       "userName": #{userName2},
                       "active": true,
                       "name": {
                         "givenName": "givenName",
                         "formatted": "givenName familyName",
                         "familyName": "familyName"
                       },
                       "emails": [
                         {
                           "value": #{userName1 <> "@testuser.com"},
                           "primary": true,
                           "type": "work"
                         }
                       ],
                       "displayName": "newDisplayName",
                       "id": "0",
                       "meta": {
                         "resourceType": "User",
                         "location": "https://example.com/Users/id",
                         "created": "2018-01-01T00:00:00Z",
                         "version": "W/\"testVersion\"",
                         "lastModified": "2018-01-01T00:00:00Z"
                       },
                       "externalId": "0a21f0f2-8d2a-4f8e-bf98-7363c4aed4ef"
                     }
                   |]
          result :: ResponseMatcher
result =
            if Bool
responsesFullyKnown
              then ResponseMatcher
exactResult
              else ResponseMatcher
200 -- TODO(fisx): check the fields changed by the patch operations?
      AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession st SResponse
patch' AcceptanceQueryConfig tag
queryConfig (ByteString
"/Users/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
testuid) ByteString
ops2 WaiSession () SResponse -> ResponseMatcher -> WaiSession () ()
forall st.
HasCallStack =>
WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st
`shouldRespondWith` ResponseMatcher
result
      -- remove displayName
      let op3 :: ByteString
op3 =
            [scim|
                 {
                         "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
                         "Operations": [{
                                 "op": "Remove",
                                 "path": "displayName"
                         }]
                 }
               |]
          exactResult3 :: ResponseMatcher
exactResult3 =
            [scim|
                     {
                       "schemas": [
                         "urn:ietf:params:scim:schemas:core:2.0:User",
                         "urn:ietf:params:scim:schemas:extension:enterprise:2.0:User"
                       ],
                       "userName": #{userName2},
                       "active": true,
                       "name": {
                         "givenName": "givenName",
                         "formatted": "givenName familyName",
                         "familyName": "familyName"
                       },
                       "emails": [
                         {
                           "value": #{userName1 <> "@testuser.com"},
                           "primary": true,
                           "type": "work"
                         }
                       ],
                       "id": "0",
                       "meta": {
                         "resourceType": "User",
                         "location": "https://example.com/Users/id",
                         "created": "2018-01-01T00:00:00Z",
                         "version": "W/\"testVersion\"",
                         "lastModified": "2018-01-01T00:00:00Z"
                       },
                       "externalId": "0a21f0f2-8d2a-4f8e-bf98-7363c4aed4ef"
                     }
                   |]
          result3 :: ResponseMatcher
result3 =
            if Bool
responsesFullyKnown
              then ResponseMatcher
exactResult3
              else ResponseMatcher
200 -- TODO(fisx): check the fields changed by the patch operations?
      AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession st SResponse
patch' AcceptanceQueryConfig tag
queryConfig (ByteString
"/Users/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
testuid) ByteString
op3 WaiSession () SResponse -> ResponseMatcher -> WaiSession () ()
forall st.
HasCallStack =>
WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st
`shouldRespondWith` ResponseMatcher
result3
      -- Delete User
      AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession st SResponse
delete' AcceptanceQueryConfig tag
queryConfig (ByteString
"/Users/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
testuid) ByteString
"" WaiSession () SResponse -> ResponseMatcher -> WaiSession () ()
forall st.
HasCallStack =>
WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st
`shouldRespondWith` ResponseMatcher
204
      -- (... idempotently)
      AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession () SResponse
forall tag st.
AcceptanceQueryConfig tag
-> ByteString -> ByteString -> WaiSession st SResponse
delete' AcceptanceQueryConfig tag
queryConfig (ByteString
"/Users/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
testuid) ByteString
"" WaiSession () SResponse -> ResponseMatcher -> WaiSession () ()
forall st.
HasCallStack =>
WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st
`shouldRespondWith` ResponseMatcher
204
    String
-> ((Application, AcceptanceQueryConfig tag) -> Expectation)
-> SpecWith
     (Arg ((Application, AcceptanceQueryConfig tag) -> Expectation))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Group operations" (((Application, AcceptanceQueryConfig tag) -> Expectation)
 -> SpecWith
      (Arg ((Application, AcceptanceQueryConfig tag) -> Expectation)))
-> ((Application, AcceptanceQueryConfig tag) -> Expectation)
-> SpecWith
     (Arg ((Application, AcceptanceQueryConfig tag) -> Expectation))
forall a b. (a -> b) -> a -> b
$ Expectation
-> (Application, AcceptanceQueryConfig tag) -> Expectation
forall a b. a -> b -> a
const Expectation
HasCallStack => Expectation
pending

sampleUser1 :: Text -> L.ByteString
sampleUser1 :: Text -> ByteString
sampleUser1 Text
userName1 =
  [scim|
  {
    "schemas": [
        "urn:ietf:params:scim:schemas:core:2.0:User",
        "urn:ietf:params:scim:schemas:extension:enterprise:2.0:User"],
    "externalId": "0a21f0f2-8d2a-4f8e-bf98-7363c4aed4ef",
    "userName": #{userName1},
    "active": true,
    "emails": [{
            "primary": true,
            "type": "work",
            "value": #{userName1 <> "@testuser.com"}
    }],
    "meta": {
            "resourceType": "User"
    },
    "name": {
            "formatted": "givenName familyName",
            "familyName": "familyName",
            "givenName": "givenName"
    },
    "roles": []
  }
|]