IgnorePrivOpenApiSpec.hs

module Feature.IgnorePrivOpenApiSpec where

import Control.Lens ((^?))

import Data.Aeson.Lens
import Data.Aeson.QQ

import Network.HTTP.Types
import Network.Wai        (Application)
import Network.Wai.Test   (SResponse (..))

import Test.Hspec     hiding (pendingWith)
import Test.Hspec.Wai

import Protolude  hiding (get)
import SpecHelper

spec :: SpecWith ((), Application)
spec = describe "OpenAPI Ignore Privileges" $ do
  it "root path returns a valid openapi spec" $ do
    validateOpenApiResponse [("Accept", "application/openapi+json")]
    request methodHead "/" (acceptHdrs "application/openapi+json") ""
      `shouldRespondWith` "" { matchStatus  = 200 }

  describe "table" $ do

    it "includes privileged table even if user does not have permission" $ do
      r <- simpleBody <$> get "/"
      let tableTag = r ^? key "paths" . key "/authors_only"
                     . key "post" . key "tags"
                     . nth 0

      liftIO $ tableTag `shouldBe` Just [aesonQQ|"authors_only"|]

    it "only includes tables that belong to another schema if the Accept-Profile header is used" $ do
      r1 <- simpleBody <$> get "/"
      let tableKey1 = r1 ^? key "paths" . key "/children"

      liftIO $ tableKey1 `shouldBe` Nothing

      r2 <- simpleBody <$> request methodGet "/" [("Accept-Profile", "v1")] ""
      let tableKey2 = r2 ^? key "paths" . key "/children"

      liftIO $ tableKey2 `shouldNotBe` Nothing

    it "includes comments on tables" $ do
      r <- simpleBody <$> get "/"

      let grandChildGet s = key "paths" . key "/grandchild_entities" . key "get" . key s
          grandChildGetSummary = r ^? grandChildGet "summary"
          grandChildGetDescription = r ^? grandChildGet "description"

      liftIO $ do
        grandChildGetSummary `shouldBe` Just "grandchild_entities summary"
        grandChildGetDescription `shouldBe` Just "grandchild_entities description\nthat spans\nmultiple lines"

  describe "RPC" $ do

    it "includes privileged function even if user does not have permission" $ do
      r <- simpleBody <$> get "/"
      let funcTag = r ^? key "paths" . key "/rpc/privileged_hello"
                    . key "post" . key "tags"
                    . nth 0

      liftIO $ funcTag `shouldBe` Just [aesonQQ|"(rpc) privileged_hello"|]

    it "only includes functions that belong to another schema if the Accept-Profile header is used" $ do
      r1 <- simpleBody <$> get "/"
      let funcKey1 = r1 ^? key "paths" . key "/rpc/get_parents_below"

      liftIO $ funcKey1 `shouldBe` Nothing

      r2 <- simpleBody <$> request methodGet "/" [("Accept-Profile", "v1")] ""
      let funcKey2 = r2 ^? key "paths" . key "/rpc/get_parents_below"

      liftIO $ funcKey2 `shouldNotBe` Nothing