{-# LANGUAGE QuasiQuotes #-}

-- 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/>.

module Test.Class.GroupSpec
  ( spec,
  )
where

import Control.Monad
import qualified Data.Aeson as A
import qualified Data.Aeson.Lens as A
import qualified Data.ByteString as BS
import Data.ByteString.Lazy (ByteString)
import Data.String
import qualified Data.Vector as V
import Lens.Micro
import Network.Wai (Application)
import Network.Wai.Test
import Servant (Proxy (Proxy))
import Servant.API.Generic
import Test.HUnit
import Test.Hspec hiding (shouldSatisfy)
import Test.Hspec.Wai hiding (patch, post, put, shouldRespondWith)
import Web.Scim.Server (GroupAPI, groupServer, mkapp)
import Web.Scim.Server.Mock
import Web.Scim.Test.Util

fail_ :: (HasCallStack) => String -> WaiSession () a
fail_ = liftIO . assertFailure

getJson :: BS.ByteString -> WaiSession () A.Value
getJson path' =
  get path'
    >>= ( \case
            Just v -> pure v
            Nothing -> fail_ "Response doesn't parse as JSON!"
        )
      . A.decode
      . simpleBody

app :: IO Application
app = do
  storage <- emptyTestStorage
  let auth = Just "authorized"
  pure $ do
    mkapp @Mock
      (Proxy @(GroupAPI Mock))
      (toServant (groupServer @Mock auth))
      (nt storage)

spec :: Spec
spec = with app $ do
  describe "GET & POST /Groups" $ do
    it "responds with [] in empty environment" $ do
      get "/" `shouldRespondWith` emptyList
    it "can insert then retrieve stored group" $ do
      post "/" adminGroup `shouldRespondWith` 201
      get "/" `shouldRespondWith` groups

    it "paginates groups" $ do
      forM_ [0 .. 4 :: Int] $ \_ -> post "/" adminGroup `shouldRespondWith` 201

      let numFieldMatch :: A.Value -> String -> Int -> WaiSession () ()
          numFieldMatch v field expected = do
            case v ^? A.key (fromString field) . A._Number of
              Just gotten ->
                when (gotten /= fromIntegral expected) $ do
                  fail_ $ field <> " is " <> show gotten <> " instead of " <> show expected
              Nothing -> fail_ $ "missing field: " <> field

          hasMembers :: (HasCallStack) => WaiSession () A.Value -> Int -> Int -> Int -> WaiSession () ()
          hasMembers getPage expectedStartIndex expectedItemsPerPage expectedTotalResults = do
            page :: A.Value <- getPage
            case page ^? A.key "Resources" . A._Array of
              Just v -> do
                let l = V.length v
                when (l /= expectedItemsPerPage) $ fail_ $ "ListResponse Resources has length " <> show l <> " instead of " <> show expectedItemsPerPage
              Nothing -> fail_ "missing Resources field"
            numFieldMatch page "totalResults" expectedTotalResults
            numFieldMatch page "itemsPerPage" expectedItemsPerPage
            numFieldMatch page "startIndex" expectedStartIndex

      hasMembers (getJson "/?startIndex=1&count=2") 1 2 5
      hasMembers (getJson "/?startIndex=3&count=2") 3 2 5
      hasMembers (getJson "/?startIndex=5&count=2") 5 1 5

      hasMembers (getJson "/?startIndex=1&count=100") 1 5 5
      hasMembers (getJson "/?startIndex=6&count=100") 6 0 5

      hasMembers (getJson "/?startIndex=1") 1 5 5
      hasMembers (getJson "/?startIndex=2") 2 4 5
      hasMembers (getJson "/?startIndex=3") 3 3 5
      hasMembers (getJson "/?startIndex=4") 4 2 5
      hasMembers (getJson "/?startIndex=5") 5 1 5
      hasMembers (getJson "/?startIndex=6") 6 0 5
      hasMembers (getJson "/") 1 5 5

  describe "GET /Groups/:id" $ do
    it "responds with 404 for unknown group" $ do
      get "/9999" `shouldRespondWith` 404
    it "retrieves stored group" $ do
      post "/" adminGroup `shouldRespondWith` 201
      -- the test implementation stores groups with uid [0,1..n-1]
      get "/0" `shouldRespondWith` admins
  describe "PUT /Groups/:id" $ do
    it "adds member to existing group" $ do
      post "/" adminGroup `shouldRespondWith` 201
      put "/0" adminUpdate0 `shouldRespondWith` updatedAdmins0
    it "does not create new group" $ do
      put "/9999" adminGroup `shouldRespondWith` 404
  describe "DELETE /Groups/:id" $ do
    it "responds with 404 for unknown group" $ do
      post "/" adminGroup `shouldRespondWith` 201
      delete "/Users/unknown" `shouldRespondWith` 404
    it "deletes a stored group" $ do
      post "/" adminGroup `shouldRespondWith` 201
      delete "/0" `shouldRespondWith` 204
      -- group should be gone
      get "/0" `shouldRespondWith` 404
      delete "/0" `shouldRespondWith` 404

adminGroup :: ByteString
adminGroup =
  [scim|
        { "schemas":["urn:ietf:params:scim:schemas:core:2.0:Group"],
          "displayName":"Admin",
          "members":[]
        }|]

groups :: ResponseMatcher
groups =
  [scim|
        { "schemas":["urn:ietf:params:scim:api:messages:2.0:ListResponse"],
          "Resources":
            [{ "schemas":["urn:ietf:params:scim:schemas:core:2.0:Group"],
               "displayName":"Admin",
               "members":[],
               "id":"0",
               "meta":{
                 "resourceType":"Group",
                 "location":"https://example.com/Users/id",
                 "created":"2018-01-01T00:00:00Z",
                 "version":"W/\"testVersion\"",
                 "lastModified":"2018-01-01T00:00:00Z"
               }
             }
            ],
          "totalResults":1,
          "itemsPerPage":1,
          "startIndex":1
        }|]

admins :: ResponseMatcher
admins =
  [scim|
        { "schemas":["urn:ietf:params:scim:schemas:core:2.0:Group"],
           "displayName":"Admin",
           "members":[],
           "id":"0",
           "meta":{
             "resourceType":"Group",
             "location":"https://example.com/Users/id",
             "created":"2018-01-01T00:00:00Z",
             "version":"W/\"testVersion\"",
             "lastModified":"2018-01-01T00:00:00Z"
           }
        }|]

adminUpdate0 :: ByteString
adminUpdate0 =
  [scim|
        { "schemas":["urn:ietf:params:scim:schemas:core:2.0:Group"],
          "displayName":"Admin",
          "members":[
            { "value": "0",
              "$ref": "https://example.com/Users/0",
              "type": "User"
            }
          ]
        }|]

updatedAdmins0 :: ResponseMatcher
updatedAdmins0 =
  [scim|
        { "schemas":["urn:ietf:params:scim:schemas:core:2.0:Group"],
           "displayName":"Admin",
           "members":[
             { "value": "0",
               "$ref": "https://example.com/Users/0",
               "type": "User"
             }],
           "id":"0",
           "meta":{
             "resourceType":"Group",
             "location":"https://example.com/Users/id",
             "created":"2018-01-01T00:00:00Z",
             "version":"W/\"testVersion\"",
             "lastModified":"2018-01-01T00:00:00Z"
           }
        }|]

emptyList :: ResponseMatcher
emptyList =
  [scim|
       { "schemas": ["urn:ietf:params:scim:api:messages:2.0:ListResponse"],
         "Resources":[],
         "totalResults":0,
         "itemsPerPage":0,
         "startIndex":1
       }|]
