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:
parent
0637da36cc
commit
6d9e76313d
3 changed files with 39 additions and 5 deletions
|
@ -15,9 +15,14 @@ type API = "user"
|
|||
:<|> "user"
|
||||
:> Capture "name" Text
|
||||
:> Get '[JSON] (Maybe T.Account)
|
||||
:<|> "trip"
|
||||
-- Create
|
||||
:<|> "trips"
|
||||
:> ReqBody '[JSON] T.Trip
|
||||
:> Post '[JSON] NoContent
|
||||
-- Read
|
||||
:<|> "trips"
|
||||
:> Get '[JSON] [T.Trip]
|
||||
-- Delete
|
||||
:<|> "trips"
|
||||
:> ReqBody '[JSON] T.TripPK
|
||||
:> Delete '[JSON] NoContent
|
||||
|
|
11
src/App.hs
11
src/App.hs
|
@ -21,11 +21,13 @@ server dbFile = userAddH
|
|||
:<|> userGetH
|
||||
:<|> createTripH
|
||||
:<|> listTripsH
|
||||
:<|> deleteTripH
|
||||
where
|
||||
userAddH newUser = liftIO $ userAdd newUser
|
||||
userGetH name = liftIO $ userGet name
|
||||
createTripH trip = liftIO $ createTrip trip
|
||||
listTripsH = liftIO $ listTrips
|
||||
deleteTripH tripPK = liftIO $ deleteTrip tripPK
|
||||
|
||||
-- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
|
||||
userAdd :: T.Account -> IO (Maybe T.Session)
|
||||
|
@ -53,6 +55,15 @@ server dbFile = userAddH
|
|||
listTrips :: IO [T.Trip]
|
||||
listTrips = withConnection dbFile $ \conn -> do
|
||||
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 dbFile = do
|
||||
pure $ serve (Proxy @ API) $ server dbFile
|
||||
|
|
18
src/Types.hs
18
src/Types.hs
|
@ -199,6 +199,24 @@ instance FromRow Trip where
|
|||
<*> 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.
|
||||
tripFields :: Trip -> (Username, Destination, Date, Date, Comment)
|
||||
tripFields (Trip{ tripUsername
|
||||
|
|
Loading…
Reference in a new issue