refactor: Split up Types.hs and logically organize modules (#1793)

PostgREST · Apr 11, 2021 · f99fd6c · f99fd6c
1 parent 8c44410
commit f99fd6c
Show file tree

Hide file tree

Showing 37 changed files with 1,506 additions and 1,018 deletions.
diff --git a/main/Main.hs b/main/Main.hs
@@ -30,24 +30,39 @@ import System.CPUTime           (getCPUTime)
 import System.IO                (BufferMode (..), hSetBuffering)
 import Text.Printf              (hPrintf)
 
-import PostgREST.App         (postgrest)
+import PostgREST.App                   (postgrest)
 import PostgREST.Config
-import PostgREST.DbStructure (getDbStructure, getPgVersion)
-import PostgREST.Error       (PgError (PgError), checkIsFatal,
-                              errorPayload)
-import PostgREST.Statements  (dbSettingsStatement)
-import PostgREST.Types       (ConnectionStatus (..), DbStructure,
-                              PgVersion (..), SCacheStatus (..),
-                              minimumPgVersion)
-import Protolude             hiding (hPutStrLn, head, toS)
-import Protolude.Conv        (toS)
+import PostgREST.DbStructure           (DbStructure, getDbStructure,
+                                        getPgVersion)
+import PostgREST.DbStructure.PgVersion (PgVersion (..),
+                                        minimumPgVersion)
+import PostgREST.Error                 (PgError (PgError),
+                                        checkIsFatal, errorPayload)
+import PostgREST.Query.Statements      (dbSettingsStatement)
+
+import Protolude      hiding (hPutStrLn, head, toS)
+import Protolude.Conv (toS)
 
 
 #ifndef mingw32_HOST_OS
 import System.Posix.Signals
 import UnixSocket
 #endif
 
+
+-- | Current database connection status data ConnectionStatus
+data ConnectionStatus
+  = NotConnected
+  | Connected PgVersion
+  | FatalConnectionError Text
+  deriving (Eq)
+
+-- | Schema cache status
+data SCacheStatus
+  = SCLoaded
+  | SCOnRetry
+  | SCFatalFail
+
 -- | This is where everything starts.
 main :: IO ()
 main = do

diff --git a/postgrest.cabal b/postgrest.cabal
@@ -34,24 +34,32 @@ library
   default-extensions: OverloadedStrings
                       NoImplicitPrelude
   hs-source-dirs:     src
-  exposed-modules:    PostgREST.ApiRequest
-                      PostgREST.App
+  exposed-modules:    PostgREST.App
                       PostgREST.Auth
                       PostgREST.Config
-                      PostgREST.DbRequestBuilder
+                      PostgREST.Config.JSPath
+                      PostgREST.Config.Proxy
+                      PostgREST.ContentType
                       PostgREST.DbStructure
+                      PostgREST.DbStructure.Identifiers
+                      PostgREST.DbStructure.PgVersion
+                      PostgREST.DbStructure.Proc
+                      PostgREST.DbStructure.Relation
+                      PostgREST.DbStructure.Table
                       PostgREST.Error
+                      PostgREST.GucHeader
                       PostgREST.Middleware
                       PostgREST.OpenAPI
-                      PostgREST.Parsers
-                      PostgREST.QueryBuilder
-                      PostgREST.Statements
+                      PostgREST.Query.QueryBuilder
+                      PostgREST.Query.SqlFragment
+                      PostgREST.Query.Statements
                       PostgREST.RangeQuery
-                      PostgREST.Types
+                      PostgREST.Request.ApiRequest
+                      PostgREST.Request.DbRequestBuilder
+                      PostgREST.Request.Parsers
+                      PostgREST.Request.Preferences
+                      PostgREST.Request.Types
   other-modules:      Paths_postgrest
-                      PostgREST.Private.Common
-                      PostgREST.Private.ProxyUri
-                      PostgREST.Private.QueryFragment
   build-depends:      base                      >= 4.9 && < 4.15
                     , HTTP                      >= 4000.3.7 && < 4000.4
                     , Ranged-sets               >= 0.3 && < 0.5

diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
@@ -30,23 +30,43 @@ import qualified Network.HTTP.Types.Status       as HTTP
 import qualified Network.HTTP.Types.URI          as HTTP
 import qualified Network.Wai                     as Wai
 
-import qualified PostgREST.ApiRequest       as ApiRequest
-import qualified PostgREST.Auth             as Auth
-import qualified PostgREST.DbRequestBuilder as ReqBuilder
-import qualified PostgREST.DbStructure      as DbStructure
-import qualified PostgREST.Error            as Error
-import qualified PostgREST.Middleware       as Middleware
-import qualified PostgREST.OpenAPI          as OpenAPI
-import qualified PostgREST.QueryBuilder     as QueryBuilder
-import qualified PostgREST.RangeQuery       as RangeQuery
-import qualified PostgREST.Statements       as Statements
-
-import PostgREST.ApiRequest (Action (..), ApiRequest (..),
-                             InvokeMethod (..), Target (..))
-import PostgREST.Config     (AppConfig (..))
-import PostgREST.Error      (Error)
-
-import PostgREST.Types
+import qualified PostgREST.Auth                     as Auth
+import qualified PostgREST.DbStructure              as DbStructure
+import qualified PostgREST.Error                    as Error
+import qualified PostgREST.Middleware               as Middleware
+import qualified PostgREST.OpenAPI                  as OpenAPI
+import qualified PostgREST.Query.QueryBuilder       as QueryBuilder
+import qualified PostgREST.Query.Statements         as Statements
+import qualified PostgREST.RangeQuery               as RangeQuery
+import qualified PostgREST.Request.ApiRequest       as ApiRequest
+import qualified PostgREST.Request.DbRequestBuilder as ReqBuilder
+
+import PostgREST.Config                  (AppConfig (..),
+                                          LogLevel (..))
+import PostgREST.ContentType             (ContentType (..))
+import PostgREST.DbStructure             (DbStructure (..),
+                                          tablePKCols)
+import PostgREST.DbStructure.Identifiers (FieldName,
+                                          QualifiedIdentifier (..),
+                                          Schema)
+import PostgREST.DbStructure.Proc        (ProcDescription (..),
+                                          ProcVolatility (..))
+import PostgREST.DbStructure.Table       (Table (..))
+import PostgREST.Error                   (Error)
+import PostgREST.GucHeader               (GucHeader,
+                                          addHeadersIfNotIncluded,
+                                          unwrapGucHeader)
+import PostgREST.Request.ApiRequest      (Action (..),
+                                          ApiRequest (..),
+                                          InvokeMethod (..),
+                                          Target (..))
+import PostgREST.Request.Preferences     (PreferCount (..),
+                                          PreferParameters (..),
+                                          PreferRepresentation (..))
+import PostgREST.Request.Types           (ReadRequest, fstFieldNames)
+
+import qualified PostgREST.ContentType      as ContentType
+import qualified PostgREST.DbStructure.Proc as Proc
 
 import Protolude      hiding (Handler, toS)
 import Protolude.Conv (toS)
@@ -123,7 +143,7 @@ postgrestResponse conf@AppConfig{..} maybeDbStructure pool time req = do
       Just ct ->
         return ct
       Nothing ->
-        throwError . Error.ContentTypeError $ map toMime iAccepts
+        throwError . Error.ContentTypeError $ map ContentType.toMime iAccepts
 
   let
     handleReq apiReq =
@@ -352,9 +372,9 @@ handleInvoke invMethod proc context@RequestContext{..} = do
     identifier =
       QualifiedIdentifier
         (pdSchema proc)
-        (fromMaybe (pdName proc) $ procTableName proc)
+        (fromMaybe (pdName proc) $ Proc.procTableName proc)
 
-    returnsSingle (ApiRequest.TargetProc target _) = procReturnsSingle target
+    returnsSingle (ApiRequest.TargetProc target _) = Proc.procReturnsSingle target
     returnsSingle _                                = False
 
   req <- readRequest identifier context
@@ -367,7 +387,7 @@ handleInvoke invMethod proc context@RequestContext{..} = do
         (returnsSingle iTarget)
         (QueryBuilder.requestToCallProcQuery
           (QualifiedIdentifier (pdSchema proc) (pdName proc))
-          (specifiedProcArgs iColumns proc)
+          (Proc.specifiedProcArgs iColumns proc)
           iPayload
           (returnsScalar iTarget)
           iPreferParameters
@@ -405,7 +425,7 @@ handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure
 
   return $
     Wai.responseLBS HTTP.status200
-      (toHeader CTOpenAPI : maybeToList (profileHeader apiRequest))
+      (ContentType.toHeader CTOpenAPI : maybeToList (profileHeader apiRequest))
       (if headersOnly then mempty else toS body)
 
 txMode :: ApiRequest -> SQL.Mode
@@ -491,7 +511,7 @@ shouldCount preferCount =
   preferCount == Just ExactCount || preferCount == Just EstimatedCount
 
 returnsScalar :: ApiRequest.Target -> Bool
-returnsScalar (TargetProc proc _) = procReturnsScalar proc
+returnsScalar (TargetProc proc _) = Proc.procReturnsScalar proc
 returnsScalar _                   = False
 
 readRequest :: Monad m => QualifiedIdentifier -> RequestContext -> Handler m ReadRequest
@@ -503,7 +523,7 @@ readRequest QualifiedIdentifier{..} (RequestContext AppConfig{..} dbStructure ap
 
 contentTypeHeaders :: RequestContext -> [HTTP.Header]
 contentTypeHeaders RequestContext{..} =
-  toHeader ctxContentType : maybeToList (profileHeader ctxApiRequest)
+  ContentType.toHeader ctxContentType : maybeToList (profileHeader ctxApiRequest)
 
 requestContentTypes :: AppConfig -> ApiRequest -> [ContentType]
 requestContentTypes conf ApiRequest{..} =
@@ -542,7 +562,7 @@ binaryField RequestContext{..} readReq
 
 rawContentTypes :: AppConfig -> [ContentType]
 rawContentTypes AppConfig{..} =
-  (decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]
+  (ContentType.decodeContentType <$> configRawMediaTypes) `union` [CTOctetStream, CTTextPlain]
 
 profileHeader :: ApiRequest -> Maybe HTTP.Header
 profileHeader ApiRequest{..} =

diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
@@ -11,7 +11,11 @@ In the test suite there is an example of simple login function that can be used
 very simple authentication system inside the PostgreSQL database.
 -}
 {-# LANGUAGE RecordWildCards #-}
-module PostgREST.Auth (containsRole, jwtClaims, JWTClaims) where
+module PostgREST.Auth
+  ( containsRole
+  , jwtClaims
+  , JWTClaims
+  ) where
 
 import qualified Crypto.JWT          as JWT
 import qualified Data.Aeson          as JSON
@@ -23,9 +27,8 @@ import Control.Monad.Except    (liftEither)
 import Data.Either.Combinators (mapLeft)
 import Data.Time.Clock         (UTCTime)
 
-import PostgREST.Config (AppConfig (..))
+import PostgREST.Config (AppConfig (..), JSPath, JSPathExp (..))
 import PostgREST.Error  (Error (..))
-import PostgREST.Types  (JSPath, JSPathExp (..))
 
 import Protolude