From c3ad87ffaf19fd105188d39f3bf351e657e18263 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Tue, 19 May 2015 23:40:39 -0700 Subject: [PATCH] Make postgrest usable as a library --- CHANGELOG.md | 1 + circle.yml | 2 +- postgrest.cabal | 67 +++++++++++++++++++++--------- src/{ => PostgREST}/App.hs | 18 ++++---- src/{ => PostgREST}/Auth.hs | 4 +- src/{ => PostgREST}/Config.hs | 2 +- src/{ => PostgREST}/Error.hs | 2 +- src/{ => PostgREST}/Main.hs | 8 ++-- src/{ => PostgREST}/Middleware.hs | 6 +-- src/{ => PostgREST}/PgQuery.hs | 4 +- src/{ => PostgREST}/PgStructure.hs | 4 +- src/{ => PostgREST}/RangeQuery.hs | 2 +- src/Types.hs | 57 ------------------------- test/SpecHelper.hs | 8 ++-- 14 files changed, 79 insertions(+), 106 deletions(-) rename src/{ => PostgREST}/App.hs (97%) rename src/{ => PostgREST}/Auth.hs (97%) rename src/{ => PostgREST}/Config.hs (98%) rename src/{ => PostgREST}/Error.hs (98%) rename src/{ => PostgREST}/Main.hs (94%) rename src/{ => PostgREST}/Middleware.hs (94%) rename src/{ => PostgREST}/PgQuery.hs (99%) rename src/{ => PostgREST}/PgStructure.hs (98%) rename src/{ => PostgREST}/RangeQuery.hs (98%) delete mode 100644 src/Types.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index eb8e4a88e..400c03709 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/circle.yml b/circle.yml index 4ba35a9a5..19aafe43d 100644 --- a/circle.yml +++ b/circle.yml @@ -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 diff --git a/postgrest.cabal b/postgrest.cabal index ebc7556f3..b73ae432a 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -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 diff --git a/src/App.hs b/src/PostgREST/App.hs similarity index 97% rename from src/App.hs rename to src/PostgREST/App.hs index b3acdf86d..d52994416 100644 --- a/src/App.hs +++ b/src/PostgREST/App.hs @@ -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] $ diff --git a/src/Auth.hs b/src/PostgREST/Auth.hs similarity index 97% rename from src/Auth.hs rename to src/PostgREST/Auth.hs index e8603a422..3b0334749 100644 --- a/src/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -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 diff --git a/src/Config.hs b/src/PostgREST/Config.hs similarity index 98% rename from src/Config.hs rename to src/PostgREST/Config.hs index 321a033df..477e44525 100644 --- a/src/Config.hs +++ b/src/PostgREST/Config.hs @@ -1,4 +1,4 @@ -module Config where +module PostgREST.Config where import Network.Wai import Control.Applicative diff --git a/src/Error.hs b/src/PostgREST/Error.hs similarity index 98% rename from src/Error.hs rename to src/PostgREST/Error.hs index e8f8a9910..176b5a327 100644 --- a/src/Error.hs +++ b/src/PostgREST/Error.hs @@ -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 diff --git a/src/Main.hs b/src/PostgREST/Main.hs similarity index 94% rename from src/Main.hs rename to src/PostgREST/Main.hs index b94e566ab..22fa11dde 100644 --- a/src/Main.hs +++ b/src/PostgREST/Main.hs @@ -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 diff --git a/src/Middleware.hs b/src/PostgREST/Middleware.hs similarity index 94% rename from src/Middleware.hs rename to src/PostgREST/Middleware.hs index 95e132a5e..7f1ca4079 100644 --- a/src/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -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 diff --git a/src/PgQuery.hs b/src/PostgREST/PgQuery.hs similarity index 99% rename from src/PgQuery.hs rename to src/PostgREST/PgQuery.hs index 3c40271e9..d1adffa1d 100644 --- a/src/PgQuery.hs +++ b/src/PostgREST/PgQuery.hs @@ -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 diff --git a/src/PgStructure.hs b/src/PostgREST/PgStructure.hs similarity index 98% rename from src/PgStructure.hs rename to src/PostgREST/PgStructure.hs index 7d909e678..0f4f0182d 100644 --- a/src/PgStructure.hs +++ b/src/PostgREST/PgStructure.hs @@ -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 diff --git a/src/RangeQuery.hs b/src/PostgREST/RangeQuery.hs similarity index 98% rename from src/RangeQuery.hs rename to src/PostgREST/RangeQuery.hs index 3614e8379..ac1b9c6d6 100644 --- a/src/RangeQuery.hs +++ b/src/PostgREST/RangeQuery.hs @@ -1,4 +1,4 @@ -module RangeQuery ( +module PostgREST.RangeQuery ( rangeParse , rangeRequested , rangeLimit diff --git a/src/Types.hs b/src/Types.hs deleted file mode 100644 index 27e323357..000000000 --- a/src/Types.hs +++ /dev/null @@ -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 diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 3afd0aafe..a6e116dfe 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -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