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

Commit 310e77b

Browse files
nmattianmattia
committed
handler: feat: move slides API under /decks
1 parent 42b8593 commit 310e77b

File tree

2 files changed

+62
-29
lines changed

2 files changed

+62
-29
lines changed

‎infra/handler/app/Test.hs‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ main = do
4545

4646
let someSlide = Slide "foo" "bar" HMS.empty
4747

48-
slideId <- runClientM (slidesPost' b someSlide) clientEnv >>= \case
48+
slideId <- runClientM (slidesPost' b deckId someSlide) clientEnv >>= \case
4949
Left err -> error $ "Expected new slide, got error: " <> show err
5050
Right (Item slideId _) -> pure slideId
5151

@@ -65,32 +65,32 @@ main = do
6565
Right deck ->
6666
if deck == (Item deckId newDeck) then pure () else (error $ "Expected get deck, got: " <> show deck)
6767

68-
runClientM (slidesGet' b) clientEnv >>= \case
68+
runClientM (slidesGet' b deckId) clientEnv >>= \case
6969
Left err -> error $ "Expected slides, got error: " <> show err
7070
Right slides ->
7171
if slides == [Item slideId someSlide] then pure () else (error $ "Expected slides, got: " <> show slides)
7272

7373
let updatedSlide = Slide "foo" "quux" HMS.empty
7474

75-
runClientM (slidesPut' b slideId updatedSlide) clientEnv >>= \case
75+
runClientM (slidesPut' b deckId slideId updatedSlide) clientEnv >>= \case
7676
Left err -> error $ "Expected new slide, got error: " <> show err
7777
Right {} -> pure ()
7878

79-
runClientM (slidesGet' b) clientEnv >>= \case
79+
runClientM (slidesGet' b deckId) clientEnv >>= \case
8080
Left err -> error $ "Expected updated slides, got error: " <> show err
8181
Right slides ->
8282
if slides == [Item slideId updatedSlide] then pure () else (error $ "Expected updated slides, got: " <> show slides)
8383

84-
runClientM (slidesGetSlideId' b slideId) clientEnv >>= \case
84+
runClientM (slidesGetSlideId' b deckId slideId) clientEnv >>= \case
8585
Left err -> error $ "Expected updated slide, got error: " <> show err
8686
Right slide ->
8787
if slide == (Item slideId updatedSlide) then pure () else (error $ "Expected updated slide, got: " <> show slide)
8888

89-
runClientM (slidesDelete' b slideId) clientEnv >>= \case
89+
runClientM (slidesDelete' b deckId slideId) clientEnv >>= \case
9090
Left err -> error $ "Expected slide delete, got error: " <> show err
9191
Right {} -> pure ()
9292

93-
runClientM (slidesGet' b) clientEnv >>= \case
93+
runClientM (slidesGet' b deckId) clientEnv >>= \case
9494
Left err -> error $ "Expected no slides, got error: " <> show err
9595
Right slides ->
9696
if slides == [] then pure () else (error $ "Expected no slides, got: " <> show slides)
@@ -138,11 +138,11 @@ decksPost' :: T.Text -> Deck -> ClientM (Item DeckId Deck)
138138
decksPut' :: T.Text -> DeckId -> Deck -> ClientM (Item DeckId Deck)
139139
decksDelete' :: T.Text -> DeckId -> ClientM ()
140140

141-
slidesGet' :: T.Text -> ClientM [Item SlideId Slide]
142-
slidesGetSlideId' :: T.Text -> SlideId -> ClientM (Item SlideId Slide)
143-
slidesPost' :: T.Text -> Slide -> ClientM (Item SlideId Slide)
144-
slidesPut' :: T.Text -> SlideId -> Slide -> ClientM (Item SlideId Slide)
145-
slidesDelete' :: T.Text -> SlideId -> ClientM ()
141+
slidesGet' :: T.Text -> DeckId -> ClientM [Item SlideId Slide]
142+
slidesGetSlideId' :: T.Text -> DeckId -> SlideId -> ClientM (Item SlideId Slide)
143+
slidesPost' :: T.Text -> DeckId -> Slide -> ClientM (Item SlideId Slide)
144+
slidesPut' :: T.Text -> DeckId -> SlideId -> Slide -> ClientM (Item SlideId Slide)
145+
slidesDelete' :: T.Text -> DeckId -> SlideId -> ClientM ()
146146
((
147147
usersGet' :<|>
148148
_usersGetUserId' :<|>

‎infra/handler/src/DeckGo/Handler.hs‎

Lines changed: 50 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -136,10 +136,10 @@ instance ToJSONObject User where
136136

137137
instance Aeson.FromJSON User where
138138
parseJSON = Aeson.withObject "User" parseJSONObject
139+
139140
instance Aeson.ToJSON User where
140141
toJSON = Aeson.Object . toJSONObject
141142

142-
143143
instance ToSchema (Item UserId User) where
144144
declareNamedSchema _ = pure $ NamedSchema (Just "UserWithId") mempty
145145

@@ -164,6 +164,7 @@ type DecksAPI =
164164
Capture "deck_id" DeckId :>
165165
ReqBody '[JSON] Deck :> Put '[JSON] (Item DeckId Deck) :<|>
166166
Protected :> Capture "deck_id" DeckId :> Delete '[JSON] ()
167+
-- Capture "deck_id" DeckId :> "slides" :> SlidesAPI
167168

168169
newtype DeckId = DeckId { unDeckId :: T.Text }
169170
deriving newtype (Aeson.FromJSON, Aeson.ToJSON, FromHttpApiData, ToHttpApiData, Show, Eq)
@@ -179,6 +180,24 @@ data Deck = Deck
179180
, deckAttributes :: HMS.HashMap T.Text T.Text
180181
} deriving (Show, Eq)
181182

183+
184+
{-
185+
data Deck = Deck
186+
{ deckSlides :: [SlideId]
187+
, deckOwnerId :: UserId
188+
, deckAttributes :: HMS.HashMap T.Text T.Text
189+
, deckTitle :: T.Text
190+
, deckDescription :: Maybe T.Text
191+
, deckAuthor :: Maybe T.Text
192+
, deckHashTags :: [CI T.Text]
193+
, deckPublicationDate :: Maybe UTCTime
194+
} deriving (Show, Eq)
195+
-}
196+
197+
198+
199+
-- /decks/<deck-id>/publish
200+
182201
instance FromJSONObject Deck where
183202
parseJSONObject = \obj ->
184203
Deck
@@ -215,16 +234,19 @@ instance ToParamSchema DeckId where
215234
-- SLIDES
216235

217236
type SlidesAPI =
218-
Protected :> Get '[JSON] [Item SlideId Slide] :<|>
219-
Protected :>
237+
238+
-- Protected :> Capture "deck_id" DeckId :> Delete '[JSON] ()
239+
Protected :> Capture "deck_id" DeckId :> "slides" :> Get '[JSON] [Item SlideId Slide] :<|>
240+
Protected :> Capture "deck_id" DeckId :> "slides" :>
220241
Capture "slide_id" SlideId :> Get '[JSON] (Item SlideId Slide) :<|>
221-
Protected :>
242+
Protected :> Capture "deck_id" DeckId :> "slides" :>
222243
ReqBody '[JSON] Slide :> Post '[JSON] (Item SlideId Slide) :<|>
223-
Protected :>
244+
Protected :> Capture "deck_id" DeckId :> "slides" :>
224245
Capture "slide_id" SlideId :>
225246
ReqBody '[JSON] Slide :>
226247
Put '[JSON] (Item SlideId Slide) :<|>
227-
Protected :> Capture "slide_id" SlideId :> Delete '[JSON] ()
248+
Protected :> Capture "deck_id" DeckId :> "slides" :>
249+
Capture "slide_id" SlideId :> Delete '[JSON] ()
228250

229251
instance ToSchema (Item SlideId Slide) where
230252
declareNamedSchema _ = pure $ NamedSchema (Just "SlideWithId") mempty
@@ -548,7 +570,18 @@ decksPut env fuid deckId deck = do
548570
pure $ Item deckId deck
549571

550572
decksDelete :: Aws.Env -> Firebase.UserId -> DeckId -> Servant.Handler ()
551-
decksDelete env _ deckId = do
573+
decksDelete env fuid deckId = do
574+
575+
getDeck env deckId >>= \case
576+
Nothing -> do
577+
liftIO $ putStrLn $ unwords
578+
[ "Trying to DELETE", show deckId, "but deck doesn't exist." ]
579+
Servant.throwError Servant.err404
580+
Just Deck{deckOwnerId} -> do
581+
when (Firebase.unUserId fuid /= unFirebaseId (unUserId deckOwnerId)) $ do
582+
liftIO $ putStrLn $ unwords $
583+
[ "Deck was DELETEd", show deckId, "but requester is not the owner", show fuid ]
584+
Servant.throwError Servant.err404
552585

553586
res <- runAWS env $ Aws.send $ DynamoDB.deleteItem "Decks" &
554587
DynamoDB.diKey .~ HMS.singleton "DeckId"
@@ -600,8 +633,8 @@ getDeck env deckId = do
600633

601634
-- SLIDES
602635

603-
slidesGet :: Aws.Env -> Firebase.UserId -> Servant.Handler [Item SlideId Slide]
604-
slidesGet env _ = do
636+
slidesGet :: Aws.Env -> Firebase.UserId -> DeckId -> Servant.Handler [Item SlideId Slide]
637+
slidesGet env _ _ = do
605638
res <- runAWS env $ Aws.send $ DynamoDB.scan "Slides"
606639
case res of
607640
Right scanResponse ->
@@ -615,8 +648,8 @@ slidesGet env _ = do
615648
liftIO $ print e
616649
Servant.throwError Servant.err500
617650

618-
slidesGetSlideId :: Aws.Env -> Firebase.UserId -> SlideId -> Servant.Handler (Item SlideId Slide)
619-
slidesGetSlideId env _ slideId = do
651+
slidesGetSlideId :: Aws.Env -> Firebase.UserId -> DeckId -> SlideId -> Servant.Handler (Item SlideId Slide)
652+
slidesGetSlideId env _ _ slideId = do
620653
res <- runAWS env $ Aws.send $ DynamoDB.getItem "Slides" &
621654
DynamoDB.giKey .~ HMS.singleton "SlideId" (slideIdToAttributeValue slideId)
622655
case res of
@@ -641,8 +674,8 @@ slidesGetSlideId env _ slideId = do
641674
liftIO $ print e
642675
Servant.throwError Servant.err500
643676

644-
slidesPost :: Aws.Env -> Firebase.UserId -> Slide -> Servant.Handler (Item SlideId Slide)
645-
slidesPost env _ slide = do
677+
slidesPost :: Aws.Env -> Firebase.UserId -> DeckId -> Slide -> Servant.Handler (Item SlideId Slide)
678+
slidesPost env _ _ slide = do
646679
slideId <- liftIO $ SlideId <$> newId
647680

648681
res <- runAWS env $
@@ -657,8 +690,8 @@ slidesPost env _ slide = do
657690

658691
pure $ Item slideId slide
659692

660-
slidesPut :: Aws.Env -> Firebase.UserId -> SlideId -> Slide -> Servant.Handler (Item SlideId Slide)
661-
slidesPut env _ slideId slide = do
693+
slidesPut :: Aws.Env -> Firebase.UserId -> DeckId -> SlideId -> Slide -> Servant.Handler (Item SlideId Slide)
694+
slidesPut env _ _ slideId slide = do
662695

663696
res <- runAWS env $ Aws.send $ DynamoDB.updateItem "Slides" &
664697
DynamoDB.uiUpdateExpression .~ Just
@@ -676,8 +709,8 @@ slidesPut env _ slideId slide = do
676709

677710
pure $ Item slideId slide
678711

679-
slidesDelete :: Aws.Env -> Firebase.UserId -> SlideId -> Servant.Handler ()
680-
slidesDelete env _ slideId = do
712+
slidesDelete :: Aws.Env -> Firebase.UserId -> DeckId -> SlideId -> Servant.Handler ()
713+
slidesDelete env _ _ slideId = do
681714

682715
res <- runAWS env $ Aws.send $ DynamoDB.deleteItem "Slides" &
683716
DynamoDB.diKey .~ HMS.singleton "SlideId"

0 commit comments

Comments
 (0)