diff options
| -rw-r--r-- | src/API.hs | 9 | ||||
| -rw-r--r-- | src/App.hs | 17 | ||||
| -rw-r--r-- | src/Types.hs | 18 |
3 files changed, 39 insertions, 5 deletions
diff --git a/src/API.hs b/src/API.hs index a42bf804b471..545aa25be777 100644 --- a/src/API.hs +++ b/src/API.hs @@ -14,10 +14,15 @@ type API = "user" :> Post '[JSON] (Maybe T.Session) :<|> "user" :> Capture "name" Text - :> Get '[JSON] (Maybe T.Account) - :<|> "trip" + :> Get '[JSON] (Maybe T.Account) + -- Create + :<|> "trips" :> ReqBody '[JSON] T.Trip :> Post '[JSON] NoContent -- Read :<|> "trips" :> Get '[JSON] [T.Trip] + -- Delete + :<|> "trips" + :> ReqBody '[JSON] T.TripPK + :> Delete '[JSON] NoContent diff --git a/src/App.hs b/src/App.hs index c4203137a4fc..7747951922fa 100644 --- a/src/App.hs +++ b/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 + 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 diff --git a/src/Types.hs b/src/Types.hs index 112b17c53ab2..6d6b83347931 100644 --- a/src/Types.hs +++ b/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 |