Client tests now pass with GADT-based auth
This commit is contained in:
aaron levin
parent
cef2e87aa6
commit
a8bb095b6f
1 changed files with 68 additions and 105 deletions
|
|
@ -31,13 +31,12 @@ import Control.Exception (bracket)
|
|||
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
|
||||
import Data.Aeson
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Char (chr, isPrint)
|
||||
import Data.Foldable (forM_)
|
||||
import Data.Monoid hiding (getLast)
|
||||
import Data.Proxy
|
||||
import qualified Data.Text as T
|
||||
import GHC.Generics (Generic)
|
||||
import GHC.TypeLits
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import GHC.Generics
|
||||
import qualified Network.HTTP.Client as C
|
||||
import Network.HTTP.Media
|
||||
|
|
@ -57,11 +56,10 @@ import Servant.API.Authentication
|
|||
import Servant.Client
|
||||
import Servant.Client.Authentication()
|
||||
import Servant.Server
|
||||
import Servant.Server.Internal.Authentication
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Servant.Client" $ do
|
||||
sucessSpec
|
||||
successSpec
|
||||
failSpec
|
||||
wrappedApiSpec
|
||||
|
||||
|
|
@ -112,8 +110,8 @@ type Api =
|
|||
ReqBody '[JSON] [(String, [Rational])] :>
|
||||
Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])
|
||||
:<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)
|
||||
:<|> AuthProtect (BasicAuth "realm") Person 'Strict () 'Strict () :> Get '[JSON] Person
|
||||
:<|> "deleteContentType" :> Delete '[JSON] ()
|
||||
:<|> AuthProtect (BasicAuth "realm") Person 'Strict :> Get '[JSON] Person
|
||||
|
||||
-- base64-encoded "servant:server"
|
||||
base64ServantColonServer :: ByteString
|
||||
|
|
@ -145,8 +143,8 @@ server = serve api (
|
|||
:<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
|
||||
:<|> (\ a b c d -> return (a, b, c, d))
|
||||
:<|> (return $ addHeader 1729 $ addHeader "eg2" True)
|
||||
:<|> return ()
|
||||
:<|> basicAuthStrict basicAuthCheck (const . return $ alice)
|
||||
:<|> return ()
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -168,48 +166,12 @@ failServer = serve failApi (
|
|||
manager :: C.Manager
|
||||
manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
|
||||
|
||||
sucessSpec :: Spec
|
||||
sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
||||
successSpec :: Spec
|
||||
successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
||||
|
||||
|
||||
it "Servant.API.Get" $ \(_, baseUrl) -> do
|
||||
let getGet = getNth (Proxy :: Proxy 0) $ client api baseUrl manager
|
||||
|
||||
manager <- C.newManager C.defaultManagerSettings
|
||||
let getGet :: ExceptT ServantError IO Person
|
||||
getDeleteEmpty :: ExceptT ServantError IO ()
|
||||
getCapture :: String -> ExceptT ServantError IO Person
|
||||
getBody :: Person -> ExceptT ServantError IO Person
|
||||
getQueryParam :: Maybe String -> ExceptT ServantError IO Person
|
||||
getQueryParams :: [String] -> ExceptT ServantError IO [Person]
|
||||
getQueryFlag :: Bool -> ExceptT ServantError IO Bool
|
||||
getMatrixParam :: Maybe String -> ExceptT ServantError IO Person
|
||||
getMatrixParams :: [String] -> ExceptT ServantError IO [Person]
|
||||
getMatrixFlag :: Bool -> ExceptT ServantError IO Bool
|
||||
getRawSuccess :: Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
|
||||
getRawFailure :: Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
|
||||
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> ExceptT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
|
||||
getRespHeaders :: ExceptT ServantError IO (Headers TestHeaders Bool)
|
||||
getDeleteContentType :: ExceptT ServantError IO ()
|
||||
( getGet
|
||||
:<|> getDeleteEmpty
|
||||
:<|> getCapture
|
||||
:<|> getBody
|
||||
:<|> getQueryParam
|
||||
:<|> getQueryParams
|
||||
:<|> getQueryFlag
|
||||
:<|> getMatrixParam
|
||||
:<|> getMatrixParams
|
||||
:<|> getMatrixFlag
|
||||
:<|> getRawSuccess
|
||||
:<|> getRawFailure
|
||||
:<|> getMultiple
|
||||
:<|> getRespHeaders
|
||||
:<|> getDeleteContentType
|
||||
:<|> getPrivatePerson)
|
||||
= client api baseUrl manager
|
||||
|
||||
hspec $ do
|
||||
it "Servant.API.Get" $ do
|
||||
(left show <$> runExceptT getGet) `shouldReturn` Right alice
|
||||
|
||||
describe "Servant.API.Delete" $ do
|
||||
|
|
@ -273,14 +235,16 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
|||
Left e -> assertFailure $ show e
|
||||
Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
|
||||
|
||||
it "handles Authentication appropriately" $ withServer $ \ _ -> do
|
||||
(Control.Arrow.left show <$> runExceptT (getPrivatePerson (BasicAuth "servant" "server"))) `shouldReturn` Right alice
|
||||
it "handles Authentication appropriately" $ \(_, baseUrl) -> do
|
||||
let getPrivatePerson = getNth (Proxy :: Proxy 11) $ client api baseUrl manager
|
||||
(left show <$> runExceptT (getPrivatePerson (BasicAuth "servant" "server"))) `shouldReturn` Right alice
|
||||
|
||||
it "returns 401 when not properly authenticated" $ do
|
||||
it "return 401 when not properly authenticated" $ \(_, baseUrl) -> do
|
||||
let getPrivatePerson = getNth (Proxy :: Proxy 11) $ client api baseUrl manager
|
||||
Left res <- runExceptT (getPrivatePerson (BasicAuth "xxx" "yyy"))
|
||||
case res of
|
||||
FailureResponse (Status 401 _) _ _ -> return ()
|
||||
_ -> fail $ "expected 401 response, but got " <> show res
|
||||
_ -> fail $ "expected 401 response, but go " <> show res
|
||||
|
||||
modifyMaxSuccess (const 20) $ do
|
||||
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
|
||||
|
|
@ -288,8 +252,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
|||
in property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
|
||||
ioProperty $ do
|
||||
result <- left show <$> runExceptT (getMultiple cap num flag body)
|
||||
return $
|
||||
result === Right (cap, num, flag, body)
|
||||
return $ result === Right (cap, num, flag, body)
|
||||
|
||||
wrappedApiSpec :: Spec
|
||||
wrappedApiSpec = describe "error status codes" $ do
|
||||
|
|
|
|||
Loading…
Reference in a new issue