jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: Remove GHC.Show instances in Preferences module

Browse Source
This commit is contained in:
monacoremo
2021-11-09 19:13:52 +01:00
committed by Remo
parent 40f9a6068a
commit 038d84b62d
4 changed files with 90 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/Request/ApiRequest.hs
+8 -26
View File
@@ -3,7 +3,6 @@ Module : PostgREST.Request.ApiRequest
Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
@@ -67,6 +66,7 @@ import PostgREST.Request.Preferences (PreferCount (..),
PreferTransaction (..))
import qualified PostgREST.ContentType as ContentType
import qualified PostgREST.Request.Preferences as Preferences
import Protolude hiding (head, toS)
import Protolude.Conv (toS)
@@ -195,20 +195,11 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
, iRange = ranges
, iTopLevelRange = topLevelRange
, iPayload = relevantPayload
, iPreferRepresentation = representation
, iPreferParameters = if | hasPrefer (show SingleObject) -> Just SingleObject
| hasPrefer (show MultipleObjects) -> Just MultipleObjects
| otherwise -> Nothing
, iPreferCount = if | hasPrefer (show ExactCount) -> Just ExactCount
| hasPrefer (show PlannedCount) -> Just PlannedCount
| hasPrefer (show EstimatedCount) -> Just EstimatedCount
| otherwise -> Nothing
, iPreferResolution = if | hasPrefer (show MergeDuplicates) -> Just MergeDuplicates
| hasPrefer (show IgnoreDuplicates) -> Just IgnoreDuplicates
| otherwise -> Nothing
, iPreferTransaction = if | hasPrefer (show Commit) -> Just Commit
| hasPrefer (show Rollback) -> Just Rollback
| otherwise -> Nothing
, iPreferRepresentation = preferRepresentation
, iPreferParameters = preferParameters
, iPreferCount = preferCount
, iPreferResolution = preferResolution
, iPreferTransaction = preferTransaction
, iFilters = filters
, iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
, iSelect = toS <$> join (lookup "select" qParams)
@@ -325,7 +316,7 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
target =
let
callFindProc procSch procNam = findProc
(QualifiedIdentifier procSch procNam) payloadColumns (hasPrefer (show SingleObject)) (dbProcs dbStructure)
(QualifiedIdentifier procSch procNam) payloadColumns (preferParameters == Just SingleObject) (dbProcs dbStructure)
contentType (action == ActionInvoke InvPost)
in
case path of
@@ -359,16 +350,7 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
hdrs = requestHeaders req
qParams = [(toS k, v)|(k,v) <- qString]
lookupHeader = flip lookup hdrs
hasPrefer :: Text -> Bool
hasPrefer val = any (\(h,v) -> h == "Prefer" && val `elem` split v) hdrs
where
split :: BS.ByteString -> [Text]
split = map T.strip . T.split (==',') . toS
representation
| hasPrefer (show Full) = Full
| hasPrefer (show None) = None
| hasPrefer (show HeadersOnly) = HeadersOnly
| otherwise = None
Preferences.Preferences{..} = Preferences.fromHeaders hdrs
auth = fromMaybe "" $ lookupHeader hAuthorization
tokenStr = case T.split (== ' ') (toS auth) of
("Bearer" : t : _) -> t
src/PostgREST/Request/Preferences.hs
+77 -22
View File
@@ -1,16 +1,69 @@
module PostgREST.Request.Preferences where
module PostgREST.Request.Preferences
( Preferences(..)
, PreferCount(..)
, PreferParameters(..)
, PreferRepresentation(..)
, PreferResolution(..)
, PreferTransaction(..)
, fromHeaders
, ToAppliedHeader(..)
) where
import qualified Data.ByteString as BS
import qualified Network.HTTP.Types.Header as HTTP
import qualified Data.Map as Map
import GHC.Show
import Protolude
data Preferences
= Preferences
{ preferResolution :: Maybe PreferResolution
, preferRepresentation :: PreferRepresentation
, preferParameters :: Maybe PreferParameters
, preferCount :: Maybe PreferCount
, preferTransaction :: Maybe PreferTransaction
}
fromHeaders :: [HTTP.Header] -> Preferences
fromHeaders headers =
Preferences
{ 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
prefs = fmap strip . concatMap (BS.split comma . snd) $ prefHeaders
comma = fromIntegral (ord ',')
strip = BS.dropWhile (space ==) . BS.dropWhileEnd (space ==)
space = fromIntegral (ord ' ')
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
instance Show PreferResolution where
show MergeDuplicates = "resolution=merge-duplicates"
show IgnoreDuplicates = "resolution=ignore-duplicates"
instance ToHeaderValue PreferResolution where
toHeaderValue MergeDuplicates = "resolution=merge-duplicates"
toHeaderValue 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
@@ -19,36 +72,38 @@ data PreferRepresentation
| None -- ^ Return nothing from the mutated data.
deriving Eq
instance Show PreferRepresentation where
show Full = "return=representation"
show None = "return=minimal"
show 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
instance Show PreferParameters where
show SingleObject = "params=single-object"
show MultipleObjects = "params=multiple-objects"
instance ToHeaderValue PreferParameters where
toHeaderValue SingleObject = "params=single-object"
toHeaderValue MultipleObjects = "params=multiple-objects"
data PreferCount
= ExactCount -- ^ exact count(slower)
| PlannedCount -- ^ PostgreSQL query planner rows count guess. Done by using EXPLAIN {query}.
| EstimatedCount -- ^ use the query planner rows if the count is superior to max-rows, otherwise get the exact count.
deriving Eq
deriving Eq
instance Show PreferCount where
show ExactCount = "count=exact"
show PlannedCount = "count=planned"
show 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.
= Commit -- ^ Commit transaction - the default.
| Rollback -- ^ Rollback transaction after sending the response - does not persist changes, e.g. for running tests.
deriving Eq
instance Show PreferTransaction where
show Commit = "tx=commit"
show Rollback = "tx=rollback"
instance ToHeaderValue PreferTransaction where
toHeaderValue Commit = "tx=commit"
toHeaderValue Rollback = "tx=rollback"
instance ToAppliedHeader PreferTransaction