handler: protect all slide APIs

Author: nmattia

infra/handler/app/Test.hs

@@ -42,7 +42,7 @@ main = do
 
   let someSlide = Slide "foo" "bar" HMS.empty
 
-  slideId <- runClientM (slidesPost' someSlide) clientEnv >>= \case
+  slideId <- runClientM (slidesPost' b someSlide) clientEnv >>= \case
     Left err -> error $ "Expected new slide, got error: " <> show err
     Right (Item slideId _) -> pure slideId
 
@@ -62,32 +62,32 @@ main = do
     Right deck ->
       if deck == (Item deckId newDeck) then pure () else (error $ "Expected get deck, got: " <> show deck)
 
-  runClientM slidesGet' clientEnv >>= \case
+  runClientM (slidesGet' b) clientEnv >>= \case
     Left err -> error $ "Expected slides, got error: " <> show err
     Right slides ->
       if slides == [Item slideId someSlide] then pure () else (error $ "Expected slides, got: " <> show slides)
 
   let updatedSlide = Slide "foo" "quux" HMS.empty
 
-  runClientM (slidesPut' slideId updatedSlide) clientEnv >>= \case
+  runClientM (slidesPut' b slideId updatedSlide) clientEnv >>= \case
     Left err -> error $ "Expected new slide, got error: " <> show err
     Right {} -> pure ()
 
-  runClientM slidesGet' clientEnv >>= \case
+  runClientM (slidesGet' b) clientEnv >>= \case
     Left err -> error $ "Expected updated slides, got error: " <> show err
     Right slides ->
       if slides == [Item slideId updatedSlide] then pure () else (error $ "Expected updated slides, got: " <> show slides)
 
-  runClientM (slidesGetSlideId' slideId) clientEnv >>= \case
+  runClientM (slidesGetSlideId' b slideId) clientEnv >>= \case
     Left err -> error $ "Expected updated slide, got error: " <> show err
     Right slide ->
       if slide == (Item slideId updatedSlide) then pure () else (error $ "Expected updated slide, got: " <> show slide)
 
-  runClientM (slidesDelete' slideId) clientEnv >>= \case
+  runClientM (slidesDelete' b slideId) clientEnv >>= \case
     Left err -> error $ "Expected slide delete, got error: " <> show err
     Right {} -> pure ()
 
-  runClientM slidesGet' clientEnv >>= \case
+  runClientM (slidesGet' b) clientEnv >>= \case
     Left err -> error $ "Expected no slides, got error: " <> show err
     Right slides ->
       if slides == [] then pure () else (error $ "Expected no slides, got: " <> show slides)
@@ -135,11 +135,11 @@ decksPost' :: T.Text -> Deck -> ClientM (Item DeckId Deck)
 decksPut' :: T.Text -> DeckId -> Deck -> ClientM (Item DeckId Deck)
 decksDelete' :: T.Text -> DeckId -> ClientM ()
 
-slidesGet' :: ClientM [Item SlideId Slide]
-slidesGetSlideId' :: SlideId -> ClientM (Item SlideId Slide)
-slidesPost' :: Slide -> ClientM (Item SlideId Slide)
-slidesPut' :: SlideId -> Slide -> ClientM (Item SlideId Slide)
-slidesDelete' :: SlideId -> ClientM ()
+slidesGet' :: T.Text -> ClientM [Item SlideId Slide]
+slidesGetSlideId' :: T.Text -> SlideId -> ClientM (Item SlideId Slide)
+slidesPost' :: T.Text -> Slide -> ClientM (Item SlideId Slide)
+slidesPut' :: T.Text -> SlideId -> Slide -> ClientM (Item SlideId Slide)
+slidesDelete' :: T.Text -> SlideId -> ClientM ()
 ((
   usersGet' :<|>
   _usersGetUserId' :<|>

infra/handler/src/DeckGo/Handler.hs

@@ -215,11 +215,16 @@ instance ToParamSchema DeckId where
 -- SLIDES
 
 type SlidesAPI =
-    Get '[JSON] [Item SlideId Slide] :<|>
-    Capture "slide_id" SlideId :> Get '[JSON] (Item SlideId Slide) :<|>
-    ReqBody '[JSON] Slide :> Post '[JSON] (Item SlideId Slide) :<|>
-    Capture "slide_id" SlideId :> ReqBody '[JSON] Slide :> Put '[JSON] (Item SlideId Slide) :<|>
-    Capture "slide_id" SlideId :> Delete '[JSON] ()
+    Protected :> Get '[JSON] [Item SlideId Slide] :<|>
+    Protected :>
+      Capture "slide_id" SlideId :> Get '[JSON] (Item SlideId Slide) :<|>
+    Protected :>
+      ReqBody '[JSON] Slide :> Post '[JSON] (Item SlideId Slide) :<|>
+    Protected :>
+      Capture "slide_id" SlideId :>
+      ReqBody '[JSON] Slide :>
+      Put '[JSON] (Item SlideId Slide) :<|>
+    Protected :> Capture "slide_id" SlideId :> Delete '[JSON] ()
 
 instance ToSchema (Item SlideId Slide) where
   declareNamedSchema _ = pure $ NamedSchema (Just "SlideWithId") mempty
@@ -506,8 +511,8 @@ decksDelete env _ deckId = do
 
 -- SLIDES
 
-slidesGet :: Aws.Env -> Servant.Handler [Item SlideId Slide]
-slidesGet env = do
+slidesGet :: Aws.Env -> Firebase.UserId -> Servant.Handler [Item SlideId Slide]
+slidesGet env _ = do
     res <- runAWS env $ Aws.send $ DynamoDB.scan "Slides"
     case res of
       Right scanResponse ->
@@ -521,8 +526,8 @@ slidesGet env = do
         liftIO $ print e
         Servant.throwError Servant.err500
 
-slidesGetSlideId :: Aws.Env -> SlideId -> Servant.Handler (Item SlideId Slide)
-slidesGetSlideId env slideId = do
+slidesGetSlideId :: Aws.Env -> Firebase.UserId -> SlideId -> Servant.Handler (Item SlideId Slide)
+slidesGetSlideId env _ slideId = do
     res <- runAWS env $ Aws.send $ DynamoDB.getItem "Slides" &
         DynamoDB.giKey .~ HMS.singleton "SlideId" (slideIdToAttributeValue slideId)
     case res of
@@ -547,8 +552,8 @@ slidesGetSlideId env slideId = do
         liftIO $ print e
         Servant.throwError Servant.err500
 
-slidesPost :: Aws.Env -> Slide -> Servant.Handler (Item SlideId Slide)
-slidesPost env slide = do
+slidesPost :: Aws.Env -> Firebase.UserId -> Slide -> Servant.Handler (Item SlideId Slide)
+slidesPost env _ slide = do
     slideId <- liftIO $ SlideId <$> newId
 
     res <- runAWS env $
@@ -563,8 +568,8 @@ slidesPost env slide = do
 
     pure $ Item slideId slide
 
-slidesPut :: Aws.Env -> SlideId -> Slide -> Servant.Handler (Item SlideId Slide)
-slidesPut env slideId slide = do
+slidesPut :: Aws.Env -> Firebase.UserId -> SlideId -> Slide -> Servant.Handler (Item SlideId Slide)
+slidesPut env _ slideId slide = do
 
     res <- runAWS env $ Aws.send $ DynamoDB.updateItem "Slides" &
         DynamoDB.uiUpdateExpression .~ Just
@@ -582,8 +587,8 @@ slidesPut env slideId slide = do
 
     pure $ Item slideId slide
 
-slidesDelete :: Aws.Env -> SlideId -> Servant.Handler ()
-slidesDelete env slideId = do
+slidesDelete :: Aws.Env -> Firebase.UserId -> SlideId -> Servant.Handler ()
+slidesDelete env _ slideId = do
 
     res <- runAWS env $ Aws.send $ DynamoDB.deleteItem "Slides" &
         DynamoDB.diKey .~  HMS.singleton "SlideId"