diff --git a/apiary.cabal b/apiary.cabal --- a/apiary.cabal +++ b/apiary.cabal @@ -1,5 +1,5 @@ name: apiary -version: 0.5.0.0 +version: 0.5.1.0 x-revision: 1 synopsis: Simple web framework inspired by scotty. description: @@ -109,8 +109,9 @@ , wai-test >=2.0 && <2.1 , apiary , bytestring >=0.10 && <0.11 + , http-types >=0.8 && <0.9 hs-source-dirs: test - ghc-options: -O2 -Wall + ghc-options: -O2 -Wall -fno-warn-missing-signatures default-language: Haskell2010 source-repository head diff --git a/src/Control/Monad/Apiary/Filter.hs b/src/Control/Monad/Apiary/Filter.hs --- a/src/Control/Monad/Apiary/Filter.hs +++ b/src/Control/Monad/Apiary/Filter.hs @@ -15,9 +15,13 @@ , capture -- ** query matcher + , query + , pFirst, pOne, pOption, pCheck, pMany, pSome + -- *** specified operators , (=:), (=!:), (=?:), (?:), (=*:), (=+:) , hasQuery + -- ** other , ssl @@ -83,81 +87,62 @@ -- | get first matched paramerer. since 0.5.0.0. -- -- @ --- "key" =: pInt == query "key" (Proxy :: Proxy (First Int)) +-- "key" =: pInt == query "key" (pFirst pInt) == query "key" (Proxy :: Proxy (First Int)) -- @ (=:) :: (Query a, Monad m) => S.ByteString -> Proxy a -> ApiaryT (Snoc as a) m b -> ApiaryT as m b -k =: t = query k (asFirst t) - where - asFirst :: Proxy a -> Proxy (First a) - asFirst _ = Proxy - +k =: t = query k (pFirst t) -- | get one matched paramerer. since 0.5.0.0. -- -- when more one parameger given, not matched. -- -- @ --- "key" =: pInt == query "key" (Proxy :: Proxy (One Int)) +-- "key" =: pInt == query "key" (pOne pInt) == query "key" (Proxy :: Proxy (One Int)) -- @ (=!:) :: (Query a, Monad m) => S.ByteString -> Proxy a -> ApiaryT (Snoc as a) m b -> ApiaryT as m b -k =!: t = query k (asOne t) - where - asOne :: Proxy a -> Proxy (One a) - asOne _ = Proxy +k =!: t = query k (pOne t) -- | get optional first paramerer. since 0.5.0.0. -- -- when illegal type parameter given, fail mather(don't give Nothing). -- -- @ --- "key" =: pInt == query "key" (Proxy :: Proxy (Option Int)) +-- "key" =: pInt == query "key" (pOption pInt) == query "key" (Proxy :: Proxy (Option Int)) -- @ (=?:) :: (Query a, Monad m) => S.ByteString -> Proxy a -> ApiaryT (Snoc as (Maybe a)) m b -> ApiaryT as m b -k =?: t = query k (asOption t) - where - asOption :: Proxy a -> Proxy (Option a) - asOption _ = Proxy +k =?: t = query k (pOption t) -- | check parameger given and type. since 0.5.0.0. -- -- If you wan't to allow any type, give 'pVoid'. -- -- @ --- "key" =: pInt == query "key" (Proxy :: Proxy (Check Int)) +-- "key" =: pInt == query "key" (pCheck pInt) == query "key" (Proxy :: Proxy (Check Int)) -- @ (?:) :: (Query a, Monad m) => S.ByteString -> Proxy a -> ApiaryT as m b -> ApiaryT as m b -k ?: t = query k (asCheck t) - where - asCheck :: Proxy a -> Proxy (Check a) - asCheck _ = Proxy +k ?: t = query k (pCheck t) -- | get many paramerer. since 0.5.0.0. -- -- @ --- "key" =: pInt == query "key" (Proxy :: Proxy (Many Int)) +-- "key" =: pInt == query "key" (pMany pInt) == query "key" (Proxy :: Proxy (Many Int)) -- @ (=*:) :: (Query a, Monad m) => S.ByteString -> Proxy a -> ApiaryT (Snoc as [a]) m b -> ApiaryT as m b -k =*: t = query k (asMany t) - where - asMany :: Proxy a -> Proxy (Many a) - asMany _ = Proxy +k =*: t = query k (pMany t) -- | get some paramerer. since 0.5.0.0. -- -- @ --- "key" =: pInt == query "key" (Proxy :: Proxy (Some Int)) +-- "key" =: pInt == query "key" (pSome pInt) == query "key" (Proxy :: Proxy (Some Int)) -- @ (=+:) :: (Query a, Monad m) => S.ByteString -> Proxy a -> ApiaryT (Snoc as [a]) m b -> ApiaryT as m b -k =+: t = query k (asSome t) - where - asSome :: Proxy a -> Proxy (Some a) - asSome _ = Proxy +k =+: t = query k (pSome t) -- | query exists checker. -- diff --git a/src/Control/Monad/Apiary/Filter/Internal/Capture.hs b/src/Control/Monad/Apiary/Filter/Internal/Capture.hs --- a/src/Control/Monad/Apiary/Filter/Internal/Capture.hs +++ b/src/Control/Monad/Apiary/Filter/Internal/Capture.hs @@ -55,7 +55,7 @@ -- -- @ -- myCapture :: 'SList' '['Equal', 'Fetch' Int, Fetch String] --- myCapture = 'Equal' "path" ':::' 'pInt' ::: 'pString' ::: 'SNil' +-- myCapture = 'Equal' \"path\" ':::' 'pInt' ::: 'pString' ::: 'SNil' -- -- capture myCapture . stdMethod GET . action $ \age name -> do -- yourAction diff --git a/src/Control/Monad/Apiary/Filter/Internal/Query.hs b/src/Control/Monad/Apiary/Filter/Internal/Query.hs --- a/src/Control/Monad/Apiary/Filter/Internal/Query.hs +++ b/src/Control/Monad/Apiary/Filter/Internal/Query.hs @@ -123,3 +123,27 @@ else case catMaybes rs of [] -> Nothing _ -> Just l + +-- | construct Option proxy. since 0.5.1.0. +pOption :: Proxy a -> Proxy (Option a) +pOption _ = Proxy + +-- | construct First proxy. since 0.5.1.0. +pFirst :: Proxy a -> Proxy (First a) +pFirst _ = Proxy + +-- | construct One proxy. since 0.5.1.0. +pOne :: Proxy a -> Proxy (One a) +pOne _ = Proxy + +-- | construct Many proxy. since 0.5.1.0. +pMany :: Proxy a -> Proxy (Many a) +pMany _ = Proxy + +-- | construct Some proxy. since 0.5.1.0. +pSome :: Proxy a -> Proxy (Some a) +pSome _ = Proxy + +-- | construct Check proxy. since 0.5.1.0. +pCheck :: Proxy a -> Proxy (Check a) +pCheck _ = Proxy diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -7,26 +7,22 @@ import Web.Apiary import Network.Wai import Network.Wai.Test - -import qualified Data.ByteString.Lazy as L - -getRoot :: Request -getRoot = defaultRequest - -postRoot :: Request -postRoot = defaultRequest { requestMethod = "POST" } - -deleteRoot :: Request -deleteRoot = defaultRequest { requestMethod = "DELETE" } - -putRoot :: Request -putRoot = defaultRequest { requestMethod = "PUT" } +import qualified Network.HTTP.Types as HTTP -getIndexHtml :: Request -getIndexHtml = setPath defaultRequest "/index.html" +import qualified Data.ByteString.Lazy.Char8 as L +import qualified Data.ByteString.Char8 as S -getNeko :: Request -getNeko = setPath defaultRequest "/neko" +testReq :: String -> (Request -> IO ()) -> Test +testReq str f = + let (meth, other) = break (== ' ') str + (path, version) = break (== ' ') (tail other) + in testCase str $ f (setPath (setVersion version $ (defaultRequest { requestMethod = S.pack meth })) (S.pack path)) + where + setVersion [] r = r + setVersion v r | v == " HTTP/1.1" = r { Network.Wai.httpVersion = HTTP.http11 } + | v == " HTTP/1.0" = r { Network.Wai.httpVersion = HTTP.http10 } + | v == " HTTP/0.9" = r { Network.Wai.httpVersion = HTTP.http09 } + | otherwise = error "unknown HTTP version" -------------------------------------------------------------------------------- @@ -60,9 +56,9 @@ helloWorldAllTest :: Test helloWorldAllTest = testGroup "helloWorld" - [ testCase "GET /" $ assertPlain200 "hello" helloWorldApp getRoot - , testCase "GET /neko" $ assertPlain200 "hello" helloWorldApp getNeko - , testCase "POST /" $ assertPlain200 "hello" helloWorldApp postRoot + [ testReq "GET /" $ assertPlain200 "hello" helloWorldApp + , testReq "GET /foo" $ assertPlain200 "hello" helloWorldApp + , testReq "POST /" $ assertPlain200 "hello" helloWorldApp ] -------------------------------------------------------------------------------- @@ -74,13 +70,29 @@ methodFilterTest :: Test methodFilterTest = testGroup "methodFilter" - [ testCase "GET /" $ assertPlain200 "GET" methodFilterApp getRoot - , testCase "POST /" $ assertPlain200 "POST" methodFilterApp postRoot - , testCase "GET /neko" $ assertPlain200 "GET" methodFilterApp getNeko - , testCase "DELETE /" $ assert404 methodFilterApp deleteRoot + [ testReq "GET /" $ assertPlain200 "GET" methodFilterApp + , testReq "POST /" $ assertPlain200 "POST" methodFilterApp + , testReq "GET /foo" $ assertPlain200 "GET" methodFilterApp + , testReq "DELETE /" $ assert404 methodFilterApp ] -------------------------------------------------------------------------------- + +httpVersionApp :: Application +httpVersionApp = runApiary def $ do + http09 . action $ contentType "text/plain" >> lbs "09" + http10 . action $ contentType "text/plain" >> lbs "10" + http11 . action $ contentType "text/plain" >> lbs "11" + +httpVersionTest :: Test +httpVersionTest = testGroup "httpVersionFilter" + [ testReq "GET / HTTP/0.9" $ assertPlain200 "09" httpVersionApp + , testReq "GET / HTTP/1.0" $ assertPlain200 "10" httpVersionApp + , testReq "GET / HTTP/1.1" $ assertPlain200 "11" httpVersionApp + ] + +-------------------------------------------------------------------------------- + rootFilterApp :: Application rootFilterApp = runApiary def . root . action $ do contentType "text/html" @@ -88,14 +100,131 @@ rootFilterTest :: Test rootFilterTest = testGroup "rootFilter" - [ testCase "GET /" $ assertHtml200 "root" rootFilterApp getRoot - , testCase "POST /" $ assertHtml200 "root" rootFilterApp postRoot - , testCase "GET /neko" $ assert404 rootFilterApp getNeko - , testCase "GET /index.html" $ assertHtml200 "root" rootFilterApp getIndexHtml + [ testReq "GET /" $ assertHtml200 "root" rootFilterApp + , testReq "POST /" $ assertHtml200 "root" rootFilterApp + , testReq "GET /neko" $ assert404 rootFilterApp + , testReq "GET /index.html" $ assertHtml200 "root" rootFilterApp ] -------------------------------------------------------------------------------- +captureApp :: Application +captureApp = runApiary def $ do + [capture|/foo|] . action $ contentType "text/plain" >> lbs "foo" + [capture|/:Int|] . stdMethod GET . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["Int", L.pack $ show i]) + [capture|/:Double|] . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["Double", L.pack $ show i]) + [capture|/bar/:L.ByteString/:Int|] . action $ \s i -> contentType "text/plain" >> lbs (L.unwords [s, L.pack $ show i]) + [capture|/:L.ByteString|] . action $ \s -> contentType "text/plain" >> lbs (L.unwords ["fall", s]) + +captureTest :: Test +captureTest = testGroup "capture" + [ testReq "GET /foo" $ assertPlain200 "foo" captureApp + , testReq "GET /12" $ assertPlain200 "Int 12" captureApp + , testReq "GET /12.4" $ assertPlain200 "Double 12.4" captureApp + , testReq "POST /12" $ assertPlain200 "Double 12.0" captureApp + , testReq "GET /bar" $ assertPlain200 "fall bar" captureApp + , testReq "GET /baz" $ assertPlain200 "fall baz" captureApp + , testReq "GET /bar/nyan/12" $ assertPlain200 "nyan 12" captureApp + ] + +-------------------------------------------------------------------------------- + +queryApp f g h = runApiary def $ do + _ <- (f "foo" pInt) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "Int", L.pack $ show i]) + _ <- (g "foo" pString) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "String", L.pack $ show i]) + (h "foo" (pMaybe pString)) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "Maybe String", L.pack $ show i]) + +queryCheckApp :: Application +queryCheckApp = runApiary def $ do + ("foo" ?: pInt) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "Int"]) + ("foo" ?: pString) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "String"]) + ("foo" ?: pMaybe pString) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "Maybe String"]) + +queryFirstTest :: Test +queryFirstTest = testGroup "First" + [ testReq "GET /" $ assert404 app + , testReq "GET /?foo" $ assertPlain200 "foo Maybe String Nothing" app + , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String Nothing" app + , testReq "GET /?foo=12" $ assertPlain200 "foo Int 12" app + , testReq "GET /?foo=a" $ assertPlain200 "foo String \"a\"" app + , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int 12" app + , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String \"12\"" app + ] + where app = queryApp (=:) (=:) (=:) + +queryOneTest :: Test +queryOneTest = testGroup "First" + [ testReq "GET /" $ assert404 app + , testReq "GET /?foo" $ assertPlain200 "foo Maybe String Nothing" app + , testReq "GET /?foo&foo=3" $ assert404 app + , testReq "GET /?foo=12" $ assertPlain200 "foo Int 12" app + , testReq "GET /?foo=a" $ assertPlain200 "foo String \"a\"" app + , testReq "GET /?foo=12&foo=23" $ assert404 app + , testReq "GET /?foo=12&foo=b" $ assert404 app + ] + where app = queryApp (=!:) (=!:) (=!:) + +queryOptionTest :: Test +queryOptionTest = testGroup "First" + [ testReq "GET /" $ assertPlain200 "foo Int Nothing" app + , testReq "GET /?foo" $ assertPlain200 "foo Maybe String Just Nothing" app + , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String Just Nothing" app + , testReq "GET /?foo=12" $ assertPlain200 "foo Int Just 12" app + , testReq "GET /?foo=a" $ assertPlain200 "foo String Just \"a\"" app + , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int Just 12" app + , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String Just \"12\"" app + ] + where app = queryApp (=?:) (=?:) (=?:) + +queryCheckTest :: Test +queryCheckTest = testGroup "First" + [ testReq "GET /" $ assert404 app + , testReq "GET /?foo" $ assertPlain200 "foo Maybe String" app + , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String" app + , testReq "GET /?foo=12" $ assertPlain200 "foo Int" app + , testReq "GET /?foo=a" $ assertPlain200 "foo String" app + , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int" app + , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String" app + ] + where app = queryCheckApp + +queryManyTest :: Test +queryManyTest = testGroup "First" + [ testReq "GET /" $ assertPlain200 "foo Int []" app + , testReq "GET /?foo" $ assertPlain200 "foo Maybe String [Nothing]" app + , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String [Nothing,Just \"3\"]" app + , testReq "GET /?foo=12" $ assertPlain200 "foo Int [12]" app + , testReq "GET /?foo=a" $ assertPlain200 "foo String [\"a\"]" app + , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int [12,23]" app + , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String [\"12\",\"b\"]" app + ] + where app = queryApp (=*:) (=*:) (=*:) + +querySomeTest :: Test +querySomeTest = testGroup "First" + [ testReq "GET /" $ assert404 app + , testReq "GET /?foo" $ assertPlain200 "foo Maybe String [Nothing]" app + , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String [Nothing,Just \"3\"]" app + , testReq "GET /?foo=12" $ assertPlain200 "foo Int [12]" app + , testReq "GET /?foo=a" $ assertPlain200 "foo String [\"a\"]" app + , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int [12,23]" app + , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String [\"12\",\"b\"]" app + ] + where app = queryApp (=+:) (=+:) (=+:) + + +queryTest :: Test +queryTest = testGroup "query" + [ queryFirstTest + , queryOneTest + , queryOptionTest + , queryCheckTest + , queryManyTest + , querySomeTest + ] + +-------------------------------------------------------------------------------- + multipleFilter1App :: Application multipleFilter1App = runApiary def $ do root $ do @@ -106,23 +235,23 @@ multipleFilter1Test :: Test multipleFilter1Test = testGroup "multiple test1: root, method" - [ testCase "GET /index.html" $ assertPlain200 "GET /" multipleFilter1App getIndexHtml - , testCase "POST /" $ assertHtml200 "POST /" multipleFilter1App postRoot - , testCase "DELETE /" $ assertPlain200 "DELETE ANY" multipleFilter1App deleteRoot - , testCase "PUT /" $ assert404 multipleFilter1App putRoot + [ testReq "GET /index.html" $ assertPlain200 "GET /" multipleFilter1App + , testReq "POST /" $ assertHtml200 "POST /" multipleFilter1App + , testReq "DELETE /" $ assertPlain200 "DELETE ANY" multipleFilter1App + , testReq "PUT /" $ assert404 multipleFilter1App ] -------------------------------------------------------------------------------- --------------------------------------------------------------------------------- - - main :: IO () main = defaultMain [ helloWorldAllTest , methodFilterTest + , httpVersionTest , rootFilterTest + , captureTest + , queryTest , multipleFilter1Test ]