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

Update stylish haskell config; apply all; add CI config (#1299)

Browse Source 
* Update config default; Copy non-defaults

* Update .stylish-haskell config version to match pgrst

* Apply stylish haskell to all files

* CircleCI config

* Remove redundant import.

What is used from Network.HTTP.Types.Headers is also exported by Network.HTTP.Types.

* Grouped imports

* Show un-styled files on CircleCI failure

* Fix styling imports

* Apply adhoc standard correctly
This commit is contained in:
Xavier Francisco
2019-05-23 10:44:34 -05:00
committed by Steve Chávez
parent 16af470a99
commit 28b3d6cafd
43 changed files with 603 additions and 549 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.circleci/config.yml
+4 -1
View File
@@ -77,7 +77,7 @@ jobs:
sudo apt-get install -y postgresql-client
stack setup
rm -rf $(stack path --dist-dir) $(stack path --local-install-root)
stack install hlint packdeps cabal-install
stack install hlint packdeps cabal-install stylish-haskell
- run:
name: build src and tests
command: |
@@ -91,6 +91,9 @@ jobs:
- run:
name: run linter
command: git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes -X NoPatternSynonyms "$@"
- run:
name: run styler
command: git ls-files | grep '\.l\?hs$' | xargs stack exec -- stylish-haskell -i && git diff-index --exit-code HEAD --
- save_cache:
paths:
- "~/.stack"
.stylish-haskell.yaml
+40 -5
View File
@@ -39,9 +39,9 @@ steps:
# - none: Do not perform any alignment.
#
# Default: global.
align: global
align: group
# Folowing options affect only import list alignment.
# The following options affect only import list alignment.
#
# List align has following options:
#
@@ -64,6 +64,25 @@ steps:
# Default: after_alias
list_align: after_alias
# Right-pad the module names to align imports in a group:
#
# - true: a little more readable
#
# > import qualified Data.List as List (concat, foldl, foldr,
# > init, last, length)
# > import qualified Data.List.Extra as List (concat, foldl, foldr,
# > init, last, length)
#
# - false: diff-safe
#
# > import qualified Data.List as List (concat, foldl, foldr, init,
# > last, length)
# > import qualified Data.List.Extra as List (concat, foldl, foldr,
# > init, last, length)
#
# Default: true
pad_module_names: true
# Long list align style takes effect when import is too long. This is
# determined by 'columns' setting.
#
@@ -75,7 +94,7 @@ steps:
# short enough to fit to single line. Otherwise it'll be multiline.
#
# - multiline: One line per import list entry.
# Type with contructor list acts like single import.
# Type with constructor list acts like single import.
#
# > import qualified Data.Map as M
# > ( empty
@@ -109,7 +128,7 @@ steps:
# Useful for 'file' and 'group' align settings.
list_padding: 4
# Separate lists option affects formating of import list for type
# Separate lists option affects formatting of import list for type
# or class. The only difference is single space between type and list
# of constructors, selectors and class functions.
#
@@ -126,6 +145,22 @@ steps:
# Default: true
separate_lists: true
# Space surround option affects formatting of import lists on a single
# line. The only difference is single space after the initial
# parenthesis and a single space before the terminal parenthesis.
#
# - true: There is single space associated with the enclosing
# parenthesis.
#
# > import Data.Foo ( foo )
#
# - false: There is no space associated with the enclosing parenthesis
#
# > import Data.Foo (foo)
#
# Default: false
space_surround: false
# Language pragmas
- language_pragmas:
# We can generate different styles of language pragma lists.
@@ -142,7 +177,7 @@ steps:
# Align affects alignment of closing pragma brackets.
#
# - true: Brackets are aligned in same collumn.
# - true: Brackets are aligned in same column.
#
# - false: Brackets are not aligned together. There is only one space
# between actual import and closing bracket.
main/Main.hs
+33 -32
View File
@@ -2,41 +2,42 @@
module Main where
import PostgREST.App (postgrest)
import PostgREST.Config (AppConfig (..), configPoolTimeout',
prettyVersion, readOptions)
import PostgREST.DbStructure (getDbStructure, getPgVersion)
import PostgREST.Error (errorPayload, checkIsFatal, PgError(PgError))
import PostgREST.OpenAPI (isMalformedProxyUri)
import PostgREST.Types (DbStructure, Schema, PgVersion(..), minimumPgVersion, ConnectionStatus(..))
import Protolude hiding (hPutStrLn, replace)
import Control.AutoUpdate (defaultUpdateSettings,
mkAutoUpdate, updateAction)
import Control.Retry (RetryStatus, capDelay,
exponentialBackoff,
retrying, rsPreviousDelay)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import Data.IORef (IORef, atomicWriteIORef,
newIORef, readIORef)
import Data.String (IsString (..))
import Data.Text (pack, replace, stripPrefix, strip)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text.IO (hPutStrLn, readFile)
import Data.Time.Clock (getCurrentTime)
import qualified Hasql.Pool as P
import qualified Hasql.Transaction.Sessions as HT
import Network.Wai.Handler.Warp (defaultSettings,
runSettings, setHost,
setPort, setServerName)
import System.IO (BufferMode (..),
hSetBuffering)
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
updateAction)
import Control.Retry (RetryStatus, capDelay,
exponentialBackoff, retrying,
rsPreviousDelay)
import Data.IORef (IORef, atomicWriteIORef, newIORef,
readIORef)
import Data.String (IsString (..))
import Data.Text (pack, replace, strip, stripPrefix)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text.IO (hPutStrLn, readFile)
import Data.Time.Clock (getCurrentTime)
import Network.Wai.Handler.Warp (defaultSettings, runSettings,
setHost, setPort, setServerName)
import System.IO (BufferMode (..), hSetBuffering)
import PostgREST.App (postgrest)
import PostgREST.Config (AppConfig (..), configPoolTimeout',
prettyVersion, readOptions)
import PostgREST.DbStructure (getDbStructure, getPgVersion)
import PostgREST.Error (PgError (PgError), checkIsFatal,
errorPayload)
import PostgREST.OpenAPI (isMalformedProxyUri)
import PostgREST.Types (ConnectionStatus (..), DbStructure,
PgVersion (..), Schema,
minimumPgVersion)
import Protolude hiding (hPutStrLn, replace)
#ifndef mingw32_HOST_OS
import System.Posix.Signals
import System.Posix.Signals
#endif
{-|
@@ -75,7 +76,7 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
putStrLn ("Attempting to connect to the database..." :: Text)
connected <- connectionStatus pool
case connected of
FatalConnectionError reason -> hPutStrLn stderr reason
FatalConnectionError reason -> hPutStrLn stderr reason
>> killThread mainTid -- Fatal error when connecting
NotConnected -> return () -- Unreachable
Connected actualPgVersion -> do -- Procede with initialization
@@ -87,7 +88,7 @@ connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do
putStrLn ("Failed to query the database. Retrying." :: Text)
hPutStrLn stderr . toS . errorPayload $ PgError False e
work
Right _ -> do
atomicWriteIORef refIsWorkerOn False
putStrLn ("Connection successful" :: Text)
@@ -298,6 +299,6 @@ loadDbUriFile conf = extractDbUri mDbUri
extractDbUri dbUri =
fmap setDbUri $
case stripPrefix "@" dbUri of
Nothing -> return dbUri
Nothing -> return dbUri
Just filename -> strip <$> readFile (toS filename)
setDbUri dbUri = conf {configDatabase = dbUri}
src/PostgREST/ApiRequest.hs
+53 -45
View File
@@ -4,7 +4,7 @@ Description : PostgREST functions to translate HTTP request to a domain type cal
-}
{-# LANGUAGE LambdaCase #-}
module PostgREST.ApiRequest (
module PostgREST.ApiRequest (
ApiRequest(..)
, ContentType(..)
, Action(..)
@@ -14,33 +14,41 @@ module PostgREST.ApiRequest (
, userApiRequest
) where
import Protolude
import qualified Data.Aeson as JSON
import Data.Aeson.Types (emptyObject, emptyArray)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Csv as CSV
import qualified Data.List as L
import Data.List (lookup, last, partition)
import qualified Data.HashMap.Strict as M
import qualified Data.Set as S
import Data.Maybe (fromJust)
import Control.Arrow ((***))
import qualified Data.Text as T
import qualified Data.Vector as V
import Network.HTTP.Base (urlEncodeVars)
import Network.HTTP.Types.Header (hAuthorization, hCookie)
import Network.HTTP.Types.URI (parseSimpleQuery, parseQueryReplacePlus)
import Network.Wai (Request (..))
import Network.Wai.Parse (parseHttpAccept)
import PostgREST.RangeQuery (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset)
import Data.Ranged.Boundaries
import PostgREST.Types
import PostgREST.Error (ApiRequestError(..))
import Data.Ranged.Ranges (Range(..), rangeIntersection, emptyRange)
import qualified Data.CaseInsensitive as CI
import Web.Cookie (parseCookiesText)
import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS (c2w)
import qualified Data.ByteString.Lazy as BL
import qualified Data.CaseInsensitive as CI
import qualified Data.Csv as CSV
import qualified Data.HashMap.Strict as M
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Vector as V
import Control.Arrow ((***))
import Data.Aeson.Types (emptyArray, emptyObject)
import Data.List (last, lookup, partition)
import Data.Maybe (fromJust)
import Data.Ranged.Ranges (Range (..), emptyRange,
rangeIntersection)
import Network.HTTP.Base (urlEncodeVars)
import Network.HTTP.Types.Header (hAuthorization, hCookie)
import Network.HTTP.Types.URI (parseQueryReplacePlus,
parseSimpleQuery)
import Network.Wai (Request (..))
import Network.Wai.Parse (parseHttpAccept)
import Web.Cookie (parseCookiesText)
import Data.Ranged.Boundaries
import PostgREST.Error (ApiRequestError (..))
import PostgREST.RangeQuery (NonnegRange, allRange, rangeGeq,
rangeLimit, rangeOffset, rangeRequested,
restrictRange)
import PostgREST.Types
import Protolude
type RequestBody = BL.ByteString
@@ -68,41 +76,41 @@ data PreferRepresentation = Full | HeadersOnly | None deriving Eq
-}
data ApiRequest = ApiRequest {
-- | Similar but not identical to HTTP verb, e.g. Create/Invoke both POST
iAction :: Action
iAction :: Action
-- | Requested range of rows within response
, iRange :: M.HashMap ByteString NonnegRange
, iRange :: M.HashMap ByteString NonnegRange
-- | The target, be it calling a proc or accessing a table
, iTarget :: Target
, iTarget :: Target
-- | Content types the client will accept, [CTAny] if no Accept header
, iAccepts :: [ContentType]
, iAccepts :: [ContentType]
-- | Data sent by client and used for mutation actions
, iPayload :: Maybe PayloadJSON
, iPayload :: Maybe PayloadJSON
-- | If client wants created items echoed back
, iPreferRepresentation :: PreferRepresentation
, iPreferRepresentation :: PreferRepresentation
-- | Pass all parameters as a single json object to a stored procedure
, iPreferSingleObjectParameter :: Bool
-- | Whether the client wants a result count (slower)
, iPreferCount :: Bool
, iPreferCount :: Bool
-- | Whether the client wants to UPSERT or ignore records on PK conflict
, iPreferResolution :: Maybe PreferResolution
, iPreferResolution :: Maybe PreferResolution
-- | Filters on the result ("id", "eq.10")
, iFilters :: [(Text, Text)]
, iFilters :: [(Text, Text)]
-- | &and and &or parameters used for complex boolean logic
, iLogic :: [(Text, Text)]
, iLogic :: [(Text, Text)]
-- | &select parameter used to shape the response
, iSelect :: Text
, iSelect :: Text
-- | &columns parameter used to shape the payload
, iColumns :: Maybe Text
, iColumns :: Maybe Text
-- | &order parameters for each level
, iOrder :: [(Text, Text)]
, iOrder :: [(Text, Text)]
-- | Alphabetized (canonical) request query string for response URLs
, iCanonicalQS :: ByteString
, iCanonicalQS :: ByteString
-- | JSON Web Token
, iJWT :: Text
, iJWT :: Text
-- | HTTP request headers
, iHeaders :: [(Text, Text)]
, iHeaders :: [(Text, Text)]
-- | Request Cookies
, iCookies :: [(Text, Text)]
, iCookies :: [(Text, Text)]
}
-- | Examines HTTP request and translates it into user intent.
src/PostgREST/App.hs
+41 -49
View File
@@ -1,64 +1,56 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns #-}
module PostgREST.App (
postgrest
) where
import Control.Applicative
import Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import Data.IORef (IORef, readIORef)
import Data.Time.Clock (UTCTime)
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashMap.Strict as M
import qualified Data.Set as S
import qualified Hasql.Pool as P
import qualified Hasql.Transaction as H
import qualified Hasql.Transaction as HT
import qualified Hasql.Transaction.Sessions as HT
import Network.HTTP.Types.Header
import Network.HTTP.Types.Status
import Network.HTTP.Types.URI (renderSimpleQuery)
import Network.Wai
import Network.Wai.Middleware.RequestLogger (logStdout)
import Data.Aeson as JSON
import Data.Function (id)
import Data.IORef (IORef, readIORef)
import Data.Time.Clock (UTCTime)
import Network.HTTP.Types.URI (renderSimpleQuery)
import Network.Wai.Middleware.RequestLogger (logStdout)
import qualified Hasql.Transaction as H
import Control.Applicative
import Data.Maybe
import Network.HTTP.Types.Header
import Network.HTTP.Types.Status
import Network.Wai
import qualified Data.HashMap.Strict as M
import PostgREST.ApiRequest ( ApiRequest(..), ContentType(..)
, Action(..), Target(..)
, PreferRepresentation (..)
, mutuallyAgreeable
, userApiRequest
)
import PostgREST.Auth (jwtClaims, containsRole, parseSecret)
import PostgREST.Config (AppConfig (..))
import PostgREST.DbStructure
import PostgREST.DbRequestBuilder( readRequest
, mutateRequest
, fieldNames
)
import PostgREST.Error ( SimpleError(..), PgError(..)
, errorResponseFor
)
import PostgREST.RangeQuery (allRange, rangeOffset)
import PostgREST.Middleware
import PostgREST.QueryBuilder ( callProc
, requestToQuery
, requestToCountQuery
, createReadStatement
, createWriteStatement
, ResultsWithCount
)
import PostgREST.Parsers (pRequestColumns)
import PostgREST.Types
import PostgREST.OpenAPI
import Data.Function (id)
import Protolude hiding (intercalate, Proxy)
import PostgREST.ApiRequest (Action (..), ApiRequest (..),
ContentType (..),
PreferRepresentation (..),
Target (..), mutuallyAgreeable,
userApiRequest)
import PostgREST.Auth (containsRole, jwtClaims,
parseSecret)
import PostgREST.Config (AppConfig (..))
import PostgREST.DbRequestBuilder (fieldNames, mutateRequest,
readRequest)
import PostgREST.DbStructure
import PostgREST.Error (PgError (..), SimpleError (..),
errorResponseFor)
import PostgREST.Middleware
import PostgREST.OpenAPI
import PostgREST.Parsers (pRequestColumns)
import PostgREST.QueryBuilder (ResultsWithCount, callProc,
createReadStatement,
createWriteStatement,
requestToCountQuery,
requestToQuery)
import PostgREST.RangeQuery (allRange, rangeOffset)
import PostgREST.Types
import Protolude hiding (Proxy, intercalate)
postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application
postgrest conf refDbStructure pool getTime worker =
@@ -211,7 +203,7 @@ app dbStructure proc cols conf apiRequest =
Right (sq, mq) -> do
let isSingle = case pjType of
PJArray len -> len == 1
PJObject -> True
PJObject -> True
colNames = colName <$> tableCols dbStructure tSchema tName
if topLevelRange /= allRange
then return . errorResponseFor $ PutRangeNotAllowedError
src/PostgREST/Auth.hs
+13 -11
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase #-}
{-|
Module : PostgREST.Auth
Description : PostgREST authorization functions.
@@ -19,17 +19,19 @@ module PostgREST.Auth (
, parseSecret
) where
import Control.Lens.Operators
import Control.Lens (set)
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as M
import Data.Time.Clock (UTCTime)
import Data.Vector as V
import PostgREST.Types
import Protolude
import qualified Crypto.JOSE.Types as JOSE.Types
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as M
import Data.Vector as V
import qualified Crypto.JOSE.Types as JOSE.Types
import Crypto.JWT
import Control.Lens (set)
import Data.Time.Clock (UTCTime)
import Control.Lens.Operators
import Crypto.JWT
import PostgREST.Types
import Protolude
{-|
Possible situations encountered with client JWTs
src/PostgREST/Config.hs
+36 -33
View File
@@ -12,7 +12,8 @@ turned in configurable behaviour if needed.
Other hardcoded options such as the minimum version number also belong here.
-}
{-# LANGUAGE LambdaCase, TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module PostgREST.Config ( prettyVersion
@@ -24,43 +25,45 @@ module PostgREST.Config ( prettyVersion
)
where
import Control.Applicative
import Control.Monad (fail)
import Control.Lens (preview)
import Crypto.JWT (StringOrURI,
stringOrUri)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BS
import qualified Data.CaseInsensitive as CI
import qualified Data.Configurator as C
import qualified Data.Configurator.Parser as C
import Data.Configurator.Types as C
import Data.List (lookup)
import Data.Monoid
import Data.Scientific (floatingOrInteger)
import Data.String (String)
import Data.Text (dropWhileEnd, dropEnd,
intercalate, lines,
strip, take, splitOn)
import Data.Text.Encoding (encodeUtf8)
import Data.Text.IO (hPutStrLn)
import Data.Version (versionBranch)
import Development.GitRev (gitHash)
import Network.Wai
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
import Options.Applicative hiding (str)
import Paths_postgrest (version)
import PostgREST.Parsers (pRoleClaimKey)
import PostgREST.Types (JSPath, JSPathExp(..))
import PostgREST.Error (ApiRequestError(..))
import Protolude hiding (hPutStrLn, take,
intercalate, (<>))
import System.IO (hPrint)
import System.IO.Error (IOError)
import Text.Heredoc
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
import qualified Text.PrettyPrint.ANSI.Leijen as L
import Control.Lens (preview)
import Control.Monad (fail)
import Crypto.JWT (StringOrURI, stringOrUri)
import Data.List (lookup)
import Data.Scientific (floatingOrInteger)
import Data.String (String)
import Data.Text (dropEnd, dropWhileEnd,
intercalate, lines, splitOn,
strip, take)
import Data.Text.Encoding (encodeUtf8)
import Data.Text.IO (hPutStrLn)
import Data.Version (versionBranch)
import Development.GitRev (gitHash)
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
import Paths_postgrest (version)
import System.IO (hPrint)
import System.IO.Error (IOError)
import Control.Applicative
import Data.Monoid
import Network.Wai
import Options.Applicative hiding (str)
import Text.Heredoc
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
import PostgREST.Error (ApiRequestError (..))
import PostgREST.Parsers (pRoleClaimKey)
import PostgREST.Types (JSPath, JSPathExp (..))
import Protolude hiding (hPutStrLn, intercalate, take, (<>))
-- | Config file settings for the server
data AppConfig = AppConfig {
configDatabase :: Text
@@ -171,7 +174,7 @@ readOptions = do
coerceText :: Value -> Text
coerceText (String s) = s
coerceText v = show v
coerceText v = show v
coerceInt :: (Read i, Integral i) => Value -> Maybe i
coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
@@ -185,11 +188,11 @@ readOptions = do
parseRoleClaimKey :: Value -> Either ApiRequestError JSPath
parseRoleClaimKey (String s) = pRoleClaimKey s
parseRoleClaimKey v = pRoleClaimKey $ show v
parseRoleClaimKey v = pRoleClaimKey $ show v
splitExtraSearchPath :: Value -> [Text]
splitExtraSearchPath (String s) = strip <$> splitOn "," s
splitExtraSearchPath _ = []
splitExtraSearchPath _ = []
opts = info (helper <*> pathParser) $
fullDesc
src/PostgREST/DbRequestBuilder.hs
+32 -35
View File
@@ -6,11 +6,11 @@ This module is in charge of building an intermediate representation(ReadRequest,
A query tree is built in case of resource embedding. By inferring the relationship between tables, join conditions are added for every embedded resource.
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DuplicateRecordFields#-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
module PostgREST.DbRequestBuilder (
readRequest
@@ -18,36 +18,33 @@ module PostgREST.DbRequestBuilder (
, fieldNames
) where
import Control.Applicative
import Control.Arrow ((***))
import Control.Lens.Getter (view)
import Control.Lens.Tuple (_1)
import qualified Data.ByteString.Char8 as BS
import Data.List (delete)
import Data.Maybe (fromJust)
import qualified Data.Set as S
import Data.Text (isInfixOf)
import Data.Tree
import Data.Either.Combinators (mapLeft)
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashMap.Strict as M
import qualified Data.Set as S
import Network.Wai
import Control.Arrow ((***))
import Control.Lens.Getter (view)
import Control.Lens.Tuple (_1)
import Data.Either.Combinators (mapLeft)
import Data.Foldable (foldr1)
import Data.List (delete)
import Data.Maybe (fromJust)
import Data.Text (isInfixOf)
import Text.Regex.TDFA ((=~))
import Unsafe (unsafeHead)
import Data.Foldable (foldr1)
import qualified Data.HashMap.Strict as M
import Control.Applicative
import Data.Tree
import Network.Wai
import PostgREST.ApiRequest ( ApiRequest(..)
, PreferRepresentation(..)
, Action(..), Target(..)
, PreferRepresentation (..)
)
import PostgREST.Error (ApiRequestError(..), errorResponseFor)
import PostgREST.Parsers
import PostgREST.RangeQuery (NonnegRange, restrictRange, allRange)
import PostgREST.Types
import Protolude hiding (from)
import Text.Regex.TDFA ((=~))
import Unsafe (unsafeHead)
import PostgREST.ApiRequest (Action (..), ApiRequest (..),
PreferRepresentation (..),
PreferRepresentation (..), Target (..))
import PostgREST.Error (ApiRequestError (..), errorResponseFor)
import PostgREST.Parsers
import PostgREST.RangeQuery (NonnegRange, allRange, restrictRange)
import PostgREST.Types
import Protolude hiding (from)
readRequest :: Maybe Integer -> [Relation] -> Maybe ProcDescription -> ApiRequest -> Either Response ReadRequest
readRequest maxRows allRels proc apiRequest =
@@ -65,9 +62,9 @@ readRequest maxRows allRels proc apiRequest =
(TargetProc (QualifiedIdentifier s pName) ) -> Just (s, tName)
where
tName = case pdReturnType <$> proc of
Just (SetOf (Composite qi)) -> qiName qi
Just (SetOf (Composite qi)) -> qiName qi
Just (Single (Composite qi)) -> qiName qi
_ -> pName
_ -> pName
_ -> Nothing
@@ -93,7 +90,7 @@ readRequest maxRows allRels proc apiRequest =
ActionUpdate -> fakeSourceRelations ++ allRels
ActionDelete -> fakeSourceRelations ++ allRels
ActionInvoke _ -> fakeSourceRelations ++ allRels
_ -> allRels
_ -> allRels
where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels
-- in a relation where one of the tables matches "TableName"
src/PostgREST/DbStructure.hs
+19 -19
View File
@@ -10,10 +10,10 @@ These queries are executed once at startup or when PostgREST is reloaded.
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
module PostgREST.DbStructure (
getDbStructure
, accessibleTables
@@ -22,26 +22,26 @@ module PostgREST.DbStructure (
, getPgVersion
) where
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Statement as H
import qualified Data.HashMap.Strict as M
import qualified Data.List as L
import qualified Data.Text as T
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Session as H
import qualified Hasql.Statement as H
import qualified Hasql.Transaction as HT
import Control.Applicative
import qualified Data.HashMap.Strict as M
import qualified Data.List as L
import Data.Set as S (fromList)
import Data.Text (split, strip,
breakOn, dropAround,
splitOn)
import qualified Data.Text as T
import qualified Hasql.Session as H
import qualified Hasql.Transaction as HT
import PostgREST.Types
import Text.InterpolatedString.Perl6 (q, qc)
import Data.Set as S (fromList)
import Data.Text (breakOn, dropAround, split,
splitOn, strip)
import GHC.Exts (groupWith)
import Text.InterpolatedString.Perl6 (q, qc)
import Unsafe (unsafeHead)
import GHC.Exts (groupWith)
import Protolude
import Unsafe (unsafeHead)
import Control.Applicative
import PostgREST.Types
import Protolude
getDbStructure :: Schema -> PgVersion -> HT.Transaction DbStructure
getDbStructure schema pgVer = do
src/PostgREST/Error.hs
+10 -7
View File
@@ -15,17 +15,20 @@ module PostgREST.Error (
, checkIsFatal
) where
import Protolude
import Data.Aeson ((.=))
import qualified Data.Aeson as JSON
import Data.Text (unwords)
import qualified Hasql.Pool as P
import qualified Hasql.Session as H
import Network.HTTP.Types.Header
import qualified Network.HTTP.Types.Status as HT
import Network.Wai (Response, responseLBS)
import PostgREST.Types
import Text.Read (readMaybe)
import Data.Aeson ((.=))
import Data.Text (unwords)
import Network.Wai (Response, responseLBS)
import Text.Read (readMaybe)
import Network.HTTP.Types.Header
import PostgREST.Types
import Protolude
class (JSON.ToJSON a) => PgrstError a where
src/PostgREST/Middleware.hs
+17 -15
View File
@@ -3,28 +3,30 @@ Module : PostgREST.Middleware
Description : Sets the PostgreSQL GUCs, role, search_path and pre-request function. Validates JWT.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
module PostgREST.Middleware where
import Crypto.JWT
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as M
import qualified Hasql.Transaction as H
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as M
import qualified Hasql.Transaction as H
import Network.Wai (Application, Response)
import Network.Wai.Middleware.Cors (cors)
import Network.Wai.Middleware.Gzip (def, gzip)
import Network.Wai.Middleware.Static (only, staticPolicy)
import Network.Wai (Application, Response)
import Network.Wai.Middleware.Cors (cors)
import Network.Wai.Middleware.Gzip (def, gzip)
import Network.Wai.Middleware.Static (only, staticPolicy)
import PostgREST.ApiRequest (ApiRequest(..))
import PostgREST.Auth (JWTAttempt(..))
import PostgREST.Config (AppConfig (..), corsPolicy)
import PostgREST.Error (errorResponseFor, SimpleError(JwtTokenMissing, JwtTokenInvalid))
import PostgREST.QueryBuilder (unquoted, pgFmtSetLocal, pgFmtSetLocalSearchPath)
import Crypto.JWT
import Protolude
import PostgREST.ApiRequest (ApiRequest (..))
import PostgREST.Auth (JWTAttempt (..))
import PostgREST.Config (AppConfig (..), corsPolicy)
import PostgREST.Error (SimpleError (JwtTokenInvalid, JwtTokenMissing),
errorResponseFor)
import PostgREST.QueryBuilder (pgFmtSetLocal, pgFmtSetLocalSearchPath,
unquoted)
import Protolude
runWithClaims :: AppConfig -> JWTAttempt ->
(ApiRequest -> H.Transaction Response) ->
src/PostgREST/OpenAPI.hs
+27 -23
View File
@@ -10,25 +10,29 @@ module PostgREST.OpenAPI (
, pickProxy
) where
import Control.Arrow ((&&&))
import Control.Lens
import Data.Aeson (decode, encode)
import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
import Data.Maybe (fromJust)
import qualified Data.Set as Set
import Data.String (IsString (..))
import Data.Text (unpack, pack, init, tail, toLower, intercalate, append, dropWhile, breakOn)
import Network.URI (parseURI, isAbsoluteURI,
URI (..), URIAuth (..))
import qualified Data.Set as Set
import Protolude hiding ((&), Proxy, get, intercalate, dropWhile)
import Control.Arrow ((&&&))
import Data.Aeson (decode, encode)
import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList)
import Data.Maybe (fromJust)
import Data.String (IsString (..))
import Data.Text (append, breakOn, dropWhile, init,
intercalate, pack, tail, toLower,
unpack)
import Network.URI (URI (..), URIAuth (..),
isAbsoluteURI, parseURI)
import Data.Swagger
import Control.Lens
import Data.Swagger
import PostgREST.ApiRequest (ContentType(..))
import PostgREST.Config (prettyVersion, docsVersion)
import PostgREST.Types (Table(..), Column(..), PgArg(..), ForeignKey(..),
PrimaryKey(..), Proxy(..), ProcDescription(..), toMime)
import PostgREST.ApiRequest (ContentType (..))
import PostgREST.Config (docsVersion, prettyVersion)
import PostgREST.Types (Column (..), ForeignKey (..), PgArg (..),
PrimaryKey (..), ProcDescription (..),
Proxy (..), Table (..), toMime)
import Protolude hiding (Proxy, dropWhile, get,
intercalate, (&))
makeMimeList :: [ContentType] -> MimeList
makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs
@@ -329,7 +333,7 @@ pickProxy proxy
uri = toURI $ fromJust proxy
scheme = init $ toLower $ pack $ uriScheme uri
path URI {uriPath = ""} = "/"
path URI {uriPath = p} = p
path URI {uriPath = p} = p
path' = pack $ path uri
authority = fromJust $ uriAuthority uri
host' = pack $ uriRegName authority
@@ -337,9 +341,9 @@ pickProxy proxy
readPort = fromMaybe 80 . readMaybe
port'' :: Integer
port'' = case (port', scheme) of
("", "http") -> 80
("", "http") -> 80
("", "https") -> 443
_ -> readPort $ unpack $ tail $ pack port'
_ -> readPort $ unpack $ tail $ pack port'
isUriValid:: URI -> Bool
isUriValid = fAnd [isSchemeValid, isQueryValid, isAuthorityValid]
@@ -355,7 +359,7 @@ isSchemeValid URI {uriScheme = s}
isQueryValid :: URI -> Bool
isQueryValid URI {uriQuery = ""} = True
isQueryValid _ = False
isQueryValid _ = False
isAuthorityValid :: URI -> Bool
isAuthorityValid URI {uriAuthority = a}
@@ -364,16 +368,16 @@ isAuthorityValid URI {uriAuthority = a}
isUserInfoValid :: URIAuth -> Bool
isUserInfoValid URIAuth {uriUserInfo = ""} = True
isUserInfoValid _ = False
isUserInfoValid _ = False
isHostValid :: URIAuth -> Bool
isHostValid URIAuth {uriRegName = ""} = False
isHostValid _ = True
isHostValid _ = True
isPortValid :: URIAuth -> Bool
isPortValid URIAuth {uriPort = ""} = True
isPortValid URIAuth {uriPort = (':':p)} =
case readMaybe p of
Just i -> i > (0 :: Integer) && i < 65536
Just i -> i > (0 :: Integer) && i < 65536
Nothing -> False
isPortValid _ = False
src/PostgREST/Parsers.hs
+19 -16
View File
@@ -6,22 +6,25 @@ This module is in charge of parsing all the querystring values in an url, e.g. t
-}
module PostgREST.Parsers where
import Protolude hiding (try, intercalate, replace, option)
import Control.Monad ((>>))
import Data.Foldable (foldl1)
import Data.Functor (($>))
import qualified Data.HashMap.Strict as M
import Data.Text (intercalate, replace, strip)
import Data.List (init, last)
import qualified Data.Set as S
import Data.Tree
import Data.Either.Combinators (mapLeft)
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.Error (ApiRequestError(ParseRequestError))
import PostgREST.Types
import Text.ParserCombinators.Parsec hiding (many, (<|>))
import Text.Parsec.Error
import Text.Read (read)
import qualified Data.HashMap.Strict as M
import qualified Data.Set as S
import Control.Monad ((>>))
import Data.Either.Combinators (mapLeft)
import Data.Foldable (foldl1)
import Data.Functor (($>))
import Data.List (init, last)
import Data.Text (intercalate, replace, strip)
import Text.Read (read)
import Data.Tree
import Text.Parsec.Error
import Text.ParserCombinators.Parsec hiding (many, (<|>))
import PostgREST.Error (ApiRequestError (ParseRequestError))
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.Types
import Protolude hiding (intercalate, option, replace, try)
pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
pRequestSelect selStr =
src/PostgREST/QueryBuilder.hs
+28 -28
View File
@@ -1,6 +1,6 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
@@ -27,29 +27,29 @@ module PostgREST.QueryBuilder (
, pgFmtSetLocalSearchPath
) where
import qualified Hasql.Statement as H
import qualified Hasql.Encoders as HE
import qualified Hasql.Decoders as HD
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S
import qualified Data.Text as T (map, null, takeWhile)
import qualified Data.Text.Encoding as T
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Statement as H
import qualified Data.Aeson as JSON
import Data.Scientific (FPFormat (..), formatScientific,
isInteger)
import Data.Text (intercalate, isInfixOf, replace,
toLower, unwords)
import Data.Tree (Tree (..))
import Text.InterpolatedString.Perl6 (qc)
import PostgREST.RangeQuery (rangeLimit, rangeOffset, allRange)
import qualified Data.HashMap.Strict as HM
import Data.Maybe
import qualified Data.Set as S
import Data.Text (intercalate, unwords, replace, isInfixOf, toLower)
import qualified Data.Text as T (map, takeWhile, null)
import qualified Data.Text.Encoding as T
import Data.Tree (Tree(..))
import PostgREST.Types
import Text.InterpolatedString.Perl6 (qc)
import qualified Data.ByteString.Char8 as BS
import Data.Scientific ( FPFormat (..)
, formatScientific
, isInteger
)
import Protolude hiding ( intercalate, cast, replace)
import PostgREST.ApiRequest (PreferRepresentation (..))
import Data.Maybe
import PostgREST.ApiRequest (PreferRepresentation (..))
import PostgREST.RangeQuery (allRange, rangeLimit, rangeOffset)
import PostgREST.Types
import Protolude hiding (cast, intercalate, replace)
{-| The generic query result format used by API responses. The location header
is represented as a list of strings containing variable bindings like
@@ -409,7 +409,7 @@ emptyOnFalse val cond = if cond then "" else val
pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn table "*" = fromQi table <> ".*"
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
@@ -427,10 +427,10 @@ pgFmtOrderTerm qi ot = unwords [
pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment
pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of
Op op val -> pgFmtFieldOp op <> " " <> case op of
"like" -> unknownLiteral (T.map star val)
"ilike" -> unknownLiteral (T.map star val)
"is" -> whiteList val
_ -> unknownLiteral val
"like" -> unknownLiteral (T.map star val)
"ilike" -> unknownLiteral (T.map star val)
"is" -> whiteList val
_ -> unknownLiteral val
In vals -> pgFmtField table fld <> " " <>
let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')"
src/PostgREST/RangeQuery.hs
+9 -11
View File
@@ -13,19 +13,17 @@ module PostgREST.RangeQuery (
, NonnegRange
) where
import qualified Data.ByteString.Char8 as BS
import Control.Applicative
import Network.HTTP.Types.Header
import Data.List (lookup)
import Text.Regex.TDFA ((=~))
import qualified Data.ByteString.Char8 as BS
import Data.Ranged.Boundaries
import Data.Ranged.Ranges
import Control.Applicative
import Data.Ranged.Boundaries
import Data.Ranged.Ranges
import Network.HTTP.Types.Header
import Text.Regex.TDFA ((=~))
import Data.List (lookup)
import Protolude
import Protolude
type NonnegRange = Range Integer
@@ -60,7 +58,7 @@ rangeOffset :: NonnegRange -> Integer
rangeOffset range =
case rangeLower range of
BoundaryBelow lower -> lower
_ -> panic "range without lower bound" -- should never happen
_ -> panic "range without lower bound" -- should never happen
rangeGeq :: Integer -> NonnegRange
rangeGeq n =
src/PostgREST/Types.hs
+24 -21
View File
@@ -2,20 +2,23 @@
Module : PostgREST.Types
Description : PostgREST common types and functions used by the rest of the modules
-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DuplicateRecordFields #-}
module PostgREST.Types where
import Protolude
import qualified GHC.Show
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Lazy as BL
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as M
import qualified Data.Set as S
import Data.Tree
import PostgREST.RangeQuery (NonnegRange)
import Network.HTTP.Types.Header (hContentType, Header)
import qualified Data.Set as S
import qualified GHC.Show
import Network.HTTP.Types.Header (Header, hContentType)
import Data.Tree
import PostgREST.RangeQuery (NonnegRange)
import Protolude
-- | Enumeration of currently supported response content types
data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
@@ -224,10 +227,10 @@ data PayloadJSON =
data PJType = PJArray { pjaLength :: Int } | PJObject deriving (Show, Eq)
data Proxy = Proxy {
proxyScheme :: Text
, proxyHost :: Text
, proxyPort :: Integer
, proxyPath :: Text
proxyScheme :: Text
, proxyHost :: Text
, proxyPort :: Integer
, proxyPath :: Text
} deriving (Show, Eq)
type Operator = Text
@@ -272,8 +275,8 @@ type ListVal = [Text]
data LogicOperator = And | Or deriving Eq
instance Show LogicOperator where
show And = "AND"
show Or = "OR"
show And = "AND"
show Or = "OR"
{-|
Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is:
@@ -353,15 +356,15 @@ data MutateQuery =
, returning :: [FieldName]
}|
Update {
in_ :: TableName
, updCols :: S.Set FieldName
, where_ :: [LogicTree]
, returning :: [FieldName]
in_ :: TableName
, updCols :: S.Set FieldName
, where_ :: [LogicTree]
, returning :: [FieldName]
}|
Delete {
in_ :: TableName
, where_ :: [LogicTree]
, returning :: [FieldName]
in_ :: TableName
, where_ :: [LogicTree]
, returning :: [FieldName]
} deriving (Show, Eq)
data DbRequest = DbRead ReadRequest | DbMutate MutateRequest
@@ -409,7 +412,7 @@ data JSPathExp = JSPKey Text | JSPIdx Int deriving (Eq, Show)
-- | Current database connection status data ConnectionStatus
data ConnectionStatus
data ConnectionStatus
= NotConnected
| Connected PgVersion
| FatalConnectionError Text
test/Feature/AndOrParamsSpec.hs
+6 -5
View File
@@ -1,13 +1,14 @@
module Feature.AndOrParamsSpec where
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Protolude hiding (get)
import SpecHelper
import Protolude hiding (get)
spec :: SpecWith Application
test/Feature/AsymmetricJwtSpec.hs
+5 -5
View File
@@ -1,14 +1,14 @@
module Feature.AsymmetricJwtSpec where
-- {{{ Imports
import Test.Hspec
import Test.Hspec.Wai
import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Protolude
import SpecHelper
-- }}}
spec :: SpecWith Application
test/Feature/AudienceJwtSecretSpec.hs
+7 -7
View File
@@ -1,14 +1,14 @@
module Feature.AudienceJwtSecretSpec where
-- {{{ Imports
import Test.Hspec
import Test.Hspec.Wai
import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Protolude hiding (get)
import SpecHelper
-- }}}
spec :: SpecWith Application
@@ -44,4 +44,4 @@ spec = describe "test handling of aud claims in JWT" $ do
`shouldRespondWith` 200
it "requests without JWT token should work" $
get "/has_count_column" `shouldRespondWith` 200
get "/has_count_column" `shouldRespondWith` 200
test/Feature/AuthSpec.hs
+6 -7
View File
@@ -1,17 +1,16 @@
module Feature.AuthSpec where
import Text.Heredoc
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
import Text.Heredoc
import PostgREST.Types (PgVersion, pgVersion112)
import Protolude hiding (get)
import SpecHelper
spec :: PgVersion -> SpecWith Application
spec actualPgVersion = describe "authorization" $ do
test/Feature/BinaryJwtSecretSpec.hs
+5 -5
View File
@@ -1,14 +1,14 @@
module Feature.BinaryJwtSecretSpec where
-- {{{ Imports
import Test.Hspec
import Test.Hspec.Wai
import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Protolude
import SpecHelper
-- }}}
spec :: SpecWith Application
test/Feature/ConcurrentSpec.hs
+10 -9
View File
@@ -1,20 +1,21 @@
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Feature.ConcurrentSpec where
import Control.Monad (void)
import Control.Monad.Base
import Control.Monad.Trans.Control
import Control.Concurrent.Async (mapConcurrently)
import Control.Monad (void)
import Network.Wai (Application)
import Control.Monad.Base
import Control.Monad.Trans.Control
import Network.Wai.Test (Session)
import Test.Hspec
import Test.Hspec.Wai.Internal
import Test.Hspec.Wai
import Test.Hspec.Wai.Internal
import Test.Hspec.Wai.JSON
import Network.Wai.Test (Session)
import Network.Wai (Application)
import Protolude hiding (get)
test/Feature/CorsSpec.hs
+5 -5
View File
@@ -1,17 +1,17 @@
module Feature.CorsSpec where
-- {{{ Imports
import Test.Hspec
import Test.Hspec.Wai
import Network.Wai.Test (SResponse(simpleHeaders, simpleBody))
import qualified Data.ByteString.Lazy as BL
import SpecHelper
import Network.Wai (Application)
import Network.Wai.Test (SResponse (simpleBody, simpleHeaders))
import Network.HTTP.Types
import Network.Wai (Application)
import Test.Hspec
import Test.Hspec.Wai
import Protolude
import SpecHelper
-- }}}
spec :: SpecWith Application
test/Feature/DeleteSpec.hs
+3 -3
View File
@@ -1,12 +1,12 @@
module Feature.DeleteSpec where
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Text.Heredoc
import Network.HTTP.Types
import Network.Wai (Application)
import Protolude hiding (get)
spec :: SpecWith Application
test/Feature/ExtraSearchPathSpec.hs
+3 -4
View File
@@ -1,14 +1,13 @@
module Feature.ExtraSearchPathSpec where
import Network.HTTP.Types
import Network.Wai (Application)
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Protolude
import SpecHelper
spec :: SpecWith Application
spec = describe "extra search path" $ do
test/Feature/InsertSpec.hs
+14 -17
View File
@@ -1,27 +1,24 @@
module Feature.InsertSpec where
import Test.Hspec hiding (pendingWith)
import qualified Data.Aeson as JSON
import Control.Monad (replicateM_, void)
import Data.List (lookup)
import Data.Maybe (fromJust)
import Network.Wai (Application)
import Network.Wai.Test (SResponse (simpleBody, simpleHeaders, simpleStatus))
import Test.Hspec hiding (pendingWith)
import Test.Hspec.Wai.Matcher (bodyEquals)
import TestTypes (CompoundPK (..), IncPK (..))
import Network.HTTP.Types
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Test.Hspec.Wai.Matcher (bodyEquals)
import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
import SpecHelper
import qualified Data.Aeson as JSON
import Data.List (lookup)
import Data.Maybe (fromJust)
import Text.Heredoc
import Network.HTTP.Types.Header
import Network.HTTP.Types
import Control.Monad (replicateM_, void)
import TestTypes(IncPK(..), CompoundPK(..))
import Network.Wai (Application)
import Protolude hiding (get)
import PostgREST.Types (PgVersion, pgVersion112)
import Protolude hiding (get)
import SpecHelper
spec :: PgVersion -> SpecWith Application
spec actualPgVersion = do
test/Feature/JsonOperatorSpec.hs
+5 -6
View File
@@ -1,16 +1,15 @@
module Feature.JsonOperatorSpec where
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
import PostgREST.Types (PgVersion, pgVersion112)
import Protolude hiding (get)
import SpecHelper
spec :: PgVersion -> SpecWith Application
spec actualPgVersion = describe "json and jsonb operators" $ do
test/Feature/NoJwtSpec.hs
+5 -4
View File
@@ -1,15 +1,16 @@
module Feature.NoJwtSpec where
-- {{{ Imports
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Protolude
import SpecHelper
-- }}}
spec :: SpecWith Application
test/Feature/NonexistentSchemaSpec.hs
+3 -1
View File
@@ -1,10 +1,12 @@
module Feature.NonexistentSchemaSpec where
import Network.Wai (Application)
import Protolude hiding (get)
import Test.Hspec
import Test.Hspec.Wai
import Protolude hiding (get)
spec :: SpecWith Application
spec =
describe "Non existent api schema" $ do
test/Feature/PgVersion95Spec.hs
+3 -3
View File
@@ -1,13 +1,13 @@
module Feature.PgVersion95Spec where
import Network.Wai (Application)
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Protolude hiding (get)
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
spec :: SpecWith Application
spec = describe "features supported on PostgreSQL 9.5" $
test/Feature/PgVersion96Spec.hs
+3 -3
View File
@@ -1,13 +1,13 @@
module Feature.PgVersion96Spec where
import Network.Wai (Application)
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Protolude hiding (get)
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
spec :: SpecWith Application
spec =
test/Feature/ProxySpec.hs
+4 -5
View File
@@ -1,13 +1,12 @@
module Feature.ProxySpec where
import Test.Hspec hiding (pendingWith)
import Network.Wai (Application)
import Test.Hspec hiding (pendingWith)
import Test.Hspec.Wai
import SpecHelper
import Network.Wai (Application)
import Protolude
import SpecHelper
spec :: SpecWith Application
spec =
test/Feature/QueryLimitedSpec.hs
+6 -5
View File
@@ -1,14 +1,15 @@
module Feature.QueryLimitedSpec where
import Network.Wai (Application)
import Network.Wai.Test (SResponse (simpleHeaders, simpleStatus))
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus))
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
import Protolude hiding (get)
import SpecHelper
spec :: SpecWith Application
spec =
test/Feature/QuerySpec.hs
+6 -5
View File
@@ -1,16 +1,17 @@
module Feature.QuerySpec where
import Network.Wai (Application)
import Network.Wai.Test (SResponse (simpleHeaders))
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleHeaders))
import SpecHelper
import Text.Heredoc
import Network.Wai (Application)
import Protolude hiding (get)
import Protolude hiding (get)
import SpecHelper
spec :: SpecWith Application
spec = do
test/Feature/RangeSpec.hs
+7 -7
View File
@@ -1,17 +1,17 @@
module Feature.RangeSpec where
import qualified Data.ByteString.Lazy as BL
import Network.Wai (Application)
import Network.Wai.Test (SResponse (simpleHeaders, simpleStatus))
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
import qualified Data.ByteString.Lazy as BL
import Protolude hiding (get)
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get)
defaultRange :: BL.ByteString
defaultRange = [json| { "min": 0, "max": 15 } |]
test/Feature/RpcSpec.hs
+8 -8
View File
@@ -1,19 +1,19 @@
module Feature.RpcSpec where
import qualified Data.ByteString.Lazy as BL (empty)
import Network.Wai (Application)
import Network.Wai.Test (SResponse (simpleBody, simpleStatus))
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleStatus, simpleBody))
import qualified Data.ByteString.Lazy as BL (empty)
import SpecHelper
import Text.Heredoc
import Network.Wai (Application)
import Protolude hiding (get)
import PostgREST.Types (PgVersion, pgVersion95)
import Protolude hiding (get)
import SpecHelper
spec :: PgVersion -> SpecWith Application
spec actualPgVersion =
test/Feature/SingularSpec.hs
+6 -6
View File
@@ -1,16 +1,16 @@
module Feature.SingularSpec where
import Text.Heredoc
import Network.Wai (Application)
import Network.Wai.Test (SResponse (..))
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import Network.Wai.Test (SResponse(..))
import Network.Wai (Application)
import Text.Heredoc
import Protolude hiding (get)
import SpecHelper
import Protolude hiding (get)
spec :: SpecWith Application
test/Feature/StructureSpec.hs
+15 -15
View File
@@ -1,22 +1,22 @@
module Feature.StructureSpec where
import Test.Hspec hiding (pendingWith)
import Test.Hspec.Wai
import Network.HTTP.Types
import PostgREST.Config (docsVersion)
import Control.Lens ((^?))
import Control.Lens ((^?))
import Data.Aeson.Types (Value (..))
import Network.Wai (Application)
import Network.Wai.Test (SResponse (..))
import Data.Aeson.Lens
import Data.Aeson.QQ
import Network.HTTP.Types
import Test.Hspec hiding (pendingWith)
import Test.Hspec.Wai
import PostgREST.Config (docsVersion)
import Protolude hiding (get)
import SpecHelper
import Network.Wai (Application)
import Network.Wai.Test (SResponse(..))
import Protolude hiding (get)
spec :: SpecWith Application
spec = do
@@ -251,7 +251,7 @@ spec = do
"type": "string"
}
|]
it "text to string" $ do
r <- simpleBody <$> get "/"
@@ -281,7 +281,7 @@ spec = do
"type": "boolean"
}
|]
it "smallint to integer" $ do
r <- simpleBody <$> get "/"
@@ -296,7 +296,7 @@ spec = do
"type": "integer"
}
|]
it "integer to integer" $ do
r <- simpleBody <$> get "/"
@@ -356,7 +356,7 @@ spec = do
"type": "number"
}
|]
it "double_precision to number" $ do
r <- simpleBody <$> get "/"
test/Feature/UnicodeSpec.hs
+4 -4
View File
@@ -1,15 +1,15 @@
module Feature.UnicodeSpec where
import Control.Monad (void)
import Network.Wai (Application)
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.Wai (Application)
import Control.Monad (void)
import Protolude hiding (get)
import SpecHelper
import Protolude hiding (get)
spec :: SpecWith Application
spec =
describe "Reading and writing to unicode schema and table names" $
test/Feature/UpsertSpec.hs
+6 -6
View File
@@ -1,16 +1,16 @@
module Feature.UpsertSpec where
import Network.Wai (Application)
import Network.HTTP.Types
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Network.HTTP.Types
import SpecHelper
import Network.Wai (Application)
import Protolude hiding (get, put)
import Text.Heredoc
import Protolude hiding (get, put)
import SpecHelper
spec :: SpecWith Application
spec =
describe "UPSERT" $ do
test/Main.hs
+26 -23
View File
@@ -1,23 +1,28 @@
module Main where
import Test.Hspec
import SpecHelper
import qualified Hasql.Pool as P
import qualified Hasql.Pool as P
import qualified Hasql.Transaction.Sessions as HT
import PostgREST.App (postgrest)
import PostgREST.DbStructure (getDbStructure, getPgVersion)
import PostgREST.Types (DbStructure(..), pgVersion95, pgVersion96)
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction)
import Data.Function (id)
import Data.IORef
import Data.Time.Clock (getCurrentTime)
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
updateAction)
import Data.Function (id)
import Data.Time.Clock (getCurrentTime)
import qualified Feature.AuthSpec
import Data.IORef
import Test.Hspec
import PostgREST.App (postgrest)
import PostgREST.DbStructure (getDbStructure, getPgVersion)
import PostgREST.Types (DbStructure (..), pgVersion95,
pgVersion96)
import Protolude
import SpecHelper
import qualified Feature.AndOrParamsSpec
import qualified Feature.AsymmetricJwtSpec
import qualified Feature.BinaryJwtSecretSpec
import qualified Feature.AudienceJwtSecretSpec
import qualified Feature.AuthSpec
import qualified Feature.BinaryJwtSecretSpec
import qualified Feature.ConcurrentSpec
import qualified Feature.CorsSpec
import qualified Feature.DeleteSpec
@@ -25,21 +30,19 @@ import qualified Feature.ExtraSearchPathSpec
import qualified Feature.InsertSpec
import qualified Feature.JsonOperatorSpec
import qualified Feature.NoJwtSpec
import qualified Feature.QueryLimitedSpec
import qualified Feature.QuerySpec
import qualified Feature.RangeSpec
import qualified Feature.StructureSpec
import qualified Feature.SingularSpec
import qualified Feature.UnicodeSpec
import qualified Feature.ProxySpec
import qualified Feature.AndOrParamsSpec
import qualified Feature.RpcSpec
import qualified Feature.NonexistentSchemaSpec
import qualified Feature.PgVersion95Spec
import qualified Feature.PgVersion96Spec
import qualified Feature.ProxySpec
import qualified Feature.QueryLimitedSpec
import qualified Feature.QuerySpec
import qualified Feature.RangeSpec
import qualified Feature.RpcSpec
import qualified Feature.SingularSpec
import qualified Feature.StructureSpec
import qualified Feature.UnicodeSpec
import qualified Feature.UpsertSpec
import Protolude
main :: IO ()
main = do
test/SpecHelper.hs
+21 -24
View File
@@ -1,34 +1,31 @@
module SpecHelper where
import Control.Monad (void)
import qualified Data.ByteString.Base64 as B64 (decodeLenient, encode)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified JSONSchema.Draft4 as D4
import qualified System.IO.Error as E
import qualified System.IO.Error as E
import System.Environment (getEnv)
import Control.Monad (void)
import Data.Aeson (Value (..), decode)
import Data.CaseInsensitive (CI (..))
import Data.List (lookup)
import Data.Maybe (fromJust)
import Network.Wai.Test (SResponse (simpleBody, simpleHeaders, simpleStatus))
import System.Environment (getEnv)
import System.Process (readProcess)
import Text.Regex.TDFA ((=~))
import qualified Data.ByteString.Base64 as B64 (encode, decodeLenient)
import Data.CaseInsensitive (CI(..))
import qualified Data.Set as S
import qualified Data.Map.Strict as M
import Data.List (lookup)
import Text.Regex.TDFA ((=~))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BL
import System.Process (readProcess)
import Text.Heredoc
import PostgREST.Config (AppConfig(..))
import PostgREST.Types (JSPathExp(..))
import Test.Hspec
import Test.Hspec.Wai
import Network.HTTP.Types
import Network.Wai.Test (SResponse(simpleStatus, simpleHeaders, simpleBody))
import Data.Maybe (fromJust)
import Data.Aeson (decode, Value(..))
import qualified JSONSchema.Draft4 as D4
import Test.Hspec
import Test.Hspec.Wai
import Text.Heredoc
import PostgREST.Config (AppConfig (..))
import PostgREST.Types (JSPathExp (..))
import Protolude
matchContentTypeJson :: MatchHeader
test/TestTypes.hs
+6 -6
View File
@@ -3,16 +3,16 @@ module TestTypes (
, CompoundPK(..)
) where
import Data.Aeson ((.:))
import qualified Data.Aeson as JSON
import Data.Aeson ((.:))
import Protolude
data IncPK = IncPK {
incId :: Int
incId :: Int
, incNullableStr :: Maybe Text
, incStr :: Text
, incInsert :: Text
, incStr :: Text
, incInsert :: Text
} deriving (Eq, Show)
instance JSON.FromJSON IncPK where
@@ -24,8 +24,8 @@ instance JSON.FromJSON IncPK where
parseJSON _ = mzero
data CompoundPK = CompoundPK {
compoundK1 :: Int
, compoundK2 :: Text
compoundK1 :: Int
, compoundK2 :: Text
, compoundExtra :: Maybe Int
} deriving (Eq, Show)