WIP: translate HTTP request into user intent

The app code will base its logic off the intent data

postgrest.cabal

@@ -72,6 +72,7 @@ executable postgrest
                      , PostgREST.DbStructure
                      , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
+                     , PostgREST.RequestIntent
                      , PostgREST.Types
 
 library
@@ -135,6 +136,7 @@ library
                      , PostgREST.DbStructure
                      , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
+                     , PostgREST.RequestIntent
                      , PostgREST.Types
   hs-source-dirs:      src
 
@@ -165,6 +167,7 @@ Test-Suite spec
                      , PostgREST.DbStructure
                      , PostgREST.QueryBuilder
                      , PostgREST.RangeQuery
+                     , PostgREST.RequestIntent
                      , PostgREST.Types
                      , Spec
                      , SpecHelper

src/PostgREST/RequestIntent.hs

@@ -0,0 +1,104 @@
+module PostgREST.RequestIntent where
+
+import qualified Data.Aeson           as JSON
+import qualified Data.ByteString      as BS
+import qualified Data.ByteString.Lazy as BL
+import           Data.List            (find)
+import           Data.Maybe           (fromMaybe, isJust, isNothing,
+                                       listToMaybe)
+import           Network.Wai          (Request (..))
+import           Network.Wai.Parse    (parseHttpAccept)
+import           PostgREST.RangeQuery (NonnegRange, rangeRequested)
+import           PostgREST.Types      (QualifiedIdentifier (..), Schema)
+
+type RequestBody = BL.ByteString
+
+-- | Types of things a user wants to do to tables/views/procs
+data Action = ActionCreate | ActionRead
+            | ActionUpdate | ActionDelete
+            | ActionInfo   | ActionInvoke
+-- | The target db object of a user action
+data Target = TargetIdent QualifiedIdentifier
+            | TargetRoot
+-- | Enumeration of currently supported content types for
+-- route responses and upload payloads
+data ContentType = ApplicationJSON | TextCSV
+-- | When Hasql supports the COPY command then we can
+-- have a special payload just for CSV, but until
+-- then CSV is converted to a JSON array
+data Payload = PayloadJSON JSON.Array
+
+-- | Describes what the user wants to do. This data type is a
+-- translation of the raw elements of an HTTP request into domain
+-- specific language.  There is no guarantee that the intent is
+-- sensible, it is up to a later stage of processing to determine
+-- if it is an action we are able to perform.
+data Intent = Intent {
+  -- | Set to Nothing for unknown HTTP verbs
+    iAction :: Maybe Action
+  -- | Set to Nothing for malformed range
+  , iRange  :: Maybe NonnegRange
+  -- | Set to Nothing for strangely nested urls
+  , iTarget :: Maybe Target
+  -- | The content type the client most desires (or JSON if undecided)
+  , iAccepts :: Either BS.ByteString ContentType
+  -- | {foo} becomes [{foo}] and CSV is converted to JSON
+  , iPayload :: Maybe Payload
+  -- | Taken from JSON Web Token
+  , iTrustedClaims :: Maybe JSON.Object
+  -- | If client wants created items echoed back
+  , iPreferRepresentation :: Bool
+  -- | If client wants first row as raw object
+  , iPreferSingular :: Bool
+  }
+
+-- | Examines HTTP request and translates it into user intent.
+userIntent :: Schema -> Request -> RequestBody -> Intent
+userIntent schema req _ =
+  let action = case requestMethod req of
+                 "GET"     -> Just ActionRead
+                 "POST"    -> Just $ if isTargetingProc
+                                then ActionInvoke
+                                else ActionCreate
+                 "PATCH"   -> Just ActionUpdate
+                 "DELETE"  -> Just ActionDelete
+                 "OPTIONS" -> Just ActionInfo
+                 _         -> Nothing
+      target = case path of
+                 []            -> Just TargetRoot
+                 [table]       -> Just $ TargetIdent
+                                       $ QualifiedIdentifier schema table
+                 ["rpc", proc] -> Just $ TargetIdent
+                                       $ QualifiedIdentifier schema proc
+                 _             -> Nothing  in
+
+  Intent action
+    (rangeRequested hdrs)
+    target
+    (pickContentType $ lookupHeader "accept")
+    Nothing -- TODO: calculate payload
+    Nothing -- TODO: decode jwt
+    (hasPrefer "return=representation")
+    (hasPrefer "plurality=singular")
+
+ where
+  path            = pathInfo req
+  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
+  hdrs            = requestHeaders req
+  lookupHeader    = flip lookup hdrs
+  hasPrefer val   = any (\(h,v) -> h == "Prefer" && v == val) hdrs
+
+-- | Chooses a payload from the items in an accept header.
+-- When possible it picks JSON.
+pickContentType :: Maybe BS.ByteString -> Either BS.ByteString ContentType
+pickContentType accept
+  | isNothing accept || has ctAll || has ctJson = Right ApplicationJSON
+  | has ctCsv = Right TextCSV
+  | otherwise = Left acceptH
+ where
+  ctAll  = "*/*"
+  ctCsv  = "text/csv"
+  ctJson = "application/json"
+  Just acceptH = accept
+  findInAccept = flip find $ parseHttpAccept acceptH
+  has          = isJust . findInAccept . BS.isPrefixOf