naming adjustments, declare types first

src/PostgREST/Query.hs

@@ -10,7 +10,7 @@ module PostgREST.Query
   , updateQuery
   , DbHandler
   , ReadQueryResult(..)
-  , WriteQueryResult(..)
+  , MutateQueryResult(..)
   , InvokeQueryResult(..)
   , OpenApiQueryResult
   ) where
@@ -53,6 +53,7 @@ import PostgREST.Request.Preferences     (PreferCount (..),
 
 import Protolude hiding (Handler)
 
+
 type DbHandler = ExceptT Error SQL.Transaction
 
 data ReadQueryResult = ReadQueryResult
@@ -64,6 +65,27 @@ data ReadQueryResult = ReadQueryResult
   , rqGucStatus  :: Maybe HTTP.Status
   }
 
+data MutateQueryResult = MutateQueryResult
+  { resRequest    :: MutateRequestInfo
+  , resQueryTotal :: Int64
+  , resFields     :: [ByteString]
+  , resBody       :: ByteString
+  , resGucStatus  :: Maybe HTTP.Status
+  , resGucHeaders :: [GucHeader]
+  }
+
+data InvokeQueryResult = InvokeQueryResult
+  { iqRequest    :: InvokeRequestInfo
+  , iqTableTotal :: Maybe Int64
+  , iqQueryTotal :: Int64
+  , iqBody       :: BS8.ByteString
+  , iqGucHeaders :: [GucHeader]
+  , iqGucStatus  :: Maybe HTTP.Status
+  }
+
+type OpenApiQueryResult = ([Table], Maybe Text, Proc.ProcsMap)
+
+
 readQuery :: ReadRequestInfo -> DbHandler ReadQueryResult
 readQuery reqInfo@ReadRequestInfo{..} = do
   (tableTotal, queryTotal, _ , body, gucHeaders, gucStatus) <-
@@ -106,24 +128,24 @@ readQuery reqInfo@ReadRequestInfo{..} = do
           lift . SQL.statement mempty $
             Statements.createExplainStatement countQry configDbPreparedStatements
 
-createQuery :: MutateRequestInfo -> DbHandler WriteQueryResult
+createQuery :: MutateRequestInfo -> DbHandler MutateQueryResult
 createQuery mutReq@MutateRequestInfo{..} = do
-  result <- writeQuery True pkCols mutReq
+  result <- mutateQuery True pkCols mutReq
   failNotSingular (iAcceptContentType mrApiRequest) (resQueryTotal result)
   return result
   where
     pkCols = tablePKCols mrDbStructure qiSchema qiName
     QualifiedIdentifier{..} = mrIdentifier
 
-updateQuery :: MutateRequestInfo -> DbHandler WriteQueryResult
+updateQuery :: MutateRequestInfo -> DbHandler MutateQueryResult
 updateQuery mutReq@MutateRequestInfo{..} = do
-  result <- writeQuery False mempty mutReq
+  result <- mutateQuery False mempty mutReq
   failNotSingular (iAcceptContentType mrApiRequest) (resQueryTotal result)
   return result
 
-singleUpsertQuery :: MutateRequestInfo -> DbHandler WriteQueryResult
+singleUpsertQuery :: MutateRequestInfo -> DbHandler MutateQueryResult
 singleUpsertQuery mutReq = do
-  result <- writeQuery False mempty mutReq
+  result <- mutateQuery False mempty mutReq
 
   -- Makes sure the querystring pk matches the payload pk
   -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
@@ -136,20 +158,28 @@ singleUpsertQuery mutReq = do
 
   return result
 
-deleteQuery :: MutateRequestInfo -> DbHandler WriteQueryResult
+deleteQuery :: MutateRequestInfo -> DbHandler MutateQueryResult
 deleteQuery mutReq@MutateRequestInfo{..} = do
-  result <- writeQuery False mempty mutReq
+  result <- mutateQuery False mempty mutReq
   failNotSingular (iAcceptContentType mrApiRequest) (resQueryTotal result)
   return result
 
-data InvokeQueryResult = InvokeQueryResult
-  { iqRequest    :: InvokeRequestInfo
-  , iqTableTotal :: Maybe Int64
-  , iqQueryTotal :: Int64
-  , iqBody       :: BS8.ByteString
-  , iqGucHeaders :: [GucHeader]
-  , iqGucStatus  :: Maybe HTTP.Status
-  }
+mutateQuery :: Bool -> [Text] -> MutateRequestInfo -> DbHandler MutateQueryResult
+mutateQuery isInsert pkCols mr@MutateRequestInfo{..} = do
+  (_, queryTotal, fields, body, gucHeaders, gucStatus) <-
+    lift . SQL.statement mempty $
+      Statements.createWriteStatement
+        (QueryBuilder.readRequestToQuery mrReadRequest)
+        (QueryBuilder.mutateRequestToQuery mrMutateRequest)
+        (iAcceptContentType mrApiRequest == CTSingularJSON)
+        isInsert
+        (iAcceptContentType mrApiRequest == CTTextCSV)
+        (iPreferRepresentation mrApiRequest)
+        pkCols
+        (pgVersion mrDbStructure)
+        (configDbPreparedStatements mrConfig)
+
+  liftEither $ MutateQueryResult mr queryTotal fields body <$> gucStatus <*> gucHeaders
 
 invokeQuery :: InvokeRequestInfo -> DbHandler InvokeQueryResult
 invokeQuery ir@InvokeRequestInfo{..} = do
@@ -182,8 +212,6 @@ invokeQuery ir@InvokeRequestInfo{..} = do
     returnsSingle (ApiRequest.TargetProc target _) = Proc.procReturnsSingle target
     returnsSingle _                                = False
 
-type OpenApiQueryResult = ([Table], Maybe Text, Proc.ProcsMap)
-
 openApiQuery :: Schema -> AppConfig -> DbHandler OpenApiQueryResult
 openApiQuery tSchema AppConfig{..} = do
   lift $ (,,)
@@ -211,33 +239,6 @@ txMode ApiRequest{..} =
     _ ->
       SQL.Write
 
--- | Result from executing a write query on the database
-data WriteQueryResult = WriteQueryResult
-  { resRequest    :: MutateRequestInfo
-  , resQueryTotal :: Int64
-  , resFields     :: [ByteString]
-  , resBody       :: ByteString
-  , resGucStatus  :: Maybe HTTP.Status
-  , resGucHeaders :: [GucHeader]
-  }
-
-writeQuery :: Bool -> [Text] -> MutateRequestInfo -> DbHandler WriteQueryResult
-writeQuery isInsert pkCols mr@MutateRequestInfo{..} = do
-  (_, queryTotal, fields, body, gucHeaders, gucStatus) <-
-    lift . SQL.statement mempty $
-      Statements.createWriteStatement
-        (QueryBuilder.readRequestToQuery mrReadRequest)
-        (QueryBuilder.mutateRequestToQuery mrMutateRequest)
-        (iAcceptContentType mrApiRequest == CTSingularJSON)
-        isInsert
-        (iAcceptContentType mrApiRequest == CTTextCSV)
-        (iPreferRepresentation mrApiRequest)
-        pkCols
-        (pgVersion mrDbStructure)
-        (configDbPreparedStatements mrConfig)
-
-  liftEither $ WriteQueryResult mr queryTotal fields body <$> gucStatus <*> gucHeaders
-
 -- | Fail a response if a single JSON object was requested and not exactly one
 -- was found.
 failNotSingular :: ContentType -> Int64 -> DbHandler ()

src/PostgREST/Request.hs

@@ -37,40 +37,6 @@ import PostgREST.Request.ApiRequest      (Action (..),
 
 import Protolude
 
--- TODO: Carve out and use RequestError as Error type
-parse :: AppConfig -> DbStructure -> Wai.Request -> LBS.ByteString -> Either Error Request
-parse conf dbStructure waiRequest waiBody = do
-  apiRequest@ApiRequest{..} <-
-    mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf dbStructure waiRequest waiBody
-
-  case (iAction, iTarget) of
-    (ActionRead headersOnly, TargetIdent identifier) -> do
-      readReq <- readRequest identifier conf dbStructure apiRequest
-      bField <- binaryField conf iTarget iAcceptContentType readReq
-      return . ReadRequest $ ReadRequestInfo conf dbStructure apiRequest headersOnly identifier readReq bField
-    (ActionCreate, TargetIdent identifier) ->
-      CreateRequest <$> mutateRequest conf dbStructure apiRequest identifier
-    (ActionUpdate, TargetIdent identifier) ->
-      UpdateRequest <$> mutateRequest conf dbStructure apiRequest identifier
-    (ActionSingleUpsert, TargetIdent identifier) ->
-      SingleUpsertRequest <$> mutateRequest conf dbStructure apiRequest identifier
-    (ActionDelete, TargetIdent identifier) ->
-      DeleteRequest <$> mutateRequest conf dbStructure apiRequest identifier
-    (ActionInfo, TargetIdent identifier) ->
-      return $ InfoRequest dbStructure apiRequest identifier
-    (ActionInvoke invMethod, TargetProc proc _) -> do
-      readReq <- readRequest identifier conf dbStructure apiRequest
-      bField <- binaryField conf iTarget iAcceptContentType readReq
-      return . InvokeRequest $
-        InvokeRequestInfo conf dbStructure apiRequest invMethod proc readReq bField
-      where
-        identifier =
-          QualifiedIdentifier (pdSchema proc)
-            (fromMaybe (pdName proc) $ Proc.procTableName proc)
-    (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
-      Right $ OpenApiRequest conf dbStructure apiRequest headersOnly tSchema
-    _ ->
-      Left Error.NotFound
 
 data Request
   = ReadRequest ReadRequestInfo
@@ -111,6 +77,42 @@ data InvokeRequestInfo = InvokeRequestInfo
   , irBinaryField  :: BinaryField
   }
 
+type BinaryField = Maybe FieldName
+
+parse :: AppConfig -> DbStructure -> Wai.Request -> LBS.ByteString -> Either Error Request
+parse conf dbStructure waiRequest waiBody = do
+  apiRequest@ApiRequest{..} <-
+    mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf dbStructure waiRequest waiBody
+
+  case (iAction, iTarget) of
+    (ActionRead headersOnly, TargetIdent identifier) -> do
+      readReq <- readRequest identifier conf dbStructure apiRequest
+      bField <- binaryField conf iTarget iAcceptContentType readReq
+      return . ReadRequest $ ReadRequestInfo conf dbStructure apiRequest headersOnly identifier readReq bField
+    (ActionCreate, TargetIdent identifier) ->
+      CreateRequest <$> mutateRequest conf dbStructure apiRequest identifier
+    (ActionUpdate, TargetIdent identifier) ->
+      UpdateRequest <$> mutateRequest conf dbStructure apiRequest identifier
+    (ActionSingleUpsert, TargetIdent identifier) ->
+      SingleUpsertRequest <$> mutateRequest conf dbStructure apiRequest identifier
+    (ActionDelete, TargetIdent identifier) ->
+      DeleteRequest <$> mutateRequest conf dbStructure apiRequest identifier
+    (ActionInfo, TargetIdent identifier) ->
+      return $ InfoRequest dbStructure apiRequest identifier
+    (ActionInvoke invMethod, TargetProc proc _) -> do
+      readReq <- readRequest identifier conf dbStructure apiRequest
+      bField <- binaryField conf iTarget iAcceptContentType readReq
+      return . InvokeRequest $
+        InvokeRequestInfo conf dbStructure apiRequest invMethod proc readReq bField
+      where
+        identifier =
+          QualifiedIdentifier (pdSchema proc)
+            (fromMaybe (pdName proc) $ Proc.procTableName proc)
+    (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do
+      Right $ OpenApiRequest conf dbStructure apiRequest headersOnly tSchema
+    _ ->
+      Left Error.NotFound
+
 -- | Get the raw ApiRequest from a request. This should be obsoloted by further
 -- refactoring of this module.
 apiReq :: Request -> ApiRequest
@@ -136,8 +138,6 @@ readRequest :: QualifiedIdentifier -> AppConfig -> DbStructure -> ApiRequest ->
 readRequest QualifiedIdentifier{..} AppConfig{..} dbStructure =
   ReqBuilder.readRequest qiSchema qiName configDbMaxRows (dbRelationships dbStructure)
 
-type BinaryField = Maybe FieldName
-
 -- | If raw(binary) output is requested, check that ContentType is one of the
 -- admitted rawContentTypes and that`?select=...` contains only one field other
 -- than `*`

src/PostgREST/Response.hs

@@ -35,7 +35,7 @@ import PostgREST.GucHeader               (GucHeader,
 import PostgREST.Query                   (InvokeQueryResult (..),
                                           OpenApiQueryResult,
                                           ReadQueryResult (..),
-                                          WriteQueryResult (..))
+                                          MutateQueryResult (..))
 import PostgREST.Request                 (InvokeRequestInfo (..),
                                           MutateRequestInfo (..),
                                           ReadRequestInfo (..))
@@ -67,8 +67,8 @@ readResponse ReadQueryResult{..} =
       ]
       ++ contentTypeHeaders rrApiRequest
 
-createResponse :: WriteQueryResult -> Wai.Response
-createResponse WriteQueryResult{..} =
+createResponse :: MutateQueryResult -> Wai.Response
+createResponse MutateQueryResult{..} =
   if iPreferRepresentation == Full then
     response (headers ++ contentTypeHeaders mrApiRequest) (toS resBody)
   else
@@ -98,8 +98,8 @@ createResponse WriteQueryResult{..} =
             (\x -> ("Preference-Applied", BS8.pack $ show x)) <$> iPreferResolution
         ]
 
-updateResponse :: WriteQueryResult -> Wai.Response
-updateResponse WriteQueryResult{..} =
+updateResponse :: MutateQueryResult -> Wai.Response
+updateResponse MutateQueryResult{..} =
   if fullRepr then
     response (contentTypeHeaders mrApiRequest ++ [contentRangeHeader]) (toS resBody)
   else
@@ -117,8 +117,8 @@ updateResponse WriteQueryResult{..} =
       RangeQuery.contentRangeH 0 (resQueryTotal - 1) $
         if shouldCount (iPreferCount mrApiRequest) then Just resQueryTotal else Nothing
 
-singleUpsertResponse :: WriteQueryResult -> Wai.Response
-singleUpsertResponse WriteQueryResult{..} =
+singleUpsertResponse :: MutateQueryResult -> Wai.Response
+singleUpsertResponse MutateQueryResult{..} =
   if iPreferRepresentation mrApiRequest == Full then
     response HTTP.status200 (contentTypeHeaders mrApiRequest) (toS resBody)
   else
@@ -127,8 +127,8 @@ singleUpsertResponse WriteQueryResult{..} =
     MutateRequestInfo{..} = resRequest
     response = gucResponse resGucStatus resGucHeaders
 
-deleteResponse :: WriteQueryResult -> Wai.Response
-deleteResponse WriteQueryResult{..} =
+deleteResponse :: MutateQueryResult -> Wai.Response
+deleteResponse MutateQueryResult{..} =
   if iPreferRepresentation mrApiRequest == Full then
     response HTTP.status200
       (contentTypeHeaders mrApiRequest ++ [contentRangeHeader])