diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/API.hs | 4 | ||||
| -rw-r--r-- | src/App.hs | 14 | ||||
| -rw-r--r-- | src/Trips.hs | 15 | ||||
| -rw-r--r-- | src/Types.hs | 28 |
4 files changed, 58 insertions, 3 deletions
diff --git a/src/API.hs b/src/API.hs index 1bcc47b3a5d6..cc737c16bd72 100644 --- a/src/API.hs +++ b/src/API.hs @@ -41,6 +41,10 @@ type API = :> Post '[JSON] NoContent -- trips: Read -- trips: Update + :<|> "trips" + :> SessionCookie + :> ReqBody '[JSON] T.UpdateTripRequest + :> Patch '[JSON] NoContent -- trips: Delete :<|> "trips" :> SessionCookie diff --git a/src/App.hs b/src/App.hs index 4f02cb4447db..df70910510e0 100644 --- a/src/App.hs +++ b/src/App.hs @@ -62,6 +62,7 @@ server T.Config{..} = createAccount :<|> deleteAccount :<|> listAccounts :<|> createTrip + :<|> updateTrip :<|> deleteTrip :<|> listTrips :<|> login @@ -120,6 +121,19 @@ server T.Config{..} = createAccount liftIO $ Trips.create dbFile trip pure NoContent + updateTrip :: T.SessionCookie -> T.UpdateTripRequest -> Handler NoContent + updateTrip cookie updates@T.UpdateTripRequest{..} = + adminsAnd cookie (\T.Account{..} -> accountUsername == T.tripPKUsername updateTripRequestTripPK) $ do + mTrip <- liftIO $ Trips.get dbFile updateTripRequestTripPK + case mTrip of + Nothing -> throwError err400 { errBody = "tripKey is invalid" } + Just trip@T.Trip{..} -> do + -- TODO(wpcarro): Prefer function in Trips module that does this in a + -- DB transaction. + liftIO $ Trips.delete dbFile updateTripRequestTripPK + liftIO $ Trips.create dbFile (T.updateTrip updates trip) + pure NoContent + deleteTrip :: T.SessionCookie -> T.TripPK -> Handler NoContent deleteTrip cookie tripPK@T.TripPK{..} = adminsAnd cookie (\T.Account{..} -> accountUsername == tripPKUsername) $ do diff --git a/src/Trips.hs b/src/Trips.hs index ec52ec58fee9..022631219c62 100644 --- a/src/Trips.hs +++ b/src/Trips.hs @@ -14,12 +14,21 @@ create dbFile trip = withConnection dbFile $ \conn -> execute conn "INSERT INTO Trips (username,destination,startDate,endDate,comment) VALUES (?,?,?,?,?)" (trip |> T.tripFields) --- | Delete a trip from `dbFile` using its `tripPK` Primary Key. +-- | Attempt to get the trip record from `dbFile` under `tripKey`. +get :: FilePath -> T.TripPK -> IO (Maybe T.Trip) +get dbFile tripKey = withConnection dbFile $ \conn -> do + res <- query conn "SELECT username,destination,startDate,endDate,comment FROM Trips WHERE username = ? AND destination = ? AND startDate = ? LIMIT 1" + (T.tripPKFields tripKey) + case res of + [x] -> pure (Just x) + _ -> pure Nothing + +-- | Delete a trip from `dbFile` using its `tripKey` Primary Key. delete :: FilePath -> T.TripPK -> IO () -delete dbFile tripPK = +delete dbFile tripKey = withConnection dbFile $ \conn -> do execute conn "DELETE FROM Trips WHERE username = ? AND destination = ? and startDate = ?" - (tripPK |> T.tripPKFields) + (T.tripPKFields tripKey) -- | Return a list of all of the trips in `dbFile`. listAll :: FilePath -> IO [T.Trip] diff --git a/src/Types.hs b/src/Types.hs index d03aae9c7f38..273d4aecca70 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -449,3 +449,31 @@ instance FromRow PendingAccount where pendingAccountRole <- field pendingAccountEmail <- field pure PendingAccount {..} + +data UpdateTripRequest = UpdateTripRequest + { updateTripRequestTripPK :: TripPK + , updateTripRequestDestination :: Maybe Destination + , updateTripRequestStartDate :: Maybe Date + , updateTripRequestEndDate :: Maybe Date + , updateTripRequestComment :: Maybe Comment + } deriving (Eq, Show) + +instance FromJSON UpdateTripRequest where + parseJSON = withObject "UpdateTripRequest" $ \x -> do + updateTripRequestTripPK <- x .: "tripKey" + -- the following four fields might not be present + updateTripRequestDestination <- x .:? "destination" + updateTripRequestStartDate <- x .:? "startDate" + updateTripRequestEndDate <- x .:? "endDate" + updateTripRequestComment <- x .:? "comment" + pure UpdateTripRequest{..} + +-- | Apply the updates in the UpdateTripRequest to Trip. +updateTrip :: UpdateTripRequest -> Trip -> Trip +updateTrip UpdateTripRequest{..} Trip{..} = Trip + { tripUsername = tripUsername + , tripDestination = M.fromMaybe tripDestination updateTripRequestDestination + , tripStartDate = M.fromMaybe tripStartDate updateTripRequestStartDate + , tripEndDate = M.fromMaybe tripEndDate updateTripRequestEndDate + , tripComment = M.fromMaybe tripComment updateTripRequestComment + } |