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

Merge pull request #657 from diogob/protolude-first-fugues

Browse Source 
Protolude first fugues
This commit is contained in:
Joe Nelson
2016-06-30 08:27:58 -07:00
committed by GitHub
parent f7aa8b7ad5 578ae6b5dd
commit d102d954ac
8 changed files with 34 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
circle.yml
+1 -1
View File
@@ -17,7 +17,7 @@ dependencies:
test:
override:
- stack test
- stack test --test-arguments "--skip \"returns a valid openapi\""
- git ls-files | grep '\.l\?hs$' | xargs stack exec -- hlint -X QuasiQuotes -X NoPatternSynonyms "$@"
- stack exec -- cabal update
- stack exec --no-ghc-package-path -- cabal install --only-d --dry-run
main/Main.hs
+1 -1
View File
@@ -2,7 +2,7 @@
module Main where
import Prelude
import PostgREST.App
import PostgREST.Config (AppConfig (..),
minimumPgVersion,
postgrest.cabal
+4 -2
View File
@@ -23,7 +23,7 @@ Flag CI
executable postgrest
main-is: Main.hs
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes, NoImplicitPrelude
ghc-options:
-threaded
-rtsopts
@@ -69,6 +69,7 @@ executable postgrest
, swagger2 >= 2.1
, HTTP
, Ranged-sets
, protolude >= 0.1.5 && < 0.2.0
if !os(windows)
build-depends: unix >= 2.7 && < 3
@@ -76,7 +77,7 @@ executable postgrest
library
default-language: Haskell2010
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes, NoImplicitPrelude
build-depends: aeson
, base
, bytestring
@@ -113,6 +114,7 @@ library
, warp >= 3.1.0
, insert-ordered-containers >= 0.1.0.1
, swagger2 >= 2.1
, protolude >= 0.1.5 && < 0.2.0
Other-Modules: Paths_postgrest
Exposed-Modules: PostgREST.App
src/PostgREST/ApiRequest.hs
+2
View File
@@ -1,5 +1,7 @@
module PostgREST.ApiRequest where
import Prelude
import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
src/PostgREST/Auth.hs
+3 -5
View File
@@ -18,17 +18,15 @@ module PostgREST.Auth (
, tokenJWT
) where
import Protolude
import Control.Lens
import Data.Aeson (Value (..), parseJSON, toJSON)
import Data.Aeson.Lens
import Data.Aeson.Types (parseMaybe, emptyObject, emptyArray)
import qualified Data.ByteString as BS
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as M
import Data.Maybe (fromMaybe, maybeToList, fromJust)
import Data.Monoid ((<>))
import Data.Maybe (fromJust)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Time.Clock (NominalDiffTime)
import PostgREST.QueryBuilder (pgFmtIdent, pgFmtLit, unquoted)
import qualified Web.JWT as JWT
@@ -39,7 +37,7 @@ import qualified Web.JWT as JWT
have a claim called role, this one is mapped to a SET ROLE
statement.
-}
claimsToSQL :: M.HashMap Text Value -> [BS.ByteString]
claimsToSQL :: M.HashMap Text Value -> [ByteString]
claimsToSQL claims = roleStmts <> varStmts
where
roleStmts = maybeToList $
src/PostgREST/Error.hs
+20 -24
View File
@@ -4,13 +4,9 @@
module PostgREST.Error (pgErrResponse, errResponse) where
import Protolude
import Data.Aeson ((.=))
import qualified Data.Aeson as JSON
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.String.Conversions (cs)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Hasql.Pool as P
import qualified Hasql.Session as H
@@ -19,7 +15,7 @@ import qualified Network.HTTP.Types.Status as HT
import Network.Wai (Response, responseLBS)
errResponse :: HT.Status -> Text -> Response
errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"])
errResponse status message = responseLBS status [(hContentType, "application/json")] (toS $ T.concat ["{\"message\":\"",message,"\"}"])
pgErrResponse :: Bool -> P.UsageError -> Response
pgErrResponse authed e =
@@ -35,41 +31,41 @@ instance JSON.ToJSON P.UsageError where
toJSON (P.ConnectionError e) = JSON.object [
"code" .= ("" :: T.Text),
"message" .= ("Connection error" :: T.Text),
"details" .= (cs (fromMaybe "" e) :: T.Text)]
"details" .= (toS $ fromMaybe "" e :: T.Text)]
toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
instance JSON.ToJSON H.Error where
toJSON (H.ResultError (H.ServerError c m d h)) = JSON.object [
"code" .= (cs c::T.Text),
"message" .= (cs m::T.Text),
"details" .= (fmap cs d::Maybe T.Text),
"hint" .= (fmap cs h::Maybe T.Text)]
"code" .= (toS c::T.Text),
"message" .= (toS m::T.Text),
"details" .= (fmap toS d::Maybe T.Text),
"hint" .= (fmap toS h::Maybe T.Text)]
toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [
"message" .= (cs m::T.Text)]
"message" .= (m::T.Text)]
toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [
"message" .= ("Row error: end of input"::String),
"message" .= ("Row error: end of input"::T.Text),
"details" .=
("Attempt to parse more columns than there are in the result"::String),
"details" .= ("Row number " <> show i)]
("Attempt to parse more columns than there are in the result"::Text),
"details" .= (("Row number " <> show i)::Text)]
toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [
"message" .= ("Row error: unexpected null"::String),
"details" .= ("Attempt to parse a NULL as some value."::String),
"details" .= ("Row number " <> show i)]
"message" .= ("Row error: unexpected null"::Text),
"details" .= ("Attempt to parse a NULL as some value."::Text),
"details" .= (("Row number " <> show i)::Text)]
toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [
"message" .= ("Row error: Wrong value parser used"::String),
"message" .= ("Row error: Wrong value parser used"::Text),
"details" .= d,
"details" .= ("Row number " <> show i)]
"details" .= (("Row number " <> show i)::Text)]
toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [
"message" .= ("Unexpected amount of rows"::String),
"message" .= ("Unexpected amount of rows"::Text),
"details" .= i]
toJSON (H.ClientError d) = JSON.object [
"message" .= ("Database client error"::String),
"details" .= (fmap cs d::Maybe T.Text)]
"message" .= ("Database client error"::Text),
"details" .= (fmap toS d::Maybe T.Text)]
httpStatus :: Bool -> P.UsageError -> HT.Status
httpStatus _ (P.ConnectionError _) = HT.status500
httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
case cs c of
case toS c of
'0':'8':_ -> HT.status503 -- pg connection err
'0':'9':_ -> HT.status500 -- triggered action exception
'0':'L':_ -> HT.status403 -- invalid grantor
src/PostgREST/Parsers.hs
+1
View File
@@ -3,6 +3,7 @@ module PostgREST.Parsers
-- )
where
import Prelude
import Control.Applicative hiding ((<$>))
import Data.Monoid
import Data.String.Conversions (cs)
src/PostgREST/Types.hs
+2 -2
View File
@@ -1,9 +1,9 @@
module PostgREST.Types where
import Protolude
import qualified GHC.Show
import Data.Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Data.Int (Int32)
import Data.Text
import Data.Tree
import qualified Data.Vector as V
import PostgREST.RangeQuery (NonnegRange)