polytropos-openapi3-0.1.0.2: test/Main.hs

{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Main (main) where

import Test.Tasty
import Test.Tasty.HUnit
import Data.Aeson (decode, encode)
import qualified Data.HashMap.Strict.InsOrd.Compat as IOHM
import Data.OpenApi
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text as T
import Polytropos
import Polytropos.OpenApi ()

type MyRec = Record '["x" ':= Int, "flag" ':= Bool, "msg" ':= String]
type MyVar = Variant '["A" ':= '["foo" ':= Int], "B" ':= '["bar" ':= Bool]]

main :: IO ()
main = defaultMain $ testGroup "OpenAPI3 Integration"
  [ testGroup "Record schemas"
      [ testCase "object schema with properties in row order" $ do
          let s = toSchema (Proxy :: Proxy MyRec)
          _schemaType s @?= Just OpenApiObject
          IOHM.keys (_schemaProperties s) @?= (map T.pack ["x", "flag", "msg"])
      , testCase "all fields required" $
          _schemaRequired (toSchema (Proxy :: Proxy MyRec))
            @?= (map T.pack ["x", "flag", "msg"] :: [Text])
      , testCase "field schemas reference primitive types" $ do
          let s = toSchema (Proxy :: Proxy MyRec)
              props = _schemaProperties s
              xSchema = case IOHM.lookup (T.pack "x") props of
                Just (Inline xs) -> xs
                other            -> error ("expected inline schema for x: " ++ show other)
          _schemaType xSchema @?= Just OpenApiInteger
      , testCase "generates valid JSON schema objects" $ do
          let s = toSchema (Proxy :: Proxy MyRec)
          (decode (encode s) :: Maybe Schema) @?= Just s
      ]
  , testGroup "Variant schemas"
      [ testCase "oneOf with one entry per constructor" $ do
          let s = toSchema (Proxy :: Proxy MyVar)
          case _schemaOneOf s of
            Just [Inline a, Inline b] -> do
              IOHM.keys (_schemaProperties a) @?= [T.pack "A"]
              IOHM.keys (_schemaProperties b) @?= [T.pack "B"]
            other -> assertFailure ("expected two oneOf entries, got: " ++ show other)
      , testCase "tagged constructor requires the tag" $ do
          let s = toSchema (Proxy :: Proxy MyVar)
          case _schemaOneOf s of
            Just [Inline a, Inline b] -> do
              _schemaRequired a @?= [T.pack "A"]
              _schemaRequired b @?= [T.pack "B"]
            other -> assertFailure ("expected two oneOf entries, got: " ++ show other)
      , testCase "generates valid JSON schema objects" $ do
          let s = toSchema (Proxy :: Proxy MyVar)
          (decode (encode s) :: Maybe Schema) @?= Just s
      ]
  ]