From 310e77bb019e428c75c732d35d109d8169ac843d Mon Sep 17 00:00:00 2001 From: Nicolas Mattia Date: Fri, 19 Apr 2019 14:15:17 +0200 Subject: [PATCH 1/6] handler: feat: move slides API under /decks --- infra/handler/app/Test.hs | 24 +++++------ infra/handler/src/DeckGo/Handler.hs | 67 +++++++++++++++++++++-------- 2 files changed, 62 insertions(+), 29 deletions(-) diff --git a/infra/handler/app/Test.hs b/infra/handler/app/Test.hs index a19c0d372..d2e6d02f3 100644 --- a/infra/handler/app/Test.hs +++ b/infra/handler/app/Test.hs @@ -45,7 +45,7 @@ main = do let someSlide = Slide "foo" "bar" HMS.empty - slideId <- runClientM (slidesPost' b someSlide) clientEnv >>= \case + slideId <- runClientM (slidesPost' b deckId someSlide) clientEnv >>= \case Left err -> error $ "Expected new slide, got error: " <> show err Right (Item slideId _) -> pure slideId @@ -65,32 +65,32 @@ main = do Right deck -> if deck == (Item deckId newDeck) then pure () else (error $ "Expected get deck, got: " <> show deck) - runClientM (slidesGet' b) clientEnv >>= \case + runClientM (slidesGet' b deckId) 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' b slideId updatedSlide) clientEnv >>= \case + runClientM (slidesPut' b deckId slideId updatedSlide) clientEnv >>= \case Left err -> error $ "Expected new slide, got error: " <> show err Right {} -> pure () - runClientM (slidesGet' b) clientEnv >>= \case + runClientM (slidesGet' b deckId) 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' b slideId) clientEnv >>= \case + runClientM (slidesGetSlideId' b deckId 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' b slideId) clientEnv >>= \case + runClientM (slidesDelete' b deckId slideId) clientEnv >>= \case Left err -> error $ "Expected slide delete, got error: " <> show err Right {} -> pure () - runClientM (slidesGet' b) clientEnv >>= \case + runClientM (slidesGet' b deckId) 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) @@ -138,11 +138,11 @@ decksPost' :: T.Text -> Deck -> ClientM (Item DeckId Deck) decksPut' :: T.Text -> DeckId -> Deck -> ClientM (Item DeckId Deck) decksDelete' :: T.Text -> DeckId -> 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 () +slidesGet' :: T.Text -> DeckId -> ClientM [Item SlideId Slide] +slidesGetSlideId' :: T.Text -> DeckId -> SlideId -> ClientM (Item SlideId Slide) +slidesPost' :: T.Text -> DeckId -> Slide -> ClientM (Item SlideId Slide) +slidesPut' :: T.Text -> DeckId -> SlideId -> Slide -> ClientM (Item SlideId Slide) +slidesDelete' :: T.Text -> DeckId -> SlideId -> ClientM () (( usersGet' :<|> _usersGetUserId' :<|> diff --git a/infra/handler/src/DeckGo/Handler.hs b/infra/handler/src/DeckGo/Handler.hs index cf4b6dd8a..ea0c09e12 100644 --- a/infra/handler/src/DeckGo/Handler.hs +++ b/infra/handler/src/DeckGo/Handler.hs @@ -136,10 +136,10 @@ instance ToJSONObject User where instance Aeson.FromJSON User where parseJSON = Aeson.withObject "User" parseJSONObject + instance Aeson.ToJSON User where toJSON = Aeson.Object . toJSONObject - instance ToSchema (Item UserId User) where declareNamedSchema _ = pure $ NamedSchema (Just "UserWithId") mempty @@ -164,6 +164,7 @@ type DecksAPI = Capture "deck_id" DeckId :> ReqBody '[JSON] Deck :> Put '[JSON] (Item DeckId Deck) :<|> Protected :> Capture "deck_id" DeckId :> Delete '[JSON] () + -- Capture "deck_id" DeckId :> "slides" :> SlidesAPI newtype DeckId = DeckId { unDeckId :: T.Text } deriving newtype (Aeson.FromJSON, Aeson.ToJSON, FromHttpApiData, ToHttpApiData, Show, Eq) @@ -179,6 +180,24 @@ data Deck = Deck , deckAttributes :: HMS.HashMap T.Text T.Text } deriving (Show, Eq) + +{- +data Deck = Deck + { deckSlides :: [SlideId] + , deckOwnerId :: UserId + , deckAttributes :: HMS.HashMap T.Text T.Text + , deckTitle :: T.Text + , deckDescription :: Maybe T.Text + , deckAuthor :: Maybe T.Text + , deckHashTags :: [CI T.Text] + , deckPublicationDate :: Maybe UTCTime + } deriving (Show, Eq) +-} + + + +-- /decks//publish + instance FromJSONObject Deck where parseJSONObject = \obj -> Deck @@ -215,16 +234,19 @@ instance ToParamSchema DeckId where -- SLIDES type SlidesAPI = - Protected :> Get '[JSON] [Item SlideId Slide] :<|> - Protected :> + + -- Protected :> Capture "deck_id" DeckId :> Delete '[JSON] () + Protected :> Capture "deck_id" DeckId :> "slides" :> Get '[JSON] [Item SlideId Slide] :<|> + Protected :> Capture "deck_id" DeckId :> "slides" :> Capture "slide_id" SlideId :> Get '[JSON] (Item SlideId Slide) :<|> - Protected :> + Protected :> Capture "deck_id" DeckId :> "slides" :> ReqBody '[JSON] Slide :> Post '[JSON] (Item SlideId Slide) :<|> - Protected :> + Protected :> Capture "deck_id" DeckId :> "slides" :> Capture "slide_id" SlideId :> ReqBody '[JSON] Slide :> Put '[JSON] (Item SlideId Slide) :<|> - Protected :> Capture "slide_id" SlideId :> Delete '[JSON] () + Protected :> Capture "deck_id" DeckId :> "slides" :> + Capture "slide_id" SlideId :> Delete '[JSON] () instance ToSchema (Item SlideId Slide) where declareNamedSchema _ = pure $ NamedSchema (Just "SlideWithId") mempty @@ -548,7 +570,18 @@ decksPut env fuid deckId deck = do pure $ Item deckId deck decksDelete :: Aws.Env -> Firebase.UserId -> DeckId -> Servant.Handler () -decksDelete env _ deckId = do +decksDelete env fuid deckId = do + + getDeck env deckId >>= \case + Nothing -> do + liftIO $ putStrLn $ unwords + [ "Trying to DELETE", show deckId, "but deck doesn't exist." ] + Servant.throwError Servant.err404 + Just Deck{deckOwnerId} -> do + when (Firebase.unUserId fuid /= unFirebaseId (unUserId deckOwnerId)) $ do + liftIO $ putStrLn $ unwords $ + [ "Deck was DELETEd", show deckId, "but requester is not the owner", show fuid ] + Servant.throwError Servant.err404 res <- runAWS env $ Aws.send $ DynamoDB.deleteItem "Decks" & DynamoDB.diKey .~ HMS.singleton "DeckId" @@ -600,8 +633,8 @@ getDeck env deckId = do -- SLIDES -slidesGet :: Aws.Env -> Firebase.UserId -> Servant.Handler [Item SlideId Slide] -slidesGet env _ = do +slidesGet :: Aws.Env -> Firebase.UserId -> DeckId -> Servant.Handler [Item SlideId Slide] +slidesGet env _ _ = do res <- runAWS env $ Aws.send $ DynamoDB.scan "Slides" case res of Right scanResponse -> @@ -615,8 +648,8 @@ slidesGet env _ = do liftIO $ print e Servant.throwError Servant.err500 -slidesGetSlideId :: Aws.Env -> Firebase.UserId -> SlideId -> Servant.Handler (Item SlideId Slide) -slidesGetSlideId env _ slideId = do +slidesGetSlideId :: Aws.Env -> Firebase.UserId -> DeckId -> 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 @@ -641,8 +674,8 @@ slidesGetSlideId env _ slideId = do liftIO $ print e Servant.throwError Servant.err500 -slidesPost :: Aws.Env -> Firebase.UserId -> Slide -> Servant.Handler (Item SlideId Slide) -slidesPost env _ slide = do +slidesPost :: Aws.Env -> Firebase.UserId -> DeckId -> Slide -> Servant.Handler (Item SlideId Slide) +slidesPost env _ _ slide = do slideId <- liftIO $ SlideId <$> newId res <- runAWS env $ @@ -657,8 +690,8 @@ slidesPost env _ slide = do pure $ Item slideId slide -slidesPut :: Aws.Env -> Firebase.UserId -> SlideId -> Slide -> Servant.Handler (Item SlideId Slide) -slidesPut env _ slideId slide = do +slidesPut :: Aws.Env -> Firebase.UserId -> DeckId -> SlideId -> Slide -> Servant.Handler (Item SlideId Slide) +slidesPut env _ _ slideId slide = do res <- runAWS env $ Aws.send $ DynamoDB.updateItem "Slides" & DynamoDB.uiUpdateExpression .~ Just @@ -676,8 +709,8 @@ slidesPut env _ slideId slide = do pure $ Item slideId slide -slidesDelete :: Aws.Env -> Firebase.UserId -> SlideId -> Servant.Handler () -slidesDelete env _ slideId = do +slidesDelete :: Aws.Env -> Firebase.UserId -> DeckId -> SlideId -> Servant.Handler () +slidesDelete env _ _ slideId = do res <- runAWS env $ Aws.send $ DynamoDB.deleteItem "Slides" & DynamoDB.diKey .~ HMS.singleton "SlideId" From 3eeaec0a0680c43e55c11961c1300ffc467c2b8e Mon Sep 17 00:00:00 2001 From: Nicolas Mattia Date: Fri, 19 Apr 2019 14:22:44 +0200 Subject: [PATCH 2/6] handler: feat: protect GET slids --- infra/handler/src/DeckGo/Handler.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/infra/handler/src/DeckGo/Handler.hs b/infra/handler/src/DeckGo/Handler.hs index ea0c09e12..5050d93d4 100644 --- a/infra/handler/src/DeckGo/Handler.hs +++ b/infra/handler/src/DeckGo/Handler.hs @@ -634,7 +634,19 @@ getDeck env deckId = do -- SLIDES slidesGet :: Aws.Env -> Firebase.UserId -> DeckId -> Servant.Handler [Item SlideId Slide] -slidesGet env _ _ = do +slidesGet env fuid deckId = do + + getDeck env deckId >>= \case + Nothing -> do + liftIO $ putStrLn $ unwords + [ "Trying to GET slides for", show deckId, "but deck doesn't exist." ] + Servant.throwError Servant.err404 + Just deck@Deck{deckOwnerId, deckSlides} -> do + when (Firebase.unUserId fuid /= unFirebaseId (unUserId deckOwnerId)) $ do + liftIO $ putStrLn $ unwords $ + [ "Slides were requested for ", show deck, "but requester is not the owner", show fuid ] + Servant.throwError Servant.err404 + res <- runAWS env $ Aws.send $ DynamoDB.scan "Slides" case res of Right scanResponse -> From 3c2f26bd579aa997496054c8abc84425f768f157 Mon Sep 17 00:00:00 2001 From: Nicolas Mattia Date: Fri, 19 Apr 2019 14:33:37 +0200 Subject: [PATCH 3/6] handler: feat: remove GET slides --- infra/handler/app/Test.hs | 17 --------------- infra/handler/src/DeckGo/Handler.hs | 32 ----------------------------- 2 files changed, 49 deletions(-) diff --git a/infra/handler/app/Test.hs b/infra/handler/app/Test.hs index d2e6d02f3..e4b6d366e 100644 --- a/infra/handler/app/Test.hs +++ b/infra/handler/app/Test.hs @@ -65,22 +65,12 @@ main = do Right deck -> if deck == (Item deckId newDeck) then pure () else (error $ "Expected get deck, got: " <> show deck) - runClientM (slidesGet' b deckId) 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' b deckId slideId updatedSlide) clientEnv >>= \case Left err -> error $ "Expected new slide, got error: " <> show err Right {} -> pure () - runClientM (slidesGet' b deckId) 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' b deckId slideId) clientEnv >>= \case Left err -> error $ "Expected updated slide, got error: " <> show err Right slide -> @@ -90,11 +80,6 @@ main = do Left err -> error $ "Expected slide delete, got error: " <> show err Right {} -> pure () - runClientM (slidesGet' b deckId) 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) - runClientM (decksDelete' b deckId) clientEnv >>= \case Left err -> error $ "Expected deck delete, got error: " <> show err Right {} -> pure () @@ -138,7 +123,6 @@ decksPost' :: T.Text -> Deck -> ClientM (Item DeckId Deck) decksPut' :: T.Text -> DeckId -> Deck -> ClientM (Item DeckId Deck) decksDelete' :: T.Text -> DeckId -> ClientM () -slidesGet' :: T.Text -> DeckId -> ClientM [Item SlideId Slide] slidesGetSlideId' :: T.Text -> DeckId -> SlideId -> ClientM (Item SlideId Slide) slidesPost' :: T.Text -> DeckId -> Slide -> ClientM (Item SlideId Slide) slidesPut' :: T.Text -> DeckId -> SlideId -> Slide -> ClientM (Item SlideId Slide) @@ -158,7 +142,6 @@ slidesDelete' :: T.Text -> DeckId -> SlideId -> ClientM () decksDelete' ) :<|> ( - slidesGet' :<|> slidesGetSlideId' :<|> slidesPost' :<|> slidesPut' :<|> diff --git a/infra/handler/src/DeckGo/Handler.hs b/infra/handler/src/DeckGo/Handler.hs index 5050d93d4..e5dc0af14 100644 --- a/infra/handler/src/DeckGo/Handler.hs +++ b/infra/handler/src/DeckGo/Handler.hs @@ -164,7 +164,6 @@ type DecksAPI = Capture "deck_id" DeckId :> ReqBody '[JSON] Deck :> Put '[JSON] (Item DeckId Deck) :<|> Protected :> Capture "deck_id" DeckId :> Delete '[JSON] () - -- Capture "deck_id" DeckId :> "slides" :> SlidesAPI newtype DeckId = DeckId { unDeckId :: T.Text } deriving newtype (Aeson.FromJSON, Aeson.ToJSON, FromHttpApiData, ToHttpApiData, Show, Eq) @@ -234,9 +233,6 @@ instance ToParamSchema DeckId where -- SLIDES type SlidesAPI = - - -- Protected :> Capture "deck_id" DeckId :> Delete '[JSON] () - Protected :> Capture "deck_id" DeckId :> "slides" :> Get '[JSON] [Item SlideId Slide] :<|> Protected :> Capture "deck_id" DeckId :> "slides" :> Capture "slide_id" SlideId :> Get '[JSON] (Item SlideId Slide) :<|> Protected :> Capture "deck_id" DeckId :> "slides" :> @@ -331,7 +327,6 @@ server env = serveUsers :<|> serveDecks :<|> serveSlides decksPut env :<|> decksDelete env serveSlides = - slidesGet env :<|> slidesGetSlideId env :<|> slidesPost env :<|> slidesPut env :<|> @@ -633,33 +628,6 @@ getDeck env deckId = do -- SLIDES -slidesGet :: Aws.Env -> Firebase.UserId -> DeckId -> Servant.Handler [Item SlideId Slide] -slidesGet env fuid deckId = do - - getDeck env deckId >>= \case - Nothing -> do - liftIO $ putStrLn $ unwords - [ "Trying to GET slides for", show deckId, "but deck doesn't exist." ] - Servant.throwError Servant.err404 - Just deck@Deck{deckOwnerId, deckSlides} -> do - when (Firebase.unUserId fuid /= unFirebaseId (unUserId deckOwnerId)) $ do - liftIO $ putStrLn $ unwords $ - [ "Slides were requested for ", show deck, "but requester is not the owner", show fuid ] - Servant.throwError Servant.err404 - - res <- runAWS env $ Aws.send $ DynamoDB.scan "Slides" - case res of - Right scanResponse -> - case sequence $ scanResponse ^. DynamoDB.srsItems <&> itemToSlide of - Nothing -> do - liftIO $ putStrLn $ "Could not parse respose: " <> show scanResponse - Servant.throwError Servant.err500 - Just ids -> pure ids - - Left e -> do - liftIO $ print e - Servant.throwError Servant.err500 - slidesGetSlideId :: Aws.Env -> Firebase.UserId -> DeckId -> SlideId -> Servant.Handler (Item SlideId Slide) slidesGetSlideId env _ _ slideId = do res <- runAWS env $ Aws.send $ DynamoDB.getItem "Slides" & From da6eef8163b08190dbc93de0c6304e112b1b6f63 Mon Sep 17 00:00:00 2001 From: Nicolas Mattia Date: Fri, 19 Apr 2019 14:42:34 +0200 Subject: [PATCH 4/6] handler: feat: protect slide post --- infra/handler/src/DeckGo/Handler.hs | 38 +++++++++++++++++++++++++++-- 1 file changed, 36 insertions(+), 2 deletions(-) diff --git a/infra/handler/src/DeckGo/Handler.hs b/infra/handler/src/DeckGo/Handler.hs index e5dc0af14..c1254faaf 100644 --- a/infra/handler/src/DeckGo/Handler.hs +++ b/infra/handler/src/DeckGo/Handler.hs @@ -629,7 +629,27 @@ getDeck env deckId = do -- SLIDES slidesGetSlideId :: Aws.Env -> Firebase.UserId -> DeckId -> SlideId -> Servant.Handler (Item SlideId Slide) -slidesGetSlideId env _ _ slideId = do +slidesGetSlideId env fuid deckId slideId = do + + getDeck env deckId >>= \case + Nothing -> do + liftIO $ putStrLn $ unwords + [ "Trying to GET slide", show slideId, "of deck", show deckId + , "but deck doesn't exist." ] + Servant.throwError Servant.err404 + Just deck@Deck{deckOwnerId, deckSlides} -> do + when (Firebase.unUserId fuid /= unFirebaseId (unUserId deckOwnerId)) $ do + liftIO $ putStrLn $ unwords $ + [ "Trying to GET slide", show slideId, "of deck", show deck + , "but requester is not the owner", show fuid ] + Servant.throwError Servant.err404 + + unless (slideId `elem` deckSlides) $ do + liftIO $ putStrLn $ unwords $ + [ "Trying to GET slide", show slideId, "of deck", show deck + , "but slide doesn't belong to deck owned by", show fuid ] + Servant.throwError Servant.err404 + res <- runAWS env $ Aws.send $ DynamoDB.getItem "Slides" & DynamoDB.giKey .~ HMS.singleton "SlideId" (slideIdToAttributeValue slideId) case res of @@ -655,7 +675,21 @@ slidesGetSlideId env _ _ slideId = do Servant.throwError Servant.err500 slidesPost :: Aws.Env -> Firebase.UserId -> DeckId -> Slide -> Servant.Handler (Item SlideId Slide) -slidesPost env _ _ slide = do +slidesPost env fuid deckId slide = do + + getDeck env deckId >>= \case + Nothing -> do + liftIO $ putStrLn $ unwords + [ "Trying to POST slide", show slide, "of deck", show deckId + , "but deck doesn't exist." ] + Servant.throwError Servant.err404 + Just deck@Deck{deckOwnerId} -> do + when (Firebase.unUserId fuid /= unFirebaseId (unUserId deckOwnerId)) $ do + liftIO $ putStrLn $ unwords $ + [ "Trying to POST slide", show slide, "of deck", show deck + , "but requester is not the owner", show fuid ] + Servant.throwError Servant.err404 + slideId <- liftIO $ SlideId <$> newId res <- runAWS env $ From b07280f966f92e1c6c5ced6c7999f2113ae1b9bc Mon Sep 17 00:00:00 2001 From: Nicolas Mattia Date: Fri, 19 Apr 2019 14:43:49 +0200 Subject: [PATCH 5/6] handler: feat: protect slide put and del --- infra/handler/src/DeckGo/Handler.hs | 42 +++++++++++++++++++++++++++-- 1 file changed, 40 insertions(+), 2 deletions(-) diff --git a/infra/handler/src/DeckGo/Handler.hs b/infra/handler/src/DeckGo/Handler.hs index c1254faaf..c7d3cc4f1 100644 --- a/infra/handler/src/DeckGo/Handler.hs +++ b/infra/handler/src/DeckGo/Handler.hs @@ -705,7 +705,26 @@ slidesPost env fuid deckId slide = do pure $ Item slideId slide slidesPut :: Aws.Env -> Firebase.UserId -> DeckId -> SlideId -> Slide -> Servant.Handler (Item SlideId Slide) -slidesPut env _ _ slideId slide = do +slidesPut env fuid deckId slideId slide = do + + getDeck env deckId >>= \case + Nothing -> do + liftIO $ putStrLn $ unwords + [ "Trying to PUT slide", show slideId, "of deck", show deckId + , "but deck doesn't exist." ] + Servant.throwError Servant.err404 + Just deck@Deck{deckOwnerId, deckSlides} -> do + when (Firebase.unUserId fuid /= unFirebaseId (unUserId deckOwnerId)) $ do + liftIO $ putStrLn $ unwords $ + [ "Trying to PUT slide", show slideId, "of deck", show deck + , "but requester is not the owner", show fuid ] + Servant.throwError Servant.err404 + + unless (slideId `elem` deckSlides) $ do + liftIO $ putStrLn $ unwords $ + [ "Trying to PUT slide", show slideId, "of deck", show deck + , "but slide doesn't belong to deck owned by", show fuid ] + Servant.throwError Servant.err404 res <- runAWS env $ Aws.send $ DynamoDB.updateItem "Slides" & DynamoDB.uiUpdateExpression .~ Just @@ -724,7 +743,26 @@ slidesPut env _ _ slideId slide = do pure $ Item slideId slide slidesDelete :: Aws.Env -> Firebase.UserId -> DeckId -> SlideId -> Servant.Handler () -slidesDelete env _ _ slideId = do +slidesDelete env fuid deckId slideId = do + + getDeck env deckId >>= \case + Nothing -> do + liftIO $ putStrLn $ unwords + [ "Trying to DELETE slide", show slideId, "of deck", show deckId + , "but deck doesn't exist." ] + Servant.throwError Servant.err404 + Just deck@Deck{deckOwnerId, deckSlides} -> do + when (Firebase.unUserId fuid /= unFirebaseId (unUserId deckOwnerId)) $ do + liftIO $ putStrLn $ unwords $ + [ "Trying to DELETE slide", show slideId, "of deck", show deck + , "but requester is not the owner", show fuid ] + Servant.throwError Servant.err404 + + unless (slideId `elem` deckSlides) $ do + liftIO $ putStrLn $ unwords $ + [ "Trying to DELETE slide", show slideId, "of deck", show deck + , "but slide doesn't belong to deck owned by", show fuid ] + Servant.throwError Servant.err404 res <- runAWS env $ Aws.send $ DynamoDB.deleteItem "Slides" & DynamoDB.diKey .~ HMS.singleton "SlideId" From e59f92fd80e0e597cd047effa894c6d8c6a4b647 Mon Sep 17 00:00:00 2001 From: Nicolas Mattia Date: Fri, 19 Apr 2019 14:50:22 +0200 Subject: [PATCH 6/6] handler: fix: fix slides api --- infra/handler/src/DeckGo/Handler.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/infra/handler/src/DeckGo/Handler.hs b/infra/handler/src/DeckGo/Handler.hs index c7d3cc4f1..5b0a1afe4 100644 --- a/infra/handler/src/DeckGo/Handler.hs +++ b/infra/handler/src/DeckGo/Handler.hs @@ -295,7 +295,7 @@ instance Aeson.ToJSON Slide where type API = "users" :> UsersAPI :<|> "decks" :> DecksAPI :<|> - "slides" :> SlidesAPI + "decks" :> SlidesAPI api :: Proxy API api = Proxy