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

Merge pull request #193 from srid/makelibrary

Browse Source 
Make postgrest a library
This commit is contained in:
Joe Nelson
2015-05-19 23:59:16 -07:00
parent 035acebf59 c3ad87ffaf
commit da79f1da3e
14 changed files with 79 additions and 106 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CHANGELOG.md
+1
View File
@@ -11,6 +11,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
- Return PATCHed resources if header "Prefer: return=representation"
- Allow nested objects and arrays in JSON post for jsonb columns
- JSON Web Tokens - [Federico Rampazzo](https://github.com/framp)
- Expose PostgREST as a Haskell package
### Fixed
circle.yml
+1 -1
View File
@@ -6,5 +6,5 @@ machine:
version: 7.8.3
test:
post:
- cabal exec hlint -- -X QuasiQuotes src/*.hs test/**/*.hs
- cabal exec hlint -- -X QuasiQuotes src/**/*.hs test/**/*.hs
- cabal exec packdeps postgrest.cabal
postgrest.cabal
+48 -19
View File
@@ -14,7 +14,38 @@ build-type: Simple
cabal-version: >=1.10
executable postgrest
main-is: Main.hs
main-is: PostgREST/Main.hs
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
build-depends: base >=4.6 && <5
, postgrest
, hasql == 0.7.3.1, hasql-backend == 0.4.1
, hasql-postgres == 0.10.3.1
, warp >= 3.0.2, wai >= 3.0.1
, wai-extra, wai-cors
, wai-middleware-static >= 0.6.0
, HTTP, convertible, http-types
, case-insensitive
, scientific, time
, aeson, network >= 2.6
, bytestring, text, split, string-conversions
, stringsearch
, containers, unordered-containers
, optparse-applicative == 0.11.*
, regex-base, regex-tdfa
, regex-tdfa-text
, Ranged-sets
, transformers, MissingH
, bcrypt >= 0.0.6, base64-string
, network-uri >= 2.6
, resource-pool
, blaze-builder
, vector
, mtl
, cassava
, jwt
hs-source-dirs: src
library
ghc-options: -Wall -W -O2
default-language: Haskell2010
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
@@ -44,15 +75,14 @@ executable postgrest
, mtl
, cassava
, jwt
Other-Modules: App
, Auth
, Config
, Error
, Middleware
, PgQuery
, PgStructure
, RangeQuery
, Types
Exposed-Modules: PostgREST.App
, PostgREST.Auth
, PostgREST.Config
, PostgREST.Error
, PostgREST.Middleware
, PostgREST.PgQuery
, PostgREST.PgStructure
, PostgREST.RangeQuery
hs-source-dirs: src
Test-Suite spec
@@ -62,15 +92,14 @@ Test-Suite spec
Hs-Source-Dirs: test, src
ghc-options: -Wall -W -Werror
Main-Is: Main.hs
Other-Modules: App
, Auth
, Config
, Error
, Middleware
, PgQuery
, PgStructure
, RangeQuery
, Types
Other-Modules: PostgREST.App
, PostgREST.Auth
, PostgREST.Config
, PostgREST.Error
, PostgREST.Middleware
, PostgREST.PgQuery
, PostgREST.PgStructure
, PostgREST.RangeQuery
, Spec
, SpecHelper
Build-Depends: base, hspec >= 2.1.2, QuickCheck
src/App.hs → src/PostgREST/App.hs
+9 -9
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE FlexibleContexts #-}
module App (app, sqlError, isSqlError) where
module PostgREST.App (app, sqlError, isSqlError) where
import Control.Monad (join)
import Control.Arrow ((***), second)
@@ -34,11 +34,11 @@ import qualified Hasql as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import Config (AppConfig(..))
import Auth
import PgQuery
import RangeQuery
import PgStructure
import PostgREST.Config (AppConfig(..))
import PostgREST.Auth
import PostgREST.PgQuery
import PostgREST.RangeQuery
import PostgREST.PgStructure
import Prelude
@@ -105,13 +105,13 @@ app conf reqBody req =
, (hLocation, "/postgrest/users?id=eq." <> cs (userId u))
] ""
(["postgrest", "tokens"], "POST") ->
(["postgrest", "tokens"], "POST") ->
case jwtSecret of
"secret" -> return $ responseLBS status500 [jsonH] $
encode . object $ [("message", String "JWT Secret is set as \"secret\" which is an unsafe default.")]
_ -> do
let user = decode reqBody :: Maybe AuthUser
case user of
Nothing -> return $ responseLBS status400 [jsonH] $
encode . object $ [("message", String "Failed to parse user.")]
@@ -120,7 +120,7 @@ app conf reqBody req =
login <- signInRole (cs $ userId u)
(cs $ userPass u)
case login of
LoginSuccess role ->
LoginSuccess role ->
return $ responseLBS status201 [ jsonH ] $
encode . object $ [("token", String $ tokenJWT jwtSecret (cs $ userId u) role)]
_ -> return $ responseLBS status401 [jsonH] $
src/Auth.hs → src/PostgREST/Auth.hs
+2 -2
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-}
module Auth where
module PostgREST.Auth where
import Data.Aeson
import Control.Monad (mzero)
@@ -14,7 +14,7 @@ import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import qualified Web.JWT as JWT
import Data.String.Conversions (cs)
import PgQuery (pgFmtLit)
import PostgREST.PgQuery (pgFmtLit)
import Prelude
src/Config.hs → src/PostgREST/Config.hs
+1 -1
View File
@@ -1,4 +1,4 @@
module Config where
module PostgREST.Config where
import Network.Wai
import Control.Applicative
src/Error.hs → src/PostgREST/Error.hs
+1 -1
View File
@@ -1,7 +1,7 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
module Error (PgError, errResponse) where
module PostgREST.Error (PgError, errResponse) where
import qualified Hasql as H
import qualified Hasql.Postgres as P
src/Main.hs → src/PostgREST/Main.hs
+4 -4
View File
@@ -2,9 +2,9 @@ module Main where
import Paths_postgrest (version)
import App
import Middleware
import Error(errResponse)
import PostgREST.App
import PostgREST.Middleware
import PostgREST.Error(errResponse)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
@@ -21,7 +21,7 @@ import qualified Hasql as H
import qualified Hasql.Postgres as P
import Options.Applicative hiding (columns)
import Config (AppConfig(..), argParser, corsPolicy)
import PostgREST.Config (AppConfig(..), argParser, corsPolicy)
main :: IO ()
main = do
src/Middleware.hs → src/PostgREST/Middleware.hs
+3 -3
View File
@@ -1,7 +1,7 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Middleware where
module PostgREST.Middleware where
import Data.Maybe (fromMaybe)
import Data.Monoid
@@ -19,8 +19,8 @@ import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo,
rawQueryString, isSecure, Request(..), Response)
import Network.URI (URI(..), parseURI)
import Config (AppConfig(..))
import Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, resetRole)
import PostgREST.Config (AppConfig(..))
import PostgREST.Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, resetRole)
import Codec.Binary.Base64.String (decode)
import Prelude
src/PgQuery.hs → src/PostgREST/PgQuery.hs
+2 -2
View File
@@ -1,9 +1,9 @@
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiWayIf #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module PgQuery where
module PostgREST.PgQuery where
import RangeQuery
import PostgREST.RangeQuery
import qualified Hasql as H
import qualified Hasql.Postgres as P
src/PgStructure.hs → src/PostgREST/PgStructure.hs
+2 -2
View File
@@ -1,9 +1,9 @@
{-# LANGUAGE QuasiQuotes, OverloadedStrings, TypeSynonymInstances,
MultiParamTypeClasses, ScopedTypeVariables,
FlexibleContexts #-}
module PgStructure where
module PostgREST.PgStructure where
import PgQuery (QualifiedTable(..))
import PostgREST.PgQuery (QualifiedTable(..))
import Data.Text hiding (foldl, map, zipWith, concat)
import Data.Aeson
import Data.Functor.Identity
src/RangeQuery.hs → src/PostgREST/RangeQuery.hs
+1 -1
View File
@@ -1,4 +1,4 @@
module RangeQuery (
module PostgREST.RangeQuery (
rangeParse
, rangeRequested
, rangeLimit
src/Types.hs
-57
View File
@@ -1,57 +0,0 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Types where
import qualified Data.Aeson as JSON
import Data.Aeson.Types (Parser)
import Data.Scientific (floatingOrInteger)
import Data.HashMap.Strict (foldlWithKey')
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import Data.Time.Calendar (showGregorian)
import Control.Monad (mzero)
instance JSON.FromJSON SqlValue where
parseJSON (JSON.Number n) = return $ either toSql iToSql (floatingOrInteger n :: Either Double Int)
parseJSON (JSON.String s) = return $ toSql s
parseJSON (JSON.Bool b) = return $ toSql b
parseJSON JSON.Null = return SqlNull
parseJSON (JSON.Object o) = return . toSql $ JSON.encode o
parseJSON (JSON.Array a) = return . toSql $ JSON.encode a
instance JSON.ToJSON SqlValue where
toJSON (SqlString s) = JSON.toJSON s
toJSON (SqlByteString s) = JSON.toJSON $ decodeUtf8 s
toJSON (SqlWord32 w) = JSON.toJSON w
toJSON (SqlWord64 w) = JSON.toJSON w
toJSON (SqlInt32 i) = JSON.toJSON i
toJSON (SqlInt64 i) = JSON.toJSON i
toJSON (SqlInteger i) = JSON.toJSON i
toJSON (SqlChar c) = JSON.toJSON c
toJSON (SqlBool b) = JSON.toJSON b
toJSON (SqlDouble n) = JSON.toJSON n
toJSON (SqlRational n) = JSON.toJSON n
toJSON (SqlLocalDate d) = JSON.toJSON $ showGregorian d
toJSON (SqlLocalTimeOfDay t) = JSON.toJSON $ show t
toJSON (SqlLocalTime t) = JSON.toJSON $ show t
toJSON SqlNull = JSON.Null
toJSON x = JSON.toJSON $ show x
newtype SqlRow = SqlRow {getRow :: [(Text, SqlValue)] } deriving (Show)
sqlRowColumns :: SqlRow -> [Text]
sqlRowColumns = map fst . getRow
sqlRowValues :: SqlRow -> [SqlValue]
sqlRowValues = map snd . getRow
instance JSON.FromJSON SqlRow where
parseJSON (JSON.Object m) = foldlWithKey' add (return $ SqlRow []) m
where
add :: Parser SqlRow -> Text -> JSON.Value -> Parser SqlRow
add parser k v = do
SqlRow l <- parser
sqlV <- JSON.parseJSON v
return . SqlRow $ (k, sqlV) : l
parseJSON _ = mzero
test/SpecHelper.hs
+4 -4
View File
@@ -26,10 +26,10 @@ import System.Process (readProcess)
import qualified Data.Aeson.Types as J
import App (app)
import Config (AppConfig(..), corsPolicy)
import Middleware
import Error(errResponse)
import PostgREST.App (app)
import PostgREST.Config (AppConfig(..), corsPolicy)
import PostgREST.Middleware
import PostgREST.Error(errResponse)
isLeft :: Either a b -> Bool
isLeft (Left _ ) = True