fixup! [#114] Swagger API generator

serokell · Aug 22, 2022 · b6bb197 · b6bb197
1 parent 421a615
commit b6bb197
Show file tree

Hide file tree

Showing 6 changed files with 28 additions and 28 deletions.
diff --git a/docs/swagger.json b/docs/swagger.json
@@ -98,7 +98,7 @@
             "FieldName": {
                 "type": "string",
                 "example": "password",
-                "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]*"
+                "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]+"
             },
             "Field": {
                 "type": "object",
@@ -159,7 +159,7 @@
             "EntryTag": {
                 "type": "string",
                 "example": "some-tag",
-                "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]*"
+                "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]+"
             },
             "NewField": {
                 "type": "object",
@@ -509,7 +509,7 @@
                         "schema": {
                             "type": "string",
                             "example": "password",
-                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]*"
+                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]+"
                         }
                     }
                 ],
@@ -917,7 +917,7 @@
                         "schema": {
                             "type": "string",
                             "example": "password",
-                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]*"
+                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]+"
                         }
                     }
                 ]
@@ -1006,7 +1006,7 @@
                         "schema": {
                             "type": "string",
                             "example": "some-tag",
-                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]*"
+                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]+"
                         }
                     }
                 ]
@@ -1093,7 +1093,7 @@
                         "schema": {
                             "type": "string",
                             "example": "some-tag",
-                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]*"
+                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]+"
                         }
                     }
                 ]
@@ -1182,7 +1182,7 @@
                         "schema": {
                             "type": "string",
                             "example": "password",
-                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]*"
+                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]+"
                         }
                     }
                 ]
@@ -1271,7 +1271,7 @@
                         "schema": {
                             "type": "string",
                             "example": "password",
-                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]*"
+                            "pattern": "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_;]+"
                         }
                     }
                 ]

diff --git a/lib/CLI/Types.hs b/lib/CLI/Types.hs
@@ -58,7 +58,6 @@ deriving stock instance Show SomeCommand
 -- Command results
 ----------------------------------------------------------------------------
 
-
 data ViewResult
   = VRDirectory Directory
   | VREntry Entry

diff --git a/lib/Coffer/Instances.hs b/lib/Coffer/Instances.hs
@@ -7,9 +7,11 @@
 -- | Module with orphan instances
 module Coffer.Instances () where
 
-import Control.Lens
+import Data.Data (Proxy(..))
 import Data.OpenApi
+import Data.Text (Text)
 import Servant.Client (BaseUrl)
 
 instance ToSchema BaseUrl where
-  declareNamedSchema _ = pure $ NamedSchema Nothing $ mempty & type_ ?~ OpenApiString
+  declareNamedSchema _ = pure $ NamedSchema Nothing $
+    toSchema @Text Proxy
diff --git a/lib/Coffer/Path.hs b/lib/Coffer/Path.hs
@@ -45,7 +45,7 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Fmt (Buildable, build, pretty)
 import GHC.Generics (Generic)
-import Servant (FromHttpApiData(..), ToHttpApiData(..))
+import Servant (FromHttpApiData(..), Proxy(..), ToHttpApiData(..))
 import Text.Interpolation.Nyan
 
 -- $setup
@@ -67,9 +67,8 @@ instance FromHttpApiData PathSegment where
 
 instance ToSchema PathSegment where
   declareNamedSchema _ = pure $ NamedSchema (Just "PathSegment") $
-    mempty
+    toSchema @Text Proxy
       & Schema.pattern ?~ pathSegmentPattern
-      & type_ ?~ OpenApiString
       & Schema.example ?~ "accounts"
 
 pathSegmentPattern :: Pattern
@@ -98,9 +97,8 @@ newtype Path = Path { unPath :: [PathSegment] }
 
 instance ToParamSchema Path where
   toParamSchema _ =
-    mempty
+    toSchema @Text Proxy
       & Schema.pattern ?~ [int|s|(/#{pathSegmentPattern})*|]
-      & type_ ?~ OpenApiString
       & example ?~ String (toUrlPiece examplePath)
 
 examplePath :: Path
@@ -160,9 +158,8 @@ instance A.ToJSON EntryPath where
 
 instance ToParamSchema EntryPath where
   toParamSchema _ =
-    mempty
+    toSchema @Text Proxy
       & Schema.pattern ?~ [int|s|(/#{pathSegmentPattern})+|]
-      & type_ ?~ OpenApiString
       & example ?~ toJSON exampleEntryPath
 
 instance ToSchema EntryPath where

diff --git a/lib/Entry.hs b/lib/Entry.hs
@@ -40,6 +40,7 @@ import Data.Aeson qualified as A
 import Data.Aeson.Casing
 import Data.Aeson.TH
 import Data.Bifunctor (Bifunctor(first))
+import Data.Data (Proxy(..))
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HS
 import Data.Hashable (Hashable)
@@ -82,12 +83,11 @@ instance ToSchema FieldName where
 
 instance ToParamSchema FieldName where
   toParamSchema _ =
-    mempty
+    toSchema @Text Proxy
       & Schema.pattern ?~ fieldNamePattern
-      & type_ ?~ OpenApiString
       & example ?~ toJSON (either (error . pretty) id $ newFieldName "password")
     where
-      fieldNamePattern = "[" <> T.pack allowedCharSet <> "]*"
+      fieldNamePattern = "[" <> T.pack allowedCharSet <> "]+"
 
 allowedCharSet :: [Char]
 allowedCharSet = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "-_;"
@@ -125,12 +125,11 @@ instance ToSchema EntryTag where
 
 instance ToParamSchema EntryTag where
   toParamSchema _ =
-    mempty
+    toSchema @Text Proxy
       & Schema.pattern ?~ entryTagPattern
-      & type_ ?~ OpenApiString
       & example ?~ toJSON exampleEntryTag
     where
-      entryTagPattern = "[" <> T.pack allowedCharSet <> "]*"
+      entryTagPattern = "[" <> T.pack allowedCharSet <> "]+"
 
 newtype BadEntryTag = BadEntryTag { unBadEntryTag :: Text }
   deriving newtype Buildable
@@ -154,8 +153,8 @@ data FieldVisibility = Public | Private
   deriving anyclass (Hashable)
 
 instance ToSchema FieldVisibility where
-  declareNamedSchema _ = pure $ NamedSchema (Just "FieldVisibility") $ mempty
-    & type_ ?~ OpenApiString
+  declareNamedSchema _ = pure $ NamedSchema (Just "FieldVisibility") $
+    toSchema @Text Proxy
     & enum_ ?~ ["public", "private"]
 
 instance Buildable FieldVisibility where
@@ -180,8 +179,8 @@ newtype FieldContents = FieldContents { unFieldContents :: Text }
 makeLensesFor [("unFieldContents", "fieldContents")] ''FieldContents
 
 instance ToSchema FieldContents where
-  declareNamedSchema _ = pure $ NamedSchema Nothing $ mempty
-    & type_ ?~ OpenApiString
+  declareNamedSchema _ = pure $ NamedSchema Nothing $
+    toSchema @Text Proxy
     & example ?~ toJSON (FieldContents "some-password")
 
 -- | User can use ANSI control sequences in field contents.

diff --git a/lib/Web/API.hs b/lib/Web/API.hs
@@ -13,6 +13,9 @@ import Entry
 import Servant.API
 import Web.Types (CopiedEntry, NewEntry)
 
+-- Note: We can't yet add swagger docs to `QueryParams` and `QueryFlag`.
+-- See: https://github.com/haskell-servant/servant/issues/1602
+
 type API
   = RequiredHeaderDesc "Coffer-Backend" SomeBackend "Details about the backend to connect to."
   :> "api" :> "v1" :> "content" :>