jordan-servant-openapi (empty) → 0.1.0.0

raw patch · 5 files changed

+181/−0 lines, 5 filesdep +attoparsecdep +basedep +bytestring

Dependencies added: attoparsec, base, bytestring, contravariant, http-media, http-types, jordan, jordan-openapi, jordan-servant, lens, openapi3, scientific, servant, servant-openapi3, text, transformers

Files

CHANGELOG.md +5/−0
LICENSE +20/−0
jordan-servant-openapi.cabal +62/−0
lib/Jordan/Servant/OpenApi.hs +90/−0
test/MyLibTest.hs +4/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for jordan-servant-openapi++## 0.1.0.0 -- 2022-07-04++* First version. Provides basic orphan instances.

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2022 Anthony Super++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ jordan-servant-openapi.cabal view

@@ -0,0 +1,62 @@+cabal-version:      2.4+name:               jordan-servant-openapi+version:            0.1.0.0+synopsis:           OpenAPI schemas for Jordan-Powered Servant APIs++-- A longer description of the package.+description:+  Jordan Servant OpenAPI provides orphan instances to generate OpenAPI V3 documenation+  for Jordan-Powered Servant APIs.++homepage:           https://github.com/AnthonySuper/jordan++-- A URL where users can report bugs.+-- bug-reports:+license:            MIT+license-file:       LICENSE+author:             Anthony Super+maintainer:         anthony@noided.media+-- A copyright notice.+-- copyright:+category:           Web+extra-source-files: CHANGELOG.md++common build-deps+  build-depends:+    , attoparsec >= 0.14.1 && <0.15+    , bytestring >= 0.10.8.1 && <0.12+    , contravariant >= 1.5.5 && <1.6+    , jordan >= 0.2.0.0 && <0.3+    , servant >= 0.18 && <0.20+    , text >= 1.2.3.0 && <1.3+    , scientific >= 0.3.7 && <0.4+    , jordan-servant >= 0.1.0.0 && <0.2+    , servant-openapi3 >= 2.0 && <=2.1+    , jordan-openapi >= 0.2.0 && <= 0.3+    , http-types >= 0.12.2 && <0.13+    , http-media >= 0.7 && <0.9+    , lens >= 4.17 && <5.2+    , transformers >=0.5.5 && <= 0.7+    , openapi3 >= 3.1.0 && <3.3+    , base >= 4.14.1 && <4.17+++library+    import: build-deps+    exposed-modules:+        Jordan.Servant.OpenApi++    -- Modules included in this library but not exported.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:+    hs-source-dirs:   lib+    default-language: Haskell2010++test-suite jordan-servant-openapi-test+    import: build-deps+    default-language: Haskell2010+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          MyLibTest.hs

+ lib/Jordan/Servant/OpenApi.hs view

@@ -0,0 +1,90 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Provides orphan instances for Jordan servant combinators that allow the generation of documentation.+module Jordan.Servant.OpenApi where++import Control.Lens+import Data.OpenApi.Declare+import Data.OpenApi.Internal+import Data.OpenApi.Lens+import Data.OpenApi.Operation+import Data.OpenApi.ParamSchema+import Data.OpenApi.Schema+import Data.Proxy (Proxy (..))+import qualified Data.Text as T+import Data.Typeable+import GHC.TypeLits+import Jordan+import Jordan.OpenAPI+import Jordan.Servant+import Jordan.Types.JSONError+import Network.HTTP.Media+import Servant.API+import Servant.API.ContentTypes+import Servant.API.Modifiers+import Servant.OpenApi.Internal++instance (ToJSON a, Typeable a) => ToSchema (ViaJordan a) where+  declareNamedSchema (Proxy :: Proxy (ViaJordan a)) = getToNamed (Proxy :: Proxy a)++instance forall a sub baseKey mods. (HasOpenApi sub, FromJSON a, KnownSymbol baseKey, SBoolI (FoldRequired mods)) => HasOpenApi (JordanQuery' baseKey mods a :> sub) where+  toOpenApi _ =+    toOpenApi (Proxy :: Proxy sub)+      & addParam parameter+      & setResponseWith (<>) 400 queryErrorResponse+      & components . schemas %~ (<> defs)+    where+      (defs, ref) = runDeclare (getFromRef (Proxy @a)) mempty+      parameter :: Param+      parameter =+        mempty+          & name .~ T.pack (symbolVal $ Proxy @baseKey)+          & in_ .~ ParamQuery+          & style ?~ StyleDeepObject+          & explode ?~ True+          & allowReserved ?~ False+          & schema ?~ ref+          & required ?~ isRequired+      queryErrorResponse =+        pure $+          mempty & content . at ("application" // "json+haskell-jordan-query-error") . non mempty . schema ?~ Inline s+      s :: Schema+      s = toParamSchema (Proxy :: Proxy String)+      isRequired = case sbool @(FoldRequired mods) of+        STrue -> True+        SFalse -> False++errorResponse :: Declare (Definitions Schema) Response+errorResponse = do+  ref <- getToRef (Proxy :: Proxy JSONError)+  pure $ mempty & content . at ("application" // "json+haskell-servant-body-error") . non mempty . schema ?~ ref++instance forall a sub. (HasOpenApi sub, FromJSON a) => HasOpenApi (ReportingRequestBody a :> sub) where+  toOpenApi _ =+    toOpenApi (Proxy :: Proxy sub)+      & addRequestBody reqBody+      & addErrorResponse+      & components . schemas %~ (<> defs)+    where+      (defs, ref) = runDeclare (getFromRef (Proxy :: Proxy a)) mempty+      reqBody :: RequestBody =+        mempty+          { _requestBodyContent = [("application" // "json", mediaType)]+          }+      mediaType :: MediaTypeObject =+        mempty+          { _mediaTypeObjectSchema = Just ref+          }+      addErrorResponse = setResponseWith (<>) 400 errorResponse

+ test/MyLibTest.hs view

@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented."