diff --git a/infra/handler/app/Test.hs b/infra/handler/app/Test.hs index aaaa101ec..ef6ddf81d 100644 --- a/infra/handler/app/Test.hs +++ b/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' :<|> diff --git a/infra/handler/src/DeckGo/Handler.hs b/infra/handler/src/DeckGo/Handler.hs index f2ffdd1e8..78e17304b 100644 --- a/infra/handler/src/DeckGo/Handler.hs +++ b/infra/handler/src/DeckGo/Handler.hs @@ -185,7 +185,7 @@ instance FromJSONObject Deck where <$> obj .: "slides" <*> obj .: "name" <*> obj .: "owner_id" - <*> obj .: "attributes" + <*> obj .:? "attributes" .!= HMS.empty instance ToJSONObject Deck where toJSONObject deck = HMS.fromList @@ -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 @@ -253,7 +258,7 @@ data Slide = Slide instance FromJSONObject Slide where parseJSONObject = \obj -> Slide <$> - obj .: "content" <*> + obj .:? "content" .!= "" <*> obj .: "template" <*> obj .:? "attributes" .!= HMS.empty @@ -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"