diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index bbd0681fa7e..61a335aa0b5 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -77,7 +77,7 @@ import PostgREST.Request.ApiRequest (Action (..), import PostgREST.Request.Preferences (PreferCount (..), PreferParameters (..), PreferRepresentation (..), - resolutionAppliedHeader) + toAppliedHeader) import PostgREST.Request.Types (ReadRequest, fstFieldNames) import PostgREST.Version (prettyVersion) import PostgREST.Workers (connectionWorker, listener) @@ -323,7 +323,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do , if null pkCols && isNothing iOnConflict then Nothing else - resolutionAppliedHeader <$> iPreferResolution + toAppliedHeader <$> iPreferResolution ] failNotSingular iAcceptContentType resQueryTotal $ diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs index 5cd106a7ece..dbd1bd009cb 100644 --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -181,10 +181,10 @@ optionalRollback AppConfig{..} ApiRequest{..} transaction = do preferenceApplied | shouldCommit = addHeadersIfNotIncluded - [transactionAppliedHeader Commit] + [toAppliedHeader Commit] | shouldRollback = addHeadersIfNotIncluded - [transactionAppliedHeader Rollback] + [toAppliedHeader Rollback] | otherwise = identity diff --git a/src/PostgREST/Request/Preferences.hs b/src/PostgREST/Request/Preferences.hs index eb29440a9bf..a62e188ffe0 100644 --- a/src/PostgREST/Request/Preferences.hs +++ b/src/PostgREST/Request/Preferences.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} module PostgREST.Request.Preferences ( Preferences(..) , PreferCount(..) @@ -7,8 +6,7 @@ module PostgREST.Request.Preferences , PreferResolution(..) , PreferTransaction(..) , fromHeaders - , resolutionAppliedHeader - , transactionAppliedHeader + , ToAppliedHeader(..) ) where import qualified Data.ByteString as BS @@ -30,12 +28,11 @@ data Preferences fromHeaders :: [HTTP.Header] -> Preferences fromHeaders headers = Preferences - { preferResolution = parsePrefs resolutionStr [MergeDuplicates, IgnoreDuplicates] - , preferRepresentation = - fromMaybe None $ parsePrefs representationStr [Full, None, HeadersOnly] - , preferParameters = parsePrefs parametersStr [SingleObject, MultipleObjects] - , preferCount = parsePrefs countStr [ExactCount, PlannedCount, EstimatedCount] - , preferTransaction = parsePrefs transactionStr [Commit, Rollback] + { preferResolution = parsePrefs [MergeDuplicates, IgnoreDuplicates] + , preferRepresentation = fromMaybe None $ parsePrefs [Full, None, HeadersOnly] + , preferParameters = parsePrefs [SingleObject, MultipleObjects] + , preferCount = parsePrefs [ExactCount, PlannedCount, EstimatedCount] + , preferTransaction = parsePrefs [Commit, Rollback] } where prefHeaders = filter ((==) HTTP.hPrefer . fst) headers @@ -43,23 +40,30 @@ fromHeaders headers = comma = fromIntegral (ord ',') strip = BS.dropWhile (space ==) . BS.dropWhileEnd (space ==) space = fromIntegral (ord ' ') - parsePrefs toStr vals = - head $ mapMaybe (flip Map.lookup $ prefMap toStr vals) prefs - prefMap toStr = Map.fromList . fmap (\pref -> (toStr pref, pref)) + parsePrefs :: ToHeaderValue a => [a] -> Maybe a + parsePrefs vals = + head $ mapMaybe (flip Map.lookup $ prefMap vals) prefs + + prefMap :: ToHeaderValue a => [a] -> Map.Map ByteString a + prefMap = Map.fromList . fmap (\pref -> (toHeaderValue pref, pref)) + +class ToHeaderValue a where + toHeaderValue :: a -> ByteString + +class ToHeaderValue a => ToAppliedHeader a where + toAppliedHeader :: a -> HTTP.Header + toAppliedHeader x = (HTTP.hPreferenceApplied, toHeaderValue x) data PreferResolution = MergeDuplicates | IgnoreDuplicates -resolutionAppliedHeader :: PreferResolution -> HTTP.Header -resolutionAppliedHeader pref = - (HTTP.hPreferenceApplied, resolutionStr pref) +instance ToHeaderValue PreferResolution where + toHeaderValue MergeDuplicates = "resolution=merge-duplicates" + toHeaderValue IgnoreDuplicates = "resolution=ignore-duplicates" -resolutionStr :: PreferResolution -> ByteString -resolutionStr = \case - MergeDuplicates -> "resolution=merge-duplicates" - IgnoreDuplicates -> "resolution=ignore-duplicates" +instance ToAppliedHeader PreferResolution -- | How to return the mutated data. From https://tools.ietf.org/html/rfc7240#section-4.2 data PreferRepresentation @@ -68,21 +72,19 @@ data PreferRepresentation | None -- ^ Return nothing from the mutated data. deriving Eq -representationStr :: PreferRepresentation -> ByteString -representationStr = \case - Full -> "return=representation" - None -> "return=minimal" - HeadersOnly -> "return=headers-only" +instance ToHeaderValue PreferRepresentation where + toHeaderValue Full = "return=representation" + toHeaderValue None = "return=minimal" + toHeaderValue HeadersOnly = "return=headers-only" data PreferParameters = SingleObject -- ^ Pass all parameters as a single json object to a stored procedure | MultipleObjects -- ^ Pass an array of json objects as params to a stored procedure deriving Eq -parametersStr :: PreferParameters -> ByteString -parametersStr = \case - SingleObject -> "params=single-object" - MultipleObjects -> "params=multiple-objects" +instance ToHeaderValue PreferParameters where + toHeaderValue SingleObject = "params=single-object" + toHeaderValue MultipleObjects = "params=multiple-objects" data PreferCount = ExactCount -- ^ exact count(slower) @@ -90,22 +92,18 @@ data PreferCount | EstimatedCount -- ^ use the query planner rows if the count is superior to max-rows, otherwise get the exact count. deriving Eq -countStr :: PreferCount -> ByteString -countStr = \case - ExactCount -> "count=exact" - PlannedCount -> "count=planned" - EstimatedCount -> "count=estimated" +instance ToHeaderValue PreferCount where + toHeaderValue ExactCount = "count=exact" + toHeaderValue PlannedCount = "count=planned" + toHeaderValue EstimatedCount = "count=estimated" data PreferTransaction = Commit -- ^ Commit transaction - the default. | Rollback -- ^ Rollback transaction after sending the response - does not persist changes, e.g. for running tests. deriving Eq -transactionStr :: PreferTransaction -> ByteString -transactionStr = \case - Commit -> "tx=commit" - Rollback -> "tx=rollback" +instance ToHeaderValue PreferTransaction where + toHeaderValue Commit = "tx=commit" + toHeaderValue Rollback = "tx=rollback" -transactionAppliedHeader :: PreferTransaction -> HTTP.Header -transactionAppliedHeader pref = - (HTTP.hPreferenceApplied, transactionStr pref) +instance ToAppliedHeader PreferTransaction