Do not quote params in Location header

Also treat the enum field in OPTIONS as an array uniformly

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]

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
+instance FromJSON AuthUser where
-  parseJSON (JSON.Object v) = AuthUser <$>
+  parseJSON (Object v) = AuthUser <$>
-                         v JSON..: "id" <*>
+                         v .: "id" <*>
-                         v JSON..: "pass" <*>
+                         v .: "pass" <*>
-                         v JSON..: "role"
+                         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 =

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
+        name       = H.parseResult $ r V.! 1
-        insertable = toBool <$> (H.parseResult $ r V.! 3 :: Either Text Text) in
+        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

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" $

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";
+spec = around withApp $ do
-uRole = "dbapi_test"} in
+  let uName = "a user"
-  around withDatabaseConnection $
+      uPass = "nobody can ever know"
-  aroundWith (withUser uName uPass uRole) $ aroundWith withApp $ do
   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"}
           }
         ]

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"] []