content: {-# 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 _ = 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 AcceptanceConfig {..} = do
    describe "Within the SCIM 2.0 protocol specification, your application must meet these requirements:" $ do
      it "Supports creating users, and optionally also groups, as per section 3.3 of the SCIM protocol." $ pending -- TODO(arianvp): Write test
      it "Supports modifying users or groups with PATCH requests, as per section 3.5.2 of the SCIM protocol." $ pending -- TODO(arianvp): Write test
      it "Supports retrieving a known resource for a user or group created earlier, as per section 3.4.1 of the SCIM protocol." $ pending -- TODO(arianvp): Write test
      it "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." $ pending
      describe "Supports querying user by ID and by manager, as per section 3.4.2 of the SCIM protocol." $ do
        it "query by id" $ pending -- TODO(arianvp): Write test
        it "query by manager" $ pending -- TODO(arianvp): Implement support for enterprise extension
      it "Supports querying groups by ID and by member, as per section 3.4.2 of the SCIM protocol." $ pending -- TODO(arianvp): Implement groups
      it "Accepts a single bearer token for authentication and authorization of Azure AD to your application." $
        -- This is provided by the library
        True `shouldBe` True
    describe "Follow these general guidelines when implementing a SCIM endpoint to ensure compatibility with Azure AD:" $ do
      it "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." $
        -- NOTE: This is guaranteed by the type-system. No need for a test
        True `shouldBe` True
      it "Response to a query/filter request should always be a ListResponse." $
        -- NOTE: This is guaranteed by the type-system. No need for a test
        True `shouldBe` True
      it "Groups are optional, but only supported if the SCIM implementation supports PATCH requests." $
        -- TODO(arianvp): Implement groups
        True `shouldBe` True
      it "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, " $
        -- TODO(arianvp): Write test
        pending
      describe "Microsoft Azure AD only uses the following operators: eq and" $ do
        -- TODO(arianvp): Write test
        it "eq" $ pending
        -- TODO(arianvp): Implement 'and' as Azure needs it
        it "and" $ pending
    describe "good errors" $ do
      -- (we may touch servant for this?)
      it "surfaces parse errors of the user id path segment" $ do
        pendingWith "should contain the offending id and the error; currently contains neither"
      it "same for user id in query" $ do
        pending
      it "same for all other things parsed in path, query, body, ..." $ do
        pending
    beforeAll scimAppAndConfig $ do
      it "User Operations" $ \(app, queryConfig) -> flip runWaiSession app $ do
        userName1 <- liftIO genUserName
        userName2 <- liftIO genUserName
        -- POST /Users
        resp :: SResponse <- post' queryConfig "/Users" (sampleUser1 userName1)
        liftIO $ simpleStatus resp `shouldBe` status201
        let testuid :: BS.ByteString
            testuid =
              either (error . show . (,resp)) (cs . Servant.toUrlPiece . Hscim.id . thing) $
                Aeson.eitherDecode' @(StoredUser tag) (simpleBody resp)
        -- Get users without query
        get' queryConfig "/Users" >>= \rsp -> liftIO $ do
          simpleStatus rsp `shouldSatisfy` (`elem` [status200, status400])
        -- Get single user by query
        get' queryConfig (cs $ "/Users?filter=userName eq " <> show userName1) >>= \rsp -> liftIO $ do
          simpleStatus rsp `shouldBe` status200
          ListResponse.totalResults <$> Aeson.eitherDecode' @(ListResponse.ListResponse (StoredUser tag)) (simpleBody rsp) `shouldBe` Right 1
        -- Get single user by query, zero results
        get' queryConfig (cs $ "/Users?filter=userName eq " <> show userName2)
          `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
        ignore $ do
          get' queryConfig "/Users?filter=externalId eq \"0a21f0f2-8d2a-4f8e-479e-a20b-2d77186b5dd1\"" >>= \rsp -> liftIO $ do
            simpleStatus rsp `shouldBe` status200
            ListResponse.totalResults <$> Aeson.eitherDecode' @(ListResponse.ListResponse (StoredUser tag)) (simpleBody rsp) `shouldBe` Right 1
        -- Update user [Multi-valued properties]
        ignore $
          patch'
            queryConfig
            "/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"
                    }
                ]
              }
          |]
            `shouldRespondWith` 200
        -- update user [single-valued properties]
        -- replace userName
        let ops1 =
              [scim|
                     {
                           "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
                           "Operations": [{
                                   "op": "Replace",
                                   "path": "userName",
                                   "value": #{userName2}
                           }]
                     }
                   |]
        patch' queryConfig ("/Users/" <> testuid) ops1 `shouldRespondWith` 200
        -- replace displayName
        let ops2 =
              [scim|
                     {
                             "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
                             "Operations": [{
                                     "op": "Replace",
                                     "path": "displayName",
                                     "value": "newDisplayName"
                             }]
                     }
                   |]
            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 =
              if responsesFullyKnown
                then exactResult
                else 200 -- TODO(fisx): check the fields changed by the patch operations?
        patch' queryConfig ("/Users/" <> testuid) ops2 `shouldRespondWith` result
        -- remove displayName
        let op3 =
              [scim|
                   {
                           "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
                           "Operations": [{
                                   "op": "Remove",
                                   "path": "displayName"
                           }]
                   }
                 |]
            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 =
              if responsesFullyKnown
                then exactResult3
                else 200 -- TODO(fisx): check the fields changed by the patch operations?
        patch' queryConfig ("/Users/" <> testuid) op3 `shouldRespondWith` result3
        -- Delete User
        delete' queryConfig ("/Users/" <> testuid) "" `shouldRespondWith` 204
        -- (... idempotently)
        delete' queryConfig ("/Users/" <> testuid) "" `shouldRespondWith` 204
      it "Group operations" $ const pending
  
  sampleUser1 :: Text -> L.ByteString
  sampleUser1 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": []
    }
  |]
  