Partially support DELETE /trips

Allow a user to delete a trip entry from the Trips table using the Primary
Key. While this type-checks and compiles, it doesn't appear to be working as
intended. Perhaps I should use an auto-incrementing integer as the Primary
Key. I'm not sure how I want to handle this, so I'm punting for now.
This commit is contained in:
William Carroll 2020-07-28 10:14:33 +01:00
parent 0637da36cc
commit 6d9e76313d
3 changed files with 39 additions and 5 deletions

View file

@ -15,9 +15,14 @@ type API = "user"
:<|> "user" :<|> "user"
:> Capture "name" Text :> Capture "name" Text
:> Get '[JSON] (Maybe T.Account) :> Get '[JSON] (Maybe T.Account)
:<|> "trip" -- Create
:<|> "trips"
:> ReqBody '[JSON] T.Trip :> ReqBody '[JSON] T.Trip
:> Post '[JSON] NoContent :> Post '[JSON] NoContent
-- Read -- Read
:<|> "trips" :<|> "trips"
:> Get '[JSON] [T.Trip] :> Get '[JSON] [T.Trip]
-- Delete
:<|> "trips"
:> ReqBody '[JSON] T.TripPK
:> Delete '[JSON] NoContent

View file

@ -21,11 +21,13 @@ server dbFile = userAddH
:<|> userGetH :<|> userGetH
:<|> createTripH :<|> createTripH
:<|> listTripsH :<|> listTripsH
:<|> deleteTripH
where where
userAddH newUser = liftIO $ userAdd newUser userAddH newUser = liftIO $ userAdd newUser
userGetH name = liftIO $ userGet name userGetH name = liftIO $ userGet name
createTripH trip = liftIO $ createTrip trip createTripH trip = liftIO $ createTrip trip
listTripsH = liftIO $ listTrips listTripsH = liftIO $ listTrips
deleteTripH tripPK = liftIO $ deleteTrip tripPK
-- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
userAdd :: T.Account -> IO (Maybe T.Session) userAdd :: T.Account -> IO (Maybe T.Session)
@ -53,6 +55,15 @@ server dbFile = userAddH
listTrips :: IO [T.Trip] listTrips :: IO [T.Trip]
listTrips = withConnection dbFile $ \conn -> do listTrips = withConnection dbFile $ \conn -> do
query_ conn "SELECT * FROM Trips" query_ conn "SELECT * FROM Trips"
-- TODO(wpcarro): Validate incoming data like startDate.
deleteTrip :: T.TripPK -> IO NoContent
deleteTrip tripPK =
withConnection dbFile $ \conn -> do
execute conn "DELETE FROM Trips WHERE username = ? AND destination = ? and startDate = ?"
(tripPK & T.tripPKFields)
pure NoContent
mkApp :: FilePath -> IO Application mkApp :: FilePath -> IO Application
mkApp dbFile = do mkApp dbFile = do
pure $ serve (Proxy @ API) $ server dbFile pure $ serve (Proxy @ API) $ server dbFile

View file

@ -199,6 +199,24 @@ instance FromRow Trip where
<*> field <*> field
<*> field <*> field
-- | The fields used as the Primary Key for a Trip entry.
data TripPK = TripPK
{ tripPKUsername :: Username
, tripPKDestination :: Destination
, tripPKStartDate :: Date
} deriving (Eq, Show, Generic)
tripPKFields :: TripPK -> (Username, Destination, Date)
tripPKFields (TripPK{ tripPKUsername
, tripPKDestination
, tripPKStartDate
})
= (tripPKUsername, tripPKDestination, tripPKStartDate)
-- TODO(wpcarro): Prefer shorter JSON fields like username instead of
-- tripPKUsername.
instance FromJSON TripPK
-- | Return the tuple representation of a Trip record for SQL. -- | Return the tuple representation of a Trip record for SQL.
tripFields :: Trip -> (Username, Destination, Date, Date, Comment) tripFields :: Trip -> (Username, Destination, Date, Date, Comment)
tripFields (Trip{ tripUsername tripFields (Trip{ tripUsername