handler: swagger the whole API

Author: nmattia

infra/firebase-login/package.yaml

@@ -18,6 +18,7 @@ dependencies:
     - servant
     - servant-client-core
     - servant-server
+    - servant-swagger
     - text
     - unordered-containers
     - wai

infra/firebase-login/src/Servant/Auth/Firebase.hs

@@ -17,6 +17,7 @@ import Control.Monad.Except
 import Data.Proxy
 import Data.Word8 (isSpace, toLower)
 import Servant.API
+import qualified Servant.Swagger as Servant
 import qualified Crypto.JOSE.JWK as JWK
 import qualified Network.URI as URI
 import qualified Crypto.JWT as JWT
@@ -154,3 +155,6 @@ instance
 
   hoistServerWithContext Proxy p hoist s = \uid ->
     Servant.hoistServerWithContext (Proxy :: Proxy sub) p hoist (s uid)
+
+instance Servant.HasSwagger sub => Servant.HasSwagger (Protected :> sub) where
+  toSwagger Proxy = Servant.toSwagger (Proxy :: Proxy sub)

infra/handler/app/Swagger.hs

@@ -26,7 +26,7 @@ swagger :: Swagger.Swagger
 swagger = Servant.toSwagger (Proxy :: Proxy DeckGo.Handler.SlidesAPI)
 
 dumpSwagger :: FilePath -> IO ()
-dumpSwagger out = Servant.swaggerSchemaUiDump out swaggerApi (Proxy :: Proxy DeckGo.Handler.SlidesAPI)
+dumpSwagger out = Servant.swaggerSchemaUiDump out swaggerApi DeckGo.Handler.api
 
 serveSwagger :: IO ()
 serveSwagger =

infra/handler/src/DeckGo/Handler.hs

@@ -17,6 +17,10 @@
 module DeckGo.Handler where
 
 -- TODO: double check what is returned on 200 from DynamoDB
+-- TODO: check user is in DB
+-- TODO: check permissions
+-- TODO: created_at, updated_at
+-- TODO: TTL on anonymous users
 
 import Control.Lens hiding ((.=))
 import Control.Monad
@@ -119,7 +123,7 @@ instance FromJSONObject User where
     User
       -- potentially return "error exists" + user object
       <$> obj .: "firebase_uid"
-      <*> obj .: "anonymous" -- TODO: TTL
+      <*> obj .: "anonymous"
 
 instance ToJSONObject User where
   toJSONObject user = HMS.fromList
@@ -131,9 +135,19 @@ instance Aeson.FromJSON User where
   parseJSON = Aeson.withObject "User" parseJSONObject
 instance Aeson.ToJSON User where
   toJSON = Aeson.Object . toJSONObject
--- TODO: check user is in DB
--- TODO: check permissions
--- TODO: created_at, updated_at
+
+
+instance ToSchema (Item UserId User) where
+  declareNamedSchema _ = pure $ NamedSchema (Just "UserWithId") mempty
+
+instance ToSchema User where
+  declareNamedSchema _ = pure $ NamedSchema (Just "User") mempty
+
+instance ToParamSchema (Item UserId User) where
+  toParamSchema _ = mempty
+
+instance ToParamSchema UserId where
+  toParamSchema _ = mempty
 
 -- DECKS
 
@@ -180,6 +194,18 @@ instance Aeson.FromJSON Deck where
 instance Aeson.ToJSON Deck where
   toJSON = Aeson.Object . toJSONObject
 
+instance ToSchema (Item DeckId Deck) where
+  declareNamedSchema _ = pure $ NamedSchema (Just "DeckWithId") mempty
+
+instance ToSchema Deck where
+  declareNamedSchema _ = pure $ NamedSchema (Just "Deck") mempty
+
+instance ToParamSchema (Item DeckId Deck) where
+  toParamSchema _ = mempty
+
+instance ToParamSchema DeckId where
+  toParamSchema _ = mempty
+
 -- SLIDES
 
 type SlidesAPI =