Skip to content
This repository was archived by the owner on Feb 6, 2024. It is now read-only.

Update handle API #94

Merged
merged 3 commits into from
Apr 12, 2019
Merged

Update handle API #94

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
7f7741a
handler: optional deck attrs
nmattia Apr 12, 2019
d0ea047
handler: optional slide content
nmattia Apr 12, 2019
61d430c
handler: protect all slide APIs
nmattia Apr 12, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 12 additions & 12 deletions infra/handler/app/Test.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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)
Expand Down Expand Up @@ -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' :<|>
Expand Down
39 changes: 22 additions & 17 deletions infra/handler/src/DeckGo/Handler.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -253,7 +258,7 @@ data Slide = Slide
instance FromJSONObject Slide where
parseJSONObject = \obj ->
Slide <$>
obj .: "content" <*>
obj .:? "content" .!= "" <*>
obj .: "template" <*>
obj .:? "attributes" .!= HMS.empty

Expand Down Expand Up @@ -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 ->
Expand All @@ -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
Expand All @@ -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 $
Expand All @@ -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
Expand All @@ -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"
Expand Down