Merge branch 'adinapoli/restore-swagger-auth' into 'dev'

Switch to OpenAPI3 from Swagger2, to use proper Bearer token

Closes #427

See merge request !369

gargantext.cabal

@@ -467,6 +467,8 @@ library
       Gargantext.Database.Schema.NodeNode
       Gargantext.Database.Schema.Prelude
       Gargantext.Database.Types
+      Gargantext.Orphans
+      Gargantext.Orphans.OpenAPI
       Gargantext.Utils.Aeson
       Gargantext.Utils.Servant
       Gargantext.Utils.UTCTime
@@ -562,6 +564,7 @@ library
     , opaleye ^>= 0.9.6.1
     , opaleye-textsearch >= 0.2.0.0
     , openalex
+    , openapi3 >= 3.2.3
     , parallel ^>= 3.2.2.0
     , parsec ^>= 3.1.16.1
     , patches-class ^>= 0.1.0.1
@@ -588,6 +591,7 @@ library
     , servant-client-core >= 0.20 && < 0.21
     , servant-ekg ^>= 0.3.1
     , servant-routes < 0.2
+    , servant-openapi3 >= 2.0.1.6
     , servant-server >= 0.18.3 && < 0.21
     , servant-swagger ^>= 1.2
     , servant-swagger-ui ^>= 0.3.5.3.5.0

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -64,6 +64,7 @@ import Servant (HasServer(..), ServerT)
 import Servant.Server.Internal.Delayed (addParameterCheck)
 import Servant.Server.Internal.DelayedIO (DelayedIO(..))
 import Servant.Swagger qualified as Swagger
+import Servant.OpenApi qualified as OpenAPI
 
 -------------------------------------------------------------------------------
 -- Types
@@ -299,6 +300,9 @@ instance AddSetCookies ('S n) old new => AddSetCookies ('S n) (AccessPolicyManag
 instance Swagger.HasSwagger sub => Swagger.HasSwagger (PolicyChecked sub) where
     toSwagger _ = Swagger.toSwagger (Proxy :: Proxy sub)
 
+instance OpenAPI.HasOpenApi sub => OpenAPI.HasOpenApi (PolicyChecked sub) where
+    toOpenApi _ = OpenAPI.toOpenApi (Proxy :: Proxy sub)
+
 instance HasEndpoint sub => HasEndpoint (PolicyChecked sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)

src/Gargantext/API/Routes/Named.hs

@@ -15,6 +15,7 @@ module Gargantext.API.Routes.Named (
   , ForgotPasswordAPI(..)
   , ForgotPasswordAsyncAPI(..)
   , GargVersion(..)
+  , module Gargantext.API.Routes.Named.Private
   ) where
 
 import Data.Text (Text)
@@ -74,10 +75,9 @@ data GargAPI' mode = GargAPI'
   , gargForgotPasswordAsyncAPI :: mode :- "async" :> "forgot-password" :> NamedRoutes ForgotPasswordAsyncAPI
   , gargVersionAPI             :: mode :- NamedRoutes GargVersion
   , gargPrivateAPI             :: mode :- NamedRoutes GargPrivateAPI
-  , gargPublicAPI              :: mode :- "public" :> NamedRoutes GargPublicAPI
+  , gargPublicAPI              :: mode :- NamedRoutes GargPublicAPI
   } deriving Generic
 
-
 newtype AuthAPI mode = AuthAPI
   { authEp :: mode :- "auth"  :> Summary "AUTH API"
                               :> ReqBody '[JSON] AuthRequest

src/Gargantext/API/Routes/Named/Public.hs

@@ -2,7 +2,8 @@
 
 module Gargantext.API.Routes.Named.Public (
   -- * Routes types
-    GargPublicAPI(..)
+    GargPublicAPI'(..)
+  , GargPublicAPI(..)
   , HomeAPI(..)
   , NodeAPI(..)
   ) where
@@ -13,8 +14,11 @@ import Gargantext.API.Routes.Named.File (FileAPI)
 import Gargantext.Database.Admin.Types.Node ( NodeId )
 import Servant.API
 
+newtype GargPublicAPI mode = GargPublicAPI
+  { gargAPIVersion :: mode :- "public" :> NamedRoutes GargPublicAPI'
+  } deriving Generic
 
-data GargPublicAPI mode = GargPublicAPI
+data GargPublicAPI' mode = GargPublicAPI'
   { publicHomeAPI :: mode :- NamedRoutes HomeAPI
   , publicNodeAPI :: mode :- NamedRoutes NodeAPI
   } deriving Generic

src/Gargantext/API/Routes/Named/Share.hs

@@ -29,7 +29,7 @@ import Servant
 -- would fail because '#/share/NodeCorpus/16' by the RFC3968 spec is considered
 -- an uriFragment, but BaseUrl cannot handle that.
 newtype ShareLink = ShareLink { getShareLink :: URI }
-  deriving (Show, Eq, Ord)
+  deriving (Show, Eq, Ord, Generic)
 
 renderShareLink :: ShareLink -> T.Text
 renderShareLink = T.pack . show . getShareLink

src/Gargantext/API/Server/Named.hs

@@ -20,7 +20,7 @@ import Gargantext.API.GraphQL as GraphQL
 import Gargantext.API.Prelude (GargM)
 import Gargantext.API.Routes.Named
 import Gargantext.API.Server.Named.Public (serverPublicGargAPI)
-import Gargantext.API.Swagger (swaggerDoc)
+import Gargantext.API.Swagger (openApiDoc)
 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
 import Gargantext.Core.Notifications.Dispatcher.WebSocket qualified as Dispatcher
 import Gargantext.Core.Config (gc_frontend_config, hasConfig)
@@ -50,7 +50,7 @@ serverGargAPI env
 server :: Env -> API AsServer
 server env =
   API $ \errScheme -> NamedAPI
-     { swaggerAPI = swaggerSchemaUIServer swaggerDoc
+     { swaggerAPI = swaggerSchemaUIServer openApiDoc
      , backendAPI = hoistServerWithContext
                       (Proxy :: Proxy (NamedRoutes BackEndAPI))
                       (Proxy :: Proxy AuthContext)

src/Gargantext/API/Server/Named/Public.hs

@@ -26,8 +26,8 @@ import Servant
 import Servant.Server.Generic (AsServerT)
 
 serverPublicGargAPI :: IsGargServer env err m => Text -> Named.GargPublicAPI (AsServerT m)
-serverPublicGargAPI baseUrl =
-  Named.GargPublicAPI
+serverPublicGargAPI baseUrl = Named.GargPublicAPI $
+  Named.GargPublicAPI'
     { publicHomeAPI = api_home baseUrl
     , publicNodeAPI = Named.NodeAPI api_node
     }

src/Gargantext/API/Swagger.hs

 {-# OPTIONS_GHC -freduction-depth=400 #-}
+{-# LANGUAGE TypeApplications         #-}
+{-# LANGUAGE TypeOperators #-}
 
 {-|
 Module      : Gargantext.API.Swagger
@@ -12,30 +14,45 @@ Portability : POSIX
 -}
 
 ---------------------------------------------------------------------
-module Gargantext.API.Swagger where
----------------------------------------------------------------------
+module Gargantext.API.Swagger (
+    backendApiProxy
+  , openApiDoc
+  ) where
+
 import Control.Lens ((?~))
-import Data.Swagger
+import Data.OpenApi
 import Data.Version (showVersion)
+import Gargantext.API.Routes.Named.Public qualified as Named
 import Gargantext.API.Routes.Named qualified as Named
+import Gargantext.Orphans () -- instance HasOpenApi
 import Gargantext.Prelude
 import Paths_gargantext qualified as PG -- cabal magic build module
 import Servant
-import Servant.Swagger (toSwagger, subOperations)
+import Servant.OpenApi
 
-backendApiProxy :: Proxy (ToServantApi Named.BackEndAPI)
+backendApiProxy :: Proxy (NamedRoutes (Named.MkBackEndAPI (Named.GargAPIVersion Named.GargAPI')))
 backendApiProxy = Proxy
 
--- | Swagger Specifications
-swaggerDoc :: Swagger
-swaggerDoc = toSwagger backendApiProxy
+privateOps :: Proxy (NamedRoutes (Named.MkBackEndAPI (Named.GargAPIVersion Named.GargPrivateAPI)))
+privateOps = Proxy
+
+publicOps :: Proxy (NamedRoutes (Named.MkBackEndAPI (Named.GargAPIVersion Named.GargPublicAPI)))
+publicOps = Proxy
+
+-- | OpenAPI Specification. It supports programmatically adding the `Bearer` to the `Authorization`
+-- header, which makes the Swagger UI actually useable, unlike the 'swaggerDoc' counterpart which
+-- is stuck on version 2.x of the OpenAPI spec.
+openApiDoc :: OpenApi
+openApiDoc = toOpenApi backendApiProxy
   & info.title       .~ "GarganText"
   & info.version     .~ (cs $ showVersion PG.version)
-  -- & info.base_url     ?~ (URL "http://gargantext.org/")
   & info.description ?~ "REST API specifications"
-  -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
   & applyTagsFor (subOperations backendApiProxy backendApiProxy)
-                 ["Gargantext" & description ?~ "Main operations"]
+                 ["Gargantext" & description ?~ "All operations"]
+  & applyTagsFor (subOperations privateOps backendApiProxy)
+                 ["Private operations" & description ?~ "Operations requiring authentications"]
+  & applyTagsFor (subOperations publicOps backendApiProxy)
+                 ["Public operations" & description ?~ "Operations which don't require a valid authentication"]
   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
     where
         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"

src/Gargantext/Orphans.hs

+module Gargantext.Orphans (
+  module Gargantext.Orphans.OpenAPI
+  ) where
+
+import Gargantext.Orphans.OpenAPI

src/Gargantext/Orphans/OpenAPI.hs

+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+module Gargantext.Orphans.OpenAPI where
+
+import Control.Lens
+import Data.HashMap.Strict.InsOrd qualified as HM
+import Data.OpenApi as OpenAPI hiding (Header, Server)
+import Data.OpenApi.Declare
+import Data.Swagger.Internal qualified as Swagger
+import Data.Swagger qualified as Swagger
+import Data.Text qualified as T
+import Data.Typeable
+import Prelude
+import qualified Data.Swagger.Declare as SwaggerDeclare
+import Servant.API
+import Servant.Auth
+import Servant.OpenApi
+
+-- Auth instances
+
+instance (HasOpenApi api) => HasOpenApi (Servant.Auth.Auth '[] a :> api) where
+  toOpenApi Proxy = toOpenApi $ Proxy @api
+
+instance (HasOpenApi (Servant.Auth.Auth auths a :> api)) => HasOpenApi (Servant.Auth.Auth (Servant.Auth.BasicAuth : auths) a :> api) where
+  toOpenApi Proxy = addSecurity $ toOpenApi $ Proxy @(Servant.Auth.Auth auths a :> api)
+   where
+    addSecurity = addSecurityRequirement identifier . addSecurityScheme identifier securityScheme
+    identifier :: T.Text = "BasicAuth"
+    securityScheme =
+      SecurityScheme
+        { _securitySchemeType = SecuritySchemeHttp HttpSchemeBasic
+        , _securitySchemeDescription = Just "Basic Authentication"
+        }
+
+instance (HasOpenApi (Servant.Auth.Auth auths a :> api)) => HasOpenApi (Servant.Auth.Auth (Servant.Auth.JWT : auths) a :> api) where
+  toOpenApi Proxy = addSecurity $ toOpenApi $ Proxy @(Servant.Auth.Auth auths a :> api)
+   where
+    addSecurity = addSecurityRequirement identifier . addSecurityScheme identifier securityScheme
+    identifier :: T.Text = "JWT"
+    securityScheme =
+      SecurityScheme
+        { _securitySchemeType = SecuritySchemeHttp $ HttpSchemeBearer $ Just "JWT"
+        , _securitySchemeDescription = Just "Bearer Authentication"
+        }
+
+instance (HasOpenApi (Servant.Auth.Auth auths a :> api)) => HasOpenApi (Servant.Auth.Auth (Servant.Auth.Cookie : auths) a :> api) where
+  toOpenApi Proxy = addSecurity $ toOpenApi $ Proxy @(Servant.Auth.Auth auths a :> api)
+   where
+    addSecurity = addSecurityRequirement identifier . addSecurityScheme identifier securityScheme
+    identifier :: T.Text = "Cookie"
+    securityScheme =
+      SecurityScheme
+        { _securitySchemeType = SecuritySchemeHttp $ HttpSchemeBearer $ Just "JWT"
+        , _securitySchemeDescription = Just "Cookie Authentication"
+        }
+
+addSecurityScheme :: T.Text -> SecurityScheme -> OpenApi -> OpenApi
+addSecurityScheme securityIdentifier securityScheme openApi =
+  openApi
+    { _openApiComponents =
+        (_openApiComponents openApi)
+          { _componentsSecuritySchemes =
+              _componentsSecuritySchemes (_openApiComponents openApi)
+                <> SecurityDefinitions (HM.singleton securityIdentifier securityScheme)
+          }
+    }
+
+addSecurityRequirement :: T.Text -> OpenApi -> OpenApi
+addSecurityRequirement securityRequirement =
+  allOperations
+    . security
+    %~ ((SecurityRequirement $ HM.singleton securityRequirement []) :)
+
+-- Working with the compat shim a bit more pleasant
+
+class SwaggerConvertible a b where
+  swagConv :: Iso' a b
+
+--
+-- Instances
+--
+
+instance SwaggerConvertible OpenAPI.Discriminator T.Text where
+  swagConv = iso OpenAPI._discriminatorPropertyName convertDiscriminator
+    where
+      convertDiscriminator :: T.Text -> OpenAPI.Discriminator
+      convertDiscriminator t = OpenAPI.Discriminator t mempty
+
+instance SwaggerConvertible OpenAPI.OpenApiType (Swagger.SwaggerType 'Swagger.SwaggerKindSchema) where
+  swagConv = iso fromOpenAPI toOpenAPI
+    where
+      toOpenAPI :: Swagger.SwaggerType t -> OpenAPI.OpenApiType
+      toOpenAPI Swagger.SwaggerString = OpenAPI.OpenApiString
+      toOpenAPI Swagger.SwaggerNumber = OpenAPI.OpenApiNumber
+      toOpenAPI Swagger.SwaggerInteger = OpenAPI.OpenApiInteger
+      toOpenAPI Swagger.SwaggerBoolean = OpenAPI.OpenApiBoolean
+      toOpenAPI Swagger.SwaggerArray = OpenAPI.OpenApiArray
+      toOpenAPI Swagger.SwaggerFile = OpenAPI.OpenApiString -- OpenAPI lacks file type, fallback to string
+      toOpenAPI Swagger.SwaggerNull = OpenAPI.OpenApiNull
+      toOpenAPI Swagger.SwaggerObject = OpenAPI.OpenApiObject
+
+      fromOpenAPI OpenAPI.OpenApiString  =  Swagger.SwaggerString
+      fromOpenAPI OpenAPI.OpenApiNumber  =  Swagger.SwaggerNumber
+      fromOpenAPI OpenAPI.OpenApiInteger = Swagger.SwaggerInteger
+      fromOpenAPI OpenAPI.OpenApiBoolean = Swagger.SwaggerBoolean
+      fromOpenAPI OpenAPI.OpenApiArray   = Swagger.SwaggerArray
+      fromOpenAPI OpenAPI.OpenApiNull    = Swagger.SwaggerNull
+      fromOpenAPI OpenAPI.OpenApiObject  = Swagger.SwaggerObject
+
+instance SwaggerConvertible OpenAPI.Xml (Swagger.Xml) where
+  swagConv = iso fromOpenAPI toOpenAPI
+   where
+     fromOpenAPI :: Xml -> Swagger.Xml
+     fromOpenAPI OpenAPI.Xml
+        { OpenAPI._xmlName = xname
+        , OpenAPI._xmlNamespace = xnamespace
+        , OpenAPI._xmlPrefix = xprefix
+        , OpenAPI._xmlAttribute = xattribute
+        , OpenAPI._xmlWrapped = xwrapped
+        } = Swagger.Xml { Swagger._xmlName = xname
+                       , Swagger._xmlNamespace = xnamespace
+                       , Swagger._xmlPrefix = xprefix
+                       , Swagger._xmlAttribute = xattribute
+                       , Swagger._xmlWrapped = xwrapped }
+
+     toOpenAPI :: Swagger.Xml -> Xml
+     toOpenAPI Swagger.Xml { Swagger._xmlName = xname
+                       , Swagger._xmlNamespace = xnamespace
+                       , Swagger._xmlPrefix = xprefix
+                       , Swagger._xmlAttribute = xattribute
+                       , Swagger._xmlWrapped = xwrapped } =
+      OpenAPI.Xml
+        { OpenAPI._xmlName = xname
+        , OpenAPI._xmlNamespace = xnamespace
+        , OpenAPI._xmlPrefix = xprefix
+        , OpenAPI._xmlAttribute = xattribute
+        , OpenAPI._xmlWrapped = xwrapped
+        }
+
+instance SwaggerConvertible OpenAPI.URL (Swagger.URL) where
+  swagConv = iso fromOpenAPI toOpenAPI
+    where
+      fromOpenAPI :: URL -> Swagger.URL
+      fromOpenAPI (URL u) = Swagger.URL u
+
+      toOpenAPI :: Swagger.URL -> URL
+      toOpenAPI = OpenAPI.URL . Swagger.getUrl
+
+instance SwaggerConvertible ExternalDocs Swagger.ExternalDocs where
+  swagConv = iso fromOpenAPI toOpenAPI
+    where
+     toOpenAPI :: Swagger.ExternalDocs -> ExternalDocs
+     toOpenAPI Swagger.ExternalDocs { Swagger._externalDocsDescription = desc
+                                    , Swagger._externalDocsUrl = docurl } =
+       OpenAPI.ExternalDocs
+         { OpenAPI._externalDocsDescription = desc
+         , OpenAPI._externalDocsUrl = view (from swagConv) $ docurl
+         }
+
+     fromOpenAPI :: ExternalDocs -> Swagger.ExternalDocs
+     fromOpenAPI OpenAPI.ExternalDocs
+         { OpenAPI._externalDocsDescription = desc
+         , OpenAPI._externalDocsUrl = docurl
+         } = Swagger.ExternalDocs { Swagger._externalDocsDescription = desc
+                                  , Swagger._externalDocsUrl = view swagConv docurl
+                                  }
+
+instance SwaggerConvertible a b => SwaggerConvertible (Referenced a) (Swagger.Referenced b) where
+  swagConv = iso fromOpenAPI toOpenAPI
+   where
+     fromOpenAPI :: Referenced a -> Swagger.Referenced b
+     fromOpenAPI (OpenAPI.Ref (OpenAPI.Reference ref)) = Swagger.Ref (Swagger.Reference ref)
+     fromOpenAPI (OpenAPI.Inline s) = Swagger.Inline (view swagConv s)
+
+     toOpenAPI :: Swagger.Referenced b -> OpenAPI.Referenced a
+     toOpenAPI (Swagger.Ref ref) = OpenAPI.Ref $ OpenAPI.Reference (Swagger.getReference ref)
+     toOpenAPI (Swagger.Inline s) = OpenAPI.Inline $ view (from swagConv) s
+
+instance SwaggerConvertible Schema Swagger.Schema where
+  swagConv = iso toSwaggerSchema fromSwaggerSchema
+
+instance SwaggerConvertible AdditionalProperties Swagger.AdditionalProperties where
+  swagConv = iso fromOpenAPI toOpenAPI
+    where
+      fromOpenAPI :: AdditionalProperties -> Swagger.AdditionalProperties
+      fromOpenAPI (OpenAPI.AdditionalPropertiesAllowed allowed) =
+        Swagger.AdditionalPropertiesAllowed allowed
+      fromOpenAPI (OpenAPI.AdditionalPropertiesSchema ref) =
+        Swagger.AdditionalPropertiesSchema (view swagConv ref)
+
+      toOpenAPI :: Swagger.AdditionalProperties -> AdditionalProperties
+      toOpenAPI (Swagger.AdditionalPropertiesAllowed allowed) =
+        OpenAPI.AdditionalPropertiesAllowed allowed
+      toOpenAPI (Swagger.AdditionalPropertiesSchema ref) =
+        OpenAPI.AdditionalPropertiesSchema (view (from swagConv) ref)
+
+
+--
+-- Putting everything together
+--
+
+fromParamSchema :: Swagger.ParamSchema 'Swagger.SwaggerKindSchema -> Schema
+fromParamSchema ps = OpenAPI.Schema
+  { OpenAPI._schemaTitle = Nothing
+  , OpenAPI._schemaDescription = Nothing
+  , OpenAPI._schemaDefault = view Swagger.default_ ps
+  , OpenAPI._schemaExample = Nothing
+  , OpenAPI._schemaType = view (from swagConv) <$> view Swagger.type_ ps
+  , OpenAPI._schemaFormat = view Swagger.format ps
+  , OpenAPI._schemaNullable = Nothing
+  , OpenAPI._schemaEnum = view Swagger.enum_ ps
+  , OpenAPI._schemaMaximum = view Swagger.maximum_ ps
+  , OpenAPI._schemaExclusiveMaximum = Swagger._paramSchemaExclusiveMaximum ps
+  , OpenAPI._schemaMinimum = Swagger._paramSchemaMinimum ps
+  , OpenAPI._schemaExclusiveMinimum = Swagger._paramSchemaExclusiveMinimum ps
+  , OpenAPI._schemaMaxLength = Swagger._paramSchemaMaxLength ps
+  , OpenAPI._schemaMinLength = Swagger._paramSchemaMinLength ps
+  , OpenAPI._schemaPattern = Swagger._paramSchemaPattern ps
+  , OpenAPI._schemaMaxItems = Swagger._paramSchemaMaxItems ps
+  , OpenAPI._schemaMinItems = Swagger._paramSchemaMinItems ps
+  , OpenAPI._schemaUniqueItems = view Swagger.uniqueItems ps
+  , OpenAPI._schemaMaxProperties = Nothing
+  , OpenAPI._schemaMinProperties = Nothing
+  , OpenAPI._schemaAdditionalProperties = Nothing
+  , OpenAPI._schemaItems = convertItems <$> view Swagger.items ps
+  , OpenAPI._schemaProperties = mempty
+  , OpenAPI._schemaRequired = mempty
+  , OpenAPI._schemaAllOf = Nothing
+  , OpenAPI._schemaOneOf = Nothing
+  , OpenAPI._schemaNot = Nothing
+  , OpenAPI._schemaAnyOf = Nothing
+  , OpenAPI._schemaDiscriminator = Nothing
+  , OpenAPI._schemaReadOnly = Nothing
+  , OpenAPI._schemaWriteOnly = Nothing
+  , OpenAPI._schemaXml = Nothing
+  , OpenAPI._schemaExternalDocs = Nothing
+  , OpenAPI._schemaDeprecated = Nothing
+  , OpenAPI._schemaMultipleOf = view Swagger.multipleOf ps
+  }
+
+
+convertItems :: Swagger.SwaggerItems 'Swagger.SwaggerKindSchema -> OpenAPI.OpenApiItems
+convertItems (Swagger.SwaggerItemsPrimitive _collectionFormat paramSchema) =
+  OpenAPI.OpenApiItemsObject $ OpenAPI.Inline $ fromParamSchema paramSchema
+convertItems (Swagger.SwaggerItemsObject referencedSchema) =
+  OpenAPI.OpenApiItemsObject $ view (from swagConv) $ referencedSchema
+convertItems (Swagger.SwaggerItemsArray referencedSchemas) =
+  OpenAPI.OpenApiItemsArray $ map (view (from swagConv)) $ referencedSchemas
+
+convertItems' :: OpenApiItems -> Swagger.SwaggerItems 'Swagger.SwaggerKindSchema
+convertItems' = \case
+  OpenAPI.OpenApiItemsObject s -> Swagger.SwaggerItemsObject (view swagConv s)
+  OpenAPI.OpenApiItemsArray xs -> Swagger.SwaggerItemsArray $ map (view swagConv) xs
+
+fromSwaggerSchema :: Swagger.Schema -> OpenAPI.Schema
+fromSwaggerSchema swaggerSchema = OpenAPI.Schema
+  { OpenAPI._schemaTitle = view Swagger.title swaggerSchema
+  , OpenAPI._schemaDescription = view Swagger.description swaggerSchema
+  , OpenAPI._schemaDefault = view Swagger.default_ swaggerSchema
+  , OpenAPI._schemaExample = view Swagger.example swaggerSchema
+  , OpenAPI._schemaType = view (from swagConv) <$> view Swagger.type_ swaggerSchema
+  , OpenAPI._schemaFormat = view Swagger.format swaggerSchema
+  , OpenAPI._schemaNullable = Nothing
+  , OpenAPI._schemaEnum = view Swagger.enum_ swaggerSchema
+  , OpenAPI._schemaMaximum = view Swagger.maximum_ swaggerSchema
+  , OpenAPI._schemaExclusiveMaximum = swaggerSchema ^. Swagger.paramSchema . Swagger.exclusiveMaximum
+  , OpenAPI._schemaMinimum = view Swagger.minimum_ swaggerSchema
+  , OpenAPI._schemaExclusiveMinimum = swaggerSchema ^. Swagger.paramSchema . Swagger.exclusiveMinimum
+  , OpenAPI._schemaMaxLength = swaggerSchema ^. Swagger.paramSchema . Swagger.maxLength
+  , OpenAPI._schemaMinLength = swaggerSchema ^. Swagger.paramSchema . Swagger.minLength
+  , OpenAPI._schemaPattern = swaggerSchema ^. Swagger.paramSchema . Swagger.pattern
+  , OpenAPI._schemaMaxItems = swaggerSchema ^. Swagger.paramSchema . Swagger.maxItems
+  , OpenAPI._schemaMinItems = swaggerSchema ^. Swagger.paramSchema . Swagger.minItems
+  , OpenAPI._schemaUniqueItems = view Swagger.uniqueItems swaggerSchema
+  , OpenAPI._schemaMaxProperties = view Swagger.maxProperties swaggerSchema
+  , OpenAPI._schemaMinProperties = view Swagger.minProperties swaggerSchema
+  , OpenAPI._schemaAdditionalProperties = view (from swagConv) <$> view Swagger.additionalProperties swaggerSchema
+  , OpenAPI._schemaItems = convertItems <$> view Swagger.items swaggerSchema
+  , OpenAPI._schemaProperties = HM.map (view (from swagConv)) $ view Swagger.properties swaggerSchema
+  , OpenAPI._schemaRequired = view Swagger.required swaggerSchema
+  , OpenAPI._schemaAllOf = map (view (from swagConv)) <$> view Swagger.allOf swaggerSchema
+  , OpenAPI._schemaOneOf = Nothing
+  , OpenAPI._schemaNot = Nothing
+  , OpenAPI._schemaAnyOf = Nothing
+  , OpenAPI._schemaDiscriminator = view (from swagConv) <$> view Swagger.discriminator swaggerSchema
+  , OpenAPI._schemaReadOnly = view Swagger.readOnly swaggerSchema
+  , OpenAPI._schemaWriteOnly = Nothing
+  , OpenAPI._schemaXml = view (from swagConv) <$> view Swagger.xml swaggerSchema
+  , OpenAPI._schemaExternalDocs = view (from swagConv) <$> view Swagger.externalDocs swaggerSchema
+  , OpenAPI._schemaDeprecated = Nothing
+  , OpenAPI._schemaMultipleOf = view Swagger.multipleOf swaggerSchema
+  }
+
+toSwaggerSchema :: Schema -> Swagger.Schema
+toSwaggerSchema s@Schema{..} = Swagger.Schema
+  { Swagger._schemaTitle = view title s
+  , Swagger._schemaDescription = view description s
+  , Swagger._schemaRequired = _schemaRequired
+  , Swagger._schemaAllOf = map (view swagConv) <$> _schemaAllOf
+  , Swagger._schemaProperties = HM.map (view swagConv) $ _schemaProperties
+  , Swagger._schemaAdditionalProperties = view swagConv <$> _schemaAdditionalProperties
+  , Swagger._schemaDiscriminator = view swagConv <$> view discriminator s
+  , Swagger._schemaReadOnly = view readOnly s
+  , Swagger._schemaXml = view swagConv <$> _schemaXml
+  , Swagger._schemaExternalDocs = view swagConv <$> _schemaExternalDocs
+  , Swagger._schemaExample = view example s
+  , Swagger._schemaMaxProperties = view maxProperties s
+  , Swagger._schemaMinProperties = view minProperties s
+  , Swagger._schemaParamSchema = Swagger.ParamSchema {
+       _paramSchemaDefault = _schemaDefault
+     , _paramSchemaType = view swagConv <$> _schemaType
+     , _paramSchemaFormat = _schemaFormat
+     , _paramSchemaItems = convertItems' <$> _schemaItems
+     , _paramSchemaMaximum = _schemaMaximum
+     , _paramSchemaExclusiveMaximum = _schemaExclusiveMaximum
+     , _paramSchemaMinimum = _schemaMinimum
+     , _paramSchemaExclusiveMinimum = _schemaExclusiveMinimum
+     , _paramSchemaMaxLength = _schemaMaxLength
+     , _paramSchemaMinLength = _schemaMinLength
+     , _paramSchemaPattern = _schemaPattern
+     , _paramSchemaMaxItems = _schemaMaxItems
+     , _paramSchemaMinItems = _schemaMinItems
+     , _paramSchemaUniqueItems = _schemaUniqueItems
+     , _paramSchemaEnum = _schemaEnum
+     , _paramSchemaMultipleOf = _schemaMultipleOf
+     }
+  }
+
+-- little compat-shim to avoid re-implementing 'ToSchema' and 'ToParamSchema' for each
+-- and every type, while we transition away from swagger.
+
+instance {-# OVERLAPS #-} (Typeable a, Swagger.ToParamSchema a) => ToParamSchema a where
+  toParamSchema p = fromParamSchema $ Swagger.toParamSchema p
+
+instance {-# OVERLAPS #-} (Typeable a, Swagger.ToSchema a) => ToSchema a where
+  declareNamedSchema p = DeclareT $ \d -> do
+    let (toRegister, Swagger.NamedSchema swaggerName swaggerSchema) =
+          flip SwaggerDeclare.runDeclare (lowerD d) (Swagger.declareNamedSchema p)
+    pure $ (convertDefinitions toRegister, OpenAPI.NamedSchema swaggerName (openApiSchema swaggerSchema))
+    where
+      openApiSchema s = fromSwaggerSchema s
+
+convertDefinitions :: Swagger.Definitions Swagger.Schema -> Definitions Schema
+convertDefinitions = HM.map fromSwaggerSchema
+
+lowerD :: Definitions Schema -> Swagger.Definitions Swagger.Schema
+lowerD = HM.map toSwaggerSchema