53 lines
2.0 KiB
Haskell
53 lines
2.0 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
{-# OPTIONS_GHC -Wno-error=unused-local-binds #-}
|
|
|
|
module ServantApi.ExternalApisSpec where
|
|
|
|
import TestImport
|
|
import ServantApi.ExternalApis.Type
|
|
import ServantApi.ExternalApis.TypeSpec ()
|
|
|
|
import Servant.Client.Core (RequestF(..))
|
|
import Servant.Client.Generic
|
|
|
|
import Utils.Tokens
|
|
import Data.Time.Clock (nominalDay)
|
|
|
|
import qualified Data.HashSet as HashSet
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
|
|
import qualified Data.Sequence as Seq
|
|
|
|
import Control.Monad.Reader.Class (MonadReader(local))
|
|
import Utils (CustomHeader(..), waiCustomHeader)
|
|
|
|
|
|
spec :: Spec
|
|
spec = withApp . describe "ExternalApis" $ do
|
|
it "Supports dryRun" $ do
|
|
adminId <- runDB $ do
|
|
Entity adminId _ <- insertEntity $ fakeUser id
|
|
ifi <- insert $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional Nothing True SchoolAuthorshipStatementModeRequired Nothing False
|
|
insert_ $ UserFunction adminId ifi SchoolAdmin
|
|
return adminId
|
|
|
|
accessToken <- runHandler $ encodeBearer =<< bearerToken (HashSet.singleton $ Right adminId) Nothing HashMap.empty Nothing Nothing Nothing
|
|
|
|
let
|
|
insertExternalApi = void $ externalApisCreateR accessToken =<< liftIO (generate $ resize 10 arbitrary)
|
|
where ExternalApis{..} = genericClient
|
|
withDryRun :: ServantExampleEnv -> ServantExampleEnv
|
|
withDryRun seEnv = seEnv
|
|
{ yseMakeClientRequest = \burl req -> yseMakeClientRequest seEnv burl req{ requestHeaders = requestHeaders req Seq.:|> waiCustomHeader HeaderDryRun True }
|
|
}
|
|
externalApiCount = runDB $ count @_ @_ @ExternalApi []
|
|
|
|
runServantExample ExternalApisR insertExternalApi
|
|
liftIO . (`shouldBe` 1) =<< externalApiCount
|
|
|
|
runServantExample ExternalApisR $ local withDryRun insertExternalApi
|
|
liftIO . (`shouldBe` 1) =<< externalApiCount
|