41 lines
1.4 KiB
Haskell
41 lines
1.4 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
|
|
|
module ServantApiSpec where
|
|
|
|
import TestImport
|
|
import ServantApi
|
|
|
|
import Servant.API
|
|
import Servant.API.TypeLevel (MapSub, AppendList)
|
|
import Foundation.Servant.Types (ApiVersion)
|
|
|
|
import GHC.TypeLits
|
|
import Data.Kind (Constraint)
|
|
|
|
|
|
type family Unversioned api where
|
|
Unversioned (ApiVersion _ _ _ :> _) = '[]
|
|
Unversioned (sup :> sub) = MapSub sup (Unversioned sub)
|
|
Unversioned (a :<|> b) = AppendList (Unversioned a) (Unversioned b)
|
|
Unversioned (Verb method statusCode contentTypes a) = '[Verb method statusCode contentTypes a]
|
|
Unversioned (NoContentVerb method) = '[NoContentVerb method]
|
|
|
|
type family UnversionedError xs :: ErrorMessage where
|
|
UnversionedError (x ': '[]) = 'Text "Unversioned API endpoint: " ':$$: ('Text " " ':<>: 'ShowType x)
|
|
UnversionedError (x ': xs) = UnversionedError (x ': '[]) ':$$: UnversionedError xs
|
|
|
|
type family IsEmpty xs :: Constraint where
|
|
IsEmpty '[] = ()
|
|
IsEmpty xs = TypeError ('Text "All API endpoints must be versioned." ':$$: UnversionedError xs)
|
|
|
|
spec :: Spec
|
|
spec = describe "Servant endpoints" $ it "are all versioned" versioned
|
|
where
|
|
versioned :: IsEmpty (Unversioned UniWorXApi) => Bool
|
|
versioned = True
|