diff --git a/servant-py.cabal b/servant-py.cabal index cf04d87..2d68486 100644 --- a/servant-py.cabal +++ b/servant-py.cabal @@ -1,5 +1,5 @@ name: servant-py -version: 0.1.0.0 +version: 0.1.0.1 synopsis: Automatically derive python functions to query servant webservices. description: Automatically derive python functions to query servant webservices. @@ -65,10 +65,20 @@ executable servant-py-exe test-suite servant-py-test type: exitcode-stdio-1.0 hs-source-dirs: test + ghc-options: -Wall main-is: Spec.hs + other-modules: + Servant.PYSpec + Servant.Custom.PYHeaders build-depends: base , servant-py - ghc-options: -threaded -rtsopts -with-rtsopts=-N + , base-compat + , hspec + , hspec-expectations + , lens + , QuickCheck + , servant + , text default-language: Haskell2010 source-repository head diff --git a/src/Servant/PY/Internal.hs b/src/Servant/PY/Internal.hs index b73c995..f3e9b6e 100644 --- a/src/Servant/PY/Internal.hs +++ b/src/Servant/PY/Internal.hs @@ -174,23 +174,20 @@ filterBmpChars = Set.filter (< '\65536') -- This function creates a dict where the keys are string representations of variable -- names. This is due to the way arguments are passed into the function, and these -- arguments named params. In other words, [("key", "key")] becomes: {"key": key} -toPyDict :: [(Text, Text)] -> Text +toPyDict :: [Text] -> Text toPyDict dict | null dict = "{}" | otherwise = "{" <> insides <> "}" where insides = mconcat $ combiner <$> dict - combiner (a,b) = "\"" <> a <> "\": " <> b + combiner a = "\"" <> a <> "\": " <> a -- Query params are passed into the function that makes the request, so we make -- a python dict out of them. toPyParams :: [QueryArg f] -> Text toPyParams [] = "" -toPyParams qargs = toPyDict . tuplicious $ paramList +toPyParams qargs = toPyDict paramList where paramList = fmap (\qarg -> qarg ^. queryArgName.argName._PathSegment) qargs -tuplicious :: [Text] -> [(Text, Text)] -tuplicious = foldr (\x xs -> (x, x) : xs ) [] - toPyHeader :: HeaderArg f -> Text toPyHeader (HeaderArg n) = toValidFunctionName ("header" <> n ^. argName . _PathSegment) diff --git a/src/Servant/PY/Requests.hs b/src/Servant/PY/Requests.hs index 9fa9f9a..f24d984 100644 --- a/src/Servant/PY/Requests.hs +++ b/src/Servant/PY/Requests.hs @@ -20,16 +20,16 @@ import Servant.PY.Internal -- | Generate python functions that use the requests library. -- Uses 'defCommonGeneratorOptions' for the generator options. requests :: PythonGenerator -requests reqs = defPyImports <> mconcat (map requestsGeneratorWithDef reqs) +requests reqs = defPyImports <> mconcat (map requestsWithDef reqs) -- | Generate python functions that use the requests library. -- Lets you specify your own 'CommonGeneratorOptions'. requestsWith :: CommonGeneratorOptions -> PythonGenerator -requestsWith opts = mconcat . map (generatePyRequestWith opts) +requestsWith opts reqs = mconcat (map (generatePyRequestWith opts) reqs) -- | python codegen using requests with default options -requestsGeneratorWithDef :: PyRequest -> Text -requestsGeneratorWithDef = generatePyRequestWith defCommonGeneratorOptions +requestsWithDef :: PyRequest -> Text +requestsWithDef = generatePyRequestWith defCommonGeneratorOptions defPyImports :: Text defPyImports = diff --git a/test/Servant/Custom/PYHeaders.hs b/test/Servant/Custom/PYHeaders.hs new file mode 100644 index 0000000..ba98491 --- /dev/null +++ b/test/Servant/Custom/PYHeaders.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module Servant.Custom.PYHeaders where + +import Control.Lens +import Data.Monoid +import Data.Proxy +import Data.Text (pack) +import GHC.TypeLits +import Servant.API.ContentTypes +import Servant.PY.Internal + +-- | This is a hypothetical combinator that fetches an Authorization header. +-- The symbol in the header denotes what kind of authentication we are +-- using -- Basic, Digest, whatever. +data Authorization (sym :: Symbol) a + +instance (KnownSymbol sym, HasForeign lang NoContent api) + => HasForeign lang NoContent (Authorization sym a :> api) where + type Foreign NoContent (Authorization sym a :> api) = Foreign NoContent api + + foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $ + req & reqHeaders <>~ + [ ReplaceHeaderArg (Arg "Authorization" NoContent) + $ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ] + where + tokenType t = t <> " {Authorization}" + +-- | This is a combinator that fetches an X-ThreeMilePilot header. +data ThreeMilePilot a + +instance (HasForeign lang NoContent api) + => HasForeign lang NoContent (ThreeMilePilot a :> api) where + type Foreign NoContent (ThreeMilePilot a :> api) = Foreign NoContent api + + foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $ + req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-ThreeMilePilot" NoContent) tpl ] + where + tpl = "I am good friends with {X-ThreeMilePilot}" + +-- | This is a combinator that fetches an X-WhatsForDinner header. +data KlikatatIkatowi a + +instance (HasForeign lang NoContent api) + => HasForeign lang NoContent (KlikatatIkatowi a :> api) where + type Foreign NoContent (KlikatatIkatowi a :> api) = Foreign NoContent api + + foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $ + req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-KlikatatIkatowi" NoContent) tpl ] + where + tpl = "I would like to hear Swing Kids, Stick Figure Caraousel, {X-KlikatatIkatowi}." diff --git a/test/Servant/PYSpec.hs b/test/Servant/PYSpec.hs new file mode 100644 index 0000000..2516fdb --- /dev/null +++ b/test/Servant/PYSpec.hs @@ -0,0 +1,159 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Servant.PYSpec where + +import Data.Either (isRight) +import Data.Monoid () +import Data.Monoid.Compat ((<>)) +import Data.Proxy +import Data.Text (Text) +import qualified Data.Text as T +import Prelude () +import Prelude.Compat +import Test.Hspec hiding (shouldContain, shouldNotContain) +import Test.QuickCheck (Arbitrary (..), + choose, listOf, + property) + +import Servant.API.Internal.Test.ComprehensiveAPI +import Servant.API.ContentTypes +import Servant.PY +import Servant.PY.Internal +import qualified Servant.PY.Requests as R +import Servant.Custom.PYHeaders + + + +-- This declaration simply checks that all instances are in place. +_ = pyForAPI comprehensiveAPIWithoutRaw requests :: Text + +-- * specs + +type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] Text :> Post '[JSON] Bool + :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool + +type TopLevelRawAPI = "test" :> Get '[JSON] Int + :<|> Raw + +type HeaderHandlingAPI = "test" :> Header "Foo" Text + :> Get '[JSON] Int + +type CustomAuthAPI = "test" :> Authorization "Basic" Text + :> Get '[JSON] Int + +type CustomHeaderAPI = "test" :> ThreeMilePilot Text + :> Get '[JSON] Int + +type CustomHeaderAPI2 = "test" :> KlikatatIkatowi Text + :> Get '[JSON] Int + +headerHandlingProxy :: Proxy HeaderHandlingAPI +headerHandlingProxy = Proxy + +customAuthProxy :: Proxy CustomAuthAPI +customAuthProxy = Proxy + +customHeaderProxy :: Proxy CustomHeaderAPI +customHeaderProxy = Proxy + +customHeaderProxy2 :: Proxy CustomHeaderAPI2 +customHeaderProxy2 = Proxy + +data TestNames = Requests + | RequestsWith + deriving (Show, Eq) + +customOptions :: CommonGeneratorOptions +customOptions = defCommonGeneratorOptions + { urlPrefix = "urlForRequesting:9000" + , returnMode = DangerMode + } + +spec :: Spec +spec = describe "Servant.Requests" $ do + generatePYSpec Requests R.requestsWithDef + generatePYSpec RequestsWith (R.requestsWith customOptions) + internalSpec + +shouldContain :: Text -> Text -> Expectation +a `shouldContain` b = shouldSatisfy a (T.isInfixOf b) + +shouldNotContain :: Text -> Text -> Expectation +a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b) + +newtype ASCII = ASCII {getASCII :: T.Text} deriving (Show) + +instance Arbitrary ASCII where + -- Our arbitrary instance is generating only ASCII, since the language-ecmascript's lexer + -- is currently (October 2016) still a bit naïve + arbitrary = fmap (ASCII . T.pack) $ listOf $ choose (minBound, '\127') + shrink xs = (ASCII . T.pack) <$> shrink (T.unpack $ getASCII xs) + +internalSpec :: Spec +internalSpec = describe "Internal" $ do + it "should generate only valid javascript identifiers for any ASCII route" $ do + let parseIdentifier = fmap T.pack. parse identifier "" + property $ \x -> let valid = toValidFunctionName $ getASCII x in + Right valid == parseIdentifier valid + + it "should generate a valid javascript identifier when supplied with hyphens, unicode whitespace, non-bmp unicode" $ do + toValidFunctionName "a_--a\66352b\6158c\65075" `shouldBe` "a_abc\65075" + +generatePYSpec :: TestNames -> (PyRequest -> Text) -> Spec +generatePYSpec n gen = describe specLabel $ do + let parseFromText = parse program "" + it "should generate valid javascript" $ do + let s = pyForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen) + parseFromText s `shouldSatisfy` isRight + + it "should use non-empty function names" $ do + let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI) + output $ genJS (topLevel "GET") + parseFromText (genJS $ topLevel "GET") `shouldSatisfy` isRight + + it "should handle simple HTTP headers" $ do + let jsText = genJS $ javascript headerHandlingProxy + output jsText + parseFromText jsText `shouldSatisfy` isRight + jsText `shouldContain` "headerFoo" + jsText `shouldContain` (header n "Foo" $ "headerFoo") + + it "should handle complex HTTP headers" $ do + let jsText = genJS $ javascript customAuthProxy + output jsText + parseFromText jsText `shouldSatisfy` isRight + jsText `shouldContain` "headerAuthorization" + jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization") + + it "should handle complex, custom HTTP headers" $ do + let jsText = genJS $ javascript customHeaderProxy + output jsText + parseFromText jsText `shouldSatisfy` isRight + jsText `shouldContain` "headerXThreeMilePilot" + jsText `shouldContain` (header n "X-ThreeMilePilot" $ "\"I am good friends with \" + headerXThreeMilePilot") + + it "should handle complex, custom HTTP headers (template replacement)" $ do + let jsText = genJS $ javascript customHeaderProxy2 + output jsText + parseFromText jsText `shouldSatisfy` isRight + jsText `shouldContain` "headerXKlikatatIkatowi" + jsText `shouldContain` (header n "X-KlikatatIkatowi" $ "\"I would like to hear Swing Kids, Stick Figure Caraousel, \" + headerXKlikatatIkatowi + \" .\"") + + it "can generate the whole javascript code string at once with pyForAPI" $ do + let jsStr = pyForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen) + parseFromText jsStr `shouldSatisfy` isRight + where + specLabel = "generateJS(" <> (show n) <> ")" + output _ = return () + genJS req = gen req + header :: TestNames -> Text -> Text -> Text + header v headerName headerValue + | v `elem` [Requests, RequestsWith] = "xhr.setRequestHeader(\"" <> headerName <> "\", " <> headerValue <> ");\n" + | otherwise = "headers: { \"" <> headerName <> "\": " <> headerValue <> " }\n" diff --git a/test/Spec.hs b/test/Spec.hs index cd4753f..a824f8c 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,2 +1 @@ -main :: IO () -main = putStrLn "Test suite not yet implemented" +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}