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"
|
:<|> "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
|
||||||
|
|
11
src/App.hs
11
src/App.hs
|
@ -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
|
||||||
|
|
18
src/Types.hs
18
src/Types.hs
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue