Support PATCH /trips

Support a top-level PATCH request to trips that permits any admin to update any
trip, and any user to update any of their trips.

I'm using Aeson's (:?) combinator to support missing fields from the incoming
JSON requests, and then M.fromMaybe to apply these values to any record that
matches the primary key.

See the TODOs that I introduced for some shortcomings.

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

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

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]

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
+  }