handler: implement users

Author: nmattia

infra/default.nix

@@ -51,6 +51,15 @@ rec
       export AWS_ACCESS_KEY_ID=dummy
       export AWS_SECRET_ACCESS_KEY=dummy
 
+      aws dynamodb create-table \
+        --table-name Users \
+        --attribute-definitions \
+            AttributeName=UserId,AttributeType=S \
+        --key-schema AttributeName=UserId,KeyType=HASH \
+        --endpoint-url http://127.0.0.1:8000 \
+        --provisioned-throughput ReadCapacityUnits=1,WriteCapacityUnits=1 \
+        > /dev/null
+
       aws dynamodb create-table \
         --table-name Decks \
         --attribute-definitions \

infra/dynamo.tf

@@ -1,4 +1,16 @@
-resource "aws_dynamodb_table" "deckdeckgo-test-dynamodb-table" {
+resource "aws_dynamodb_table" "deckdeckgo-test-dynamodb-table-users" {
+  name           = "Users"
+  billing_mode   = "PAY_PER_REQUEST"
+  hash_key       = "UserId"
+
+  attribute {
+    name = "UserId"
+    type = "S"
+  }
+
+}
+
+resource "aws_dynamodb_table" "deckdeckgo-test-dynamodb-table-decks" {
   name           = "Decks"
   billing_mode   = "PAY_PER_REQUEST"
   hash_key       = "DeckId"

infra/handler/app/Swagger.hs

@@ -11,23 +11,22 @@ import qualified Servant as Servant
 import qualified Servant.Swagger as Servant
 import qualified Servant.Swagger.UI.Extended as Servant
 
--- | API type with bells and whistles, i.e. schema file and swagger-ui.
-type SwaggerAPI = Servant.SwaggerSchemaUI "" "swagger.json"
+type SwaggerAPI = Servant.SwaggerSchemaUI "swagger-ui" "swagger.json"
 
 swaggerApi :: Proxy SwaggerAPI
 swaggerApi = Proxy
 
 main :: IO ()
-main = serverSwagger
+main = serveSwagger
 
 swagger :: Swagger.Swagger
 swagger = Servant.toSwagger (Proxy :: Proxy DeckGo.Handler.SlidesAPI)
 
 dumpSwagger :: FilePath -> IO ()
 dumpSwagger out = Servant.swaggerSchemaUiDump out swaggerApi (Proxy :: Proxy DeckGo.Handler.SlidesAPI)
 
-serverSwagger :: IO ()
-serverSwagger =
+serveSwagger :: IO ()
+serveSwagger =
   Warp.run 3000 $
     Servant.serve swaggerApi $
     Servant.swaggerSchemaUIServer swagger

infra/handler/app/Test.hs

@@ -20,12 +20,17 @@ main = do
 
   let clientEnv = mkClientEnv manager' (BaseUrl Http "localhost" 8080 "")
 
+  runClientM usersGet' clientEnv >>= \case
+    Left err -> error $ "Expected users, got error: " <> show err
+    Right [] -> pure ()
+    Right decks -> error $ "Expected 0 users, got: " <> show decks
+
   runClientM (decksGet' b) clientEnv >>= \case
     Left err -> error $ "Expected decks, got error: " <> show err
     Right [] -> pure ()
     Right decks -> error $ "Expected 0 decks, got: " <> show decks
 
-  let someDeck = Deck { deckSlides = [] }
+  let someDeck = Deck { deckSlides = [] , deckDeckname = Deckname "foo" }
 
   deckId <- runClientM (decksPost' someDeck) clientEnv >>= \case
     Left err -> error $ "Expected new deck, got error: " <> show err
@@ -37,7 +42,7 @@ main = do
     Left err -> error $ "Expected new slide, got error: " <> show err
     Right (WithId slideId _) -> pure slideId
 
-  let newDeck = Deck { deckSlides = [ slideId ] }
+  let newDeck = Deck { deckSlides = [ slideId ], deckDeckname = Deckname "bar" }
 
   runClientM (decksPut' b deckId newDeck) clientEnv >>= \case
     Left err -> error $ "Expected updated deck, got error: " <> show err
@@ -92,18 +97,32 @@ main = do
     Right decks ->
       if decks == [] then pure () else (error $ "Expected no decks, got: " <> show decks)
 
--- 'client' allows you to produce operations to query an API from a client.
+
+usersGet' :: ClientM [WithId UserId User]
+_usersGetUserId' :: UserId -> ClientM (WithId UserId User)
+_usersPost' :: T.Text -> User -> ClientM (WithId UserId User)
+_usersPut' :: T.Text -> UserId -> User -> ClientM (WithId UserId User)
+_usersDelete' :: T.Text -> UserId -> ClientM ()
+
 decksGet' :: T.Text -> ClientM [WithId DeckId Deck]
 decksGetDeckId' :: T.Text -> DeckId -> ClientM (WithId DeckId Deck)
 decksPost' :: Deck -> ClientM (WithId DeckId Deck)
 decksPut' :: T.Text -> DeckId -> Deck -> ClientM (WithId DeckId Deck)
 decksDelete' :: T.Text -> DeckId -> ClientM ()
+
 slidesGet' :: ClientM [WithId SlideId Slide]
 slidesGetSlideId' :: SlideId -> ClientM (WithId SlideId Slide)
 slidesPost' :: Slide -> ClientM (WithId SlideId Slide)
 slidesPut' :: SlideId -> Slide -> ClientM (WithId SlideId Slide)
 slidesDelete' :: SlideId -> ClientM ()
 ((
+  usersGet' :<|>
+  _usersGetUserId' :<|>
+  _usersPost' :<|>
+  _usersPut' :<|>
+  _usersDelete'
+  ) :<|>
+  (
   decksGet' :<|>
   decksGetDeckId' :<|>
   decksPost' :<|>