From f1ecbec543610e47cd9ec86a0796a5a5d5807754 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Wed, 26 Nov 2014 21:36:26 -0800 Subject: [PATCH] Do not quote params in Location header Also treat the enum field in OPTIONS as an array uniformly --- src/App.hs | 8 ++++- src/Auth.hs | 18 ++++++++---- src/PgStructure.hs | 16 ++++++---- test/Feature/QuerySpec.hs | 13 --------- .../{StructureSpec.hx => StructureSpec.hs} | 29 +++++++++---------- test/Main.hs | 2 +- 6 files changed, 44 insertions(+), 42 deletions(-) rename test/Feature/{StructureSpec.hx => StructureSpec.hs} (90%) diff --git a/src/App.hs b/src/App.hs index d46466671..785367f12 100644 --- a/src/App.hs +++ b/src/App.hs @@ -116,7 +116,7 @@ app req = then inserted else filterWithKey (const . (`elem` primaryKeys)) inserted let params = urlEncodeVars - $ map (\t -> (cs $ fst t, "eq." <> cs (encode $ snd t))) + $ map (\t -> (cs $ fst t, "eq." <> cs (unquoted $ snd t))) $ sortBy (comparing fst) $ toList primaries return $ responseLBS status201 [ jsonH @@ -224,6 +224,12 @@ handleJsonObj req handler = do jErr = encode . object $ [("error", String "Expecting a JSON object")] +unquoted :: Value -> Text +unquoted (String t) = t +unquoted (Number n) = cs . show $ n +unquoted (Bool b) = cs . show $ b +unquoted _ = "" + data TableOptions = TableOptions { tblOptcolumns :: [Column] , tblOptpkey :: [Text] diff --git a/src/Auth.hs b/src/Auth.hs index 4b87243b5..4e86d31fd 100644 --- a/src/Auth.hs +++ b/src/Auth.hs @@ -1,7 +1,7 @@ {-# LANGUAGE QuasiQuotes, ScopedTypeVariables #-} module Auth where -import qualified Data.Aeson as JSON +import Data.Aeson import Control.Monad (mzero) import Control.Applicative ( (<*>), (<$>) ) import Crypto.BCrypt @@ -16,13 +16,19 @@ data AuthUser = AuthUser { , userRole :: String } -instance JSON.FromJSON AuthUser where - parseJSON (JSON.Object v) = AuthUser <$> - v JSON..: "id" <*> - v JSON..: "pass" <*> - v JSON..: "role" +instance FromJSON AuthUser where + parseJSON (Object v) = AuthUser <$> + v .: "id" <*> + v .: "pass" <*> + v .: "role" parseJSON _ = mzero +instance ToJSON AuthUser where + toJSON u = object [ + "id" .= userId u + , "pass" .= userPass u + , "role" .= userRole u ] + type DbRole = Text data LoginAttempt = diff --git a/src/PgStructure.hs b/src/PgStructure.hs index 89e85c58c..cff646428 100644 --- a/src/PgStructure.hs +++ b/src/PgStructure.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE QuasiQuotes, MultiParamTypeClasses, ScopedTypeVariables #-} +{-# LANGUAGE QuasiQuotes, OverloadedStrings, + MultiParamTypeClasses, ScopedTypeVariables #-} module PgStructure where import PgQuery (QualifiedTable(..)) @@ -127,7 +128,7 @@ data Column = Column { , colMaxLen :: Maybe Int , colPrecision :: Maybe Int , colDefault :: Maybe Text -, colEnum :: Maybe [Text] +, colEnum :: [Text] , colFK :: Maybe ForeignKey } deriving (Show) @@ -143,19 +144,22 @@ instance H.RowParser H.Postgres Column where maxLen = H.parseResult $ r V.! 7 precision = H.parseResult $ r V.! 8 defValue = H.parseResult $ r V.! 9 - enum = H.parseResult $ r V.! 10 in + enum = either (const $ Right []) (Right . split (==',')) + (H.parseResult $ r V.! 10 :: Either Text Text) + in if V.length r /= 11 then Left "Wrong number of fields in Column" else Column <$> schema <*> table <*> name <*> position <*> nullable <*> typ <*> updatable <*> maxLen <*> precision - <*> defValue <*> enum <*> return Nothing + <*> defValue <*> enum + <*> return Nothing instance H.RowParser H.Postgres Table where parseRow r = let schema = H.parseResult $ r V.! 0 - name = H.parseResult $ r V.! 2 - insertable = toBool <$> (H.parseResult $ r V.! 3 :: Either Text Text) in + name = H.parseResult $ r V.! 1 + insertable = toBool <$> (H.parseResult $ r V.! 2 :: Either Text Text) in if V.length r /= 3 then Left "Wrong number of fields in Table" else Table <$> schema <*> name <*> insertable diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 5de26a271..f423486cc 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -5,19 +5,6 @@ import Test.Hspec.Wai import SpecHelper --- around :: (ActionWith a -> IO ()) -> SpecWith a -> Spec --- type Spec = SpecWith () --- type ActionWith a = a -> IO () --- --- get :: ByteString -> WaiSession SResponse --- newtype WaiSession a = WaiSession {unWaiSession :: Session a} --- type Session = ReaderT Application (StateT ClientState IO) --- --- type Application = --- Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived --- --- runApp :: Request -> (Response -> IO Postgres) -> IO Postgres - spec :: Spec spec = around withApp $ do describe "Querying a nonexistent table" $ diff --git a/test/Feature/StructureSpec.hx b/test/Feature/StructureSpec.hs similarity index 90% rename from test/Feature/StructureSpec.hx rename to test/Feature/StructureSpec.hs index 7ef6471f3..73b0c139f 100644 --- a/test/Feature/StructureSpec.hx +++ b/test/Feature/StructureSpec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} module Feature.StructureSpec where import Test.Hspec @@ -13,14 +13,13 @@ import Data.Monoid ((<>)) import Data.String.Conversions (cs) spec :: Spec -spec = let {uName = "a user"; uPass = "nobody can ever know"; -uRole = "dbapi_test"} in - around withDatabaseConnection $ - aroundWith (withUser uName uPass uRole) $ aroundWith withApp $ do +spec = around withApp $ do + let uName = "a user" + uPass = "nobody can ever know" describe "GET /" $ it "lists views in schema" $ request methodGet "/" - [("Authorization", "Basic "<>(cs.encode $ cs uName<>":"<>cs uPass))] "" + [("Authorization", "Basic "<>(uName<>":"<>uPass))] "" `shouldRespondWith` [json| [ {"schema":"1","name":"authors_only","insertable":true} , {"schema":"1","name":"auto_incrementing_pk","insertable":true} @@ -48,7 +47,7 @@ uRole = "dbapi_test"} in "name": "integer", "type": "integer", "maxLen": null, - "enum": null, + "enum": [], "nullable": false, "position": 1, "references": null, @@ -61,7 +60,7 @@ uRole = "dbapi_test"} in "name": "double", "type": "double precision", "maxLen": null, - "enum": null, + "enum": [], "nullable": false, "references": null, "position": 2 @@ -73,7 +72,7 @@ uRole = "dbapi_test"} in "name": "varchar", "type": "character varying", "maxLen": null, - "enum": null, + "enum": [], "nullable": false, "position": 3, "references": null, @@ -86,7 +85,7 @@ uRole = "dbapi_test"} in "name": "boolean", "type": "boolean", "maxLen": null, - "enum": null, + "enum": [], "nullable": false, "references": null, "position": 4 @@ -98,7 +97,7 @@ uRole = "dbapi_test"} in "name": "date", "type": "date", "maxLen": null, - "enum": null, + "enum": [], "nullable": false, "references": null, "position": 5 @@ -110,7 +109,7 @@ uRole = "dbapi_test"} in "name": "money", "type": "money", "maxLen": null, - "enum": null, + "enum": [], "nullable": false, "position": 6, "references": null, @@ -153,7 +152,7 @@ uRole = "dbapi_test"} in "maxLen": null, "nullable": false, "position": 1, - "enum": null, + "enum": [], "references": null }, { "default": null, @@ -165,7 +164,7 @@ uRole = "dbapi_test"} in "maxLen": null, "nullable": true, "position": 2, - "enum": null, + "enum": [], "references": {"table": "auto_incrementing_pk", "column": "id"} }, { "default": null, @@ -177,7 +176,7 @@ uRole = "dbapi_test"} in "maxLen": 255, "nullable": true, "position": 3, - "enum": null, + "enum": [], "references": {"table": "simple_pk", "column": "k"} } ] diff --git a/test/Main.hs b/test/Main.hs index 55ce390a6..ac0a2cf82 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -23,4 +23,4 @@ main = do loadFixture :: FilePath -> IO() loadFixture name = - void $ readProcess "psql" ["-U", "postgres", "-d", "dbapi_test", "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] [] + void $ readProcess "psql" ["-U", "dbapi_test", "-d", "dbapi_test", "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []