From fa353ce6edf36555270adbfb710eda66f14a08d2 Mon Sep 17 00:00:00 2001 From: Aleksandr Pak Date: Mon, 25 Jul 2022 15:36:41 +0300 Subject: [PATCH] [#114] Fix swagger structural error Problem: list of tuples - [(EntryPath, EntryPath)] - used in the WebAPI for `copy` and `rename` causes errors in Swagger docs. See https://github.com/serokell/coffer/pull/115#discussion_r890082548 Solution: introduce type `PairObject` just to fix this error. --- docs/swagger.json | 39 +++++++++++++++++---------------------- lib/Web/API.hs | 6 +++--- lib/Web/Server.hs | 14 +++++++------- lib/Web/Types.hs | 16 ++++++++++++++++ 4 files changed, 43 insertions(+), 32 deletions(-) diff --git a/docs/swagger.json b/docs/swagger.json index d28b297d..0eb24df7 100644 --- a/docs/swagger.json +++ b/docs/swagger.json @@ -10,6 +10,21 @@ }, "components": { "schemas": { + "PairObject_EntryPath": { + "type": "object", + "required": [ + "first", + "second" + ], + "properties": { + "second": { + "$ref": "#/components/schemas/EntryPath" + }, + "first": { + "$ref": "#/components/schemas/EntryPath" + } + } + }, "EntryPath": { "type": "string", "pattern": "(/[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_]*)+" @@ -353,17 +368,7 @@ "application/json;charset=utf-8": { "schema": { "items": { - "items": [ - { - "$ref": "#/components/schemas/EntryPath" - }, - { - "$ref": "#/components/schemas/EntryPath" - } - ], - "type": "array", - "maxItems": 2, - "minItems": 2 + "$ref": "#/components/schemas/PairObject_EntryPath" }, "type": "array" } @@ -425,17 +430,7 @@ "application/json;charset=utf-8": { "schema": { "items": { - "items": [ - { - "$ref": "#/components/schemas/EntryPath" - }, - { - "$ref": "#/components/schemas/EntryPath" - } - ], - "type": "array", - "maxItems": 2, - "minItems": 2 + "$ref": "#/components/schemas/PairObject_EntryPath" }, "type": "array" } diff --git a/lib/Web/API.hs b/lib/Web/API.hs index 811b451e..6b61aee9 100644 --- a/lib/Web/API.hs +++ b/lib/Web/API.hs @@ -12,7 +12,7 @@ import Data.Text (Text) import Entry import GHC.Generics (Generic) import Servant.API -import Web.Types (NewEntry) +import Web.Types (NewEntry, PairObject) type API = Header' [Required, Strict] "token" VaultToken @@ -54,14 +54,14 @@ type API :> RequiredParam "old-path" (QualifiedPath Path) :> RequiredParam "new-path" (QualifiedPath Path) :> QueryFlag "force" - :> Post '[JSON] [(EntryPath, EntryPath)] + :> Post '[JSON] [PairObject EntryPath] :<|> "copy" :> QueryFlag "dry-run" :> RequiredParam "old-path" (QualifiedPath Path) :> RequiredParam "new-path" (QualifiedPath Path) :> QueryFlag "force" - :> Post '[JSON] [(EntryPath, EntryPath)] + :> Post '[JSON] [PairObject EntryPath] :<|> "delete" :> QueryFlag "dry-run" diff --git a/lib/Web/Server.hs b/lib/Web/Server.hs index 62127d27..5f60214d 100644 --- a/lib/Web/Server.hs +++ b/lib/Web/Server.hs @@ -38,7 +38,7 @@ import Fmt (Builder, pretty, unlinesF) import GHC.Generics (Generic) import Servant.API import Servant.Server -import Web.Types (NewEntry(NewEntry), NewField(NewField)) +import Web.Types (NewEntry(NewEntry), NewField(NewField), mkPair, PairObject) data CofferServerError = CofferServerError { cseError :: Text @@ -71,9 +71,9 @@ handleSetFieldResult = \case where pretty = resultToText buildSetFieldResult -handleCopyOrRenameResult :: Bool -> CopyResult -> Handler [(EntryPath, EntryPath)] +handleCopyOrRenameResult :: Bool -> CopyResult -> Handler [PairObject EntryPath] handleCopyOrRenameResult rename = \case - CPRSuccess _ paths -> pure (paths <&> bimap qpPath qpPath) + CPRSuccess _ paths -> pure (paths <&> (mkPair . bimap qpPath qpPath)) res@CPRPathNotFound{} -> throwCofferServerError err404 500 (prettySingleMessage res) res@CPRMissingEntryName{} -> @@ -97,10 +97,10 @@ handleCopyOrRenameResult rename = \case CEDestinationIsDirectory{} -> 504 CEEntryAlreadyExists{} -> 505 -handleCopyResult :: CopyResult -> Handler [(EntryPath, EntryPath)] +handleCopyResult :: CopyResult -> Handler [PairObject EntryPath] handleCopyResult = handleCopyOrRenameResult False -handleRenameResult :: RenameResult -> Handler [(EntryPath, EntryPath)] +handleRenameResult :: RenameResult -> Handler [PairObject EntryPath] handleRenameResult = handleCopyOrRenameResult True runBackendIO' :: Sem '[BackendEffect, Error CofferError, Embed IO, Final IO] a -> IO (Either CofferError a) @@ -286,7 +286,7 @@ rename -> QualifiedPath Path -> QualifiedPath Path -> Bool - -> Handler [(EntryPath, EntryPath)] + -> Handler [PairObject EntryPath] rename run token roDryRun roQOldPath roQNewPath roForce = run token (CmdRename RenameOptions { roDryRun @@ -302,7 +302,7 @@ copy' -> QualifiedPath Path -> QualifiedPath Path -> Bool - -> Handler [(EntryPath, EntryPath)] + -> Handler [PairObject EntryPath] copy' run token cpoDryRun cpoQOldPath cpoQNewPath cpoForce = run token (CmdCopy CopyOptions { cpoDryRun diff --git a/lib/Web/Types.hs b/lib/Web/Types.hs index 1a051ec2..83bc3817 100644 --- a/lib/Web/Types.hs +++ b/lib/Web/Types.hs @@ -4,6 +4,7 @@ module Web.Types where +import Data.Aeson qualified as A import Data.Aeson.Casing (aesonPrefix, camelCase) import Data.Aeson.TH (deriveJSON) import Data.HashMap.Strict (HashMap) @@ -30,3 +31,18 @@ deriveJSON (aesonPrefix camelCase) ''NewEntry instance ToSchema NewEntry where declareNamedSchema = genericDeclareNamedSchema $ fromAesonOptions (aesonPrefix camelCase) + +-- | Datatype that serves as a workaround for this issue: +-- https://github.com/biocad/openapi3/issues/31 +data PairObject a = PairObject + { poFirst :: a + , poSecond :: a + } + deriving stock (Show, Eq, Generic) + deriving anyclass (A.ToJSON, A.FromJSON) + +mkPair :: (a, a) -> PairObject a +mkPair (a, b) = PairObject a b + +instance ToSchema a => ToSchema (PairObject a) where + declareNamedSchema = genericDeclareNamedSchema $ fromAesonOptions (aesonPrefix camelCase)