diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for thrift-http +## 0.3.0.0 + +* Add TLS client support (https://github.com/facebookincubator/hsthrift/pull/170) +* Allow middleware (https://github.com/facebookincubator/hsthrift/pull/167) + ## 0.2.0.0 * The folly dependency is now bundled in the Hackage package folly-clib, diff --git a/Thrift/Channel/HTTP.hs b/Thrift/Channel/HTTP.hs --- a/Thrift/Channel/HTTP.hs +++ b/Thrift/Channel/HTTP.hs @@ -17,6 +17,7 @@ import Data.Proxy import qualified Data.Text.Encoding as Text import Network.HTTP.Client hiding (Proxy) +import Network.HTTP.Client.TLS import Network.HTTP.Types import Thrift.Channel @@ -33,6 +34,7 @@ { httpHost :: ByteString , httpPort :: Int , httpProtocolId :: ProtocolId + , httpUseHttps :: Bool , httpResponseTimeout :: Maybe Int -- ^ microseconds } deriving Show @@ -42,7 +44,7 @@ -> (forall p . Protocol p => ThriftM p HTTPChannel t a) -> IO a withHTTPChannel config@HTTPConfig{..} action = do - manager <- newManager defaultManagerSettings { + manager <- newTlsManagerWith tlsManagerSettings { managerResponseTimeout = maybe responseTimeoutNone responseTimeoutMicro httpResponseTimeout } withProxy httpProtocolId $ \proxy -> @@ -61,7 +63,7 @@ -> (forall p . Protocol p => HTTPChannel t -> Proxy p -> IO a) -> IO a withHTTPChannelIO config@HTTPConfig{..} action = do - manager <- newManager defaultManagerSettings + manager <- newTlsManagerWith tlsManagerSettings withProxy httpProtocolId $ \proxy -> action (HTTPChannel config manager) proxy @@ -81,6 +83,7 @@ { host = httpHost httpConfig , port = httpPort httpConfig , method = "POST" + , secure = httpUseHttps httpConfig , requestHeaders = [ (hContentType, if | prot == binaryProtocolId -> diff --git a/Thrift/Server/HTTP.hs b/Thrift/Server/HTTP.hs --- a/Thrift/Server/HTTP.hs +++ b/Thrift/Server/HTTP.hs @@ -16,6 +16,7 @@ withBackgroundServer, withBackgroundServer', thriftApplication, + Middleware, ) where import Data.ByteString (ByteString) @@ -30,6 +31,12 @@ import Network.Socket (close) import Network.Wai.Handler.Warp import Network.Wai + ( Application + , Middleware + , requestHeaders + , responseLBS + , strictRequestBody + ) import Thrift.Processor hiding (Header) import qualified Thrift.Processor as Thrift @@ -50,6 +57,7 @@ , numWorkerThreads :: Maybe Int -- ^ Currently ignored, provided for compatibility with CppServer , warpSettings :: Settings + , middleware :: Middleware } -- | Default options for creating a Thrift-over-HTTP service. @@ -59,6 +67,7 @@ , numWorkerThreads = Nothing , warpSettings = setHost (fromString "!6") defaultSettings -- IPv6 only by default + , middleware = id } -- | A running HTTP server. @@ -97,7 +106,7 @@ ready <- newEmptyMVar let host = getHost warpSettings - application = thriftApplication handler postProcess + application = middleware (thriftApplication handler postProcess) settings = maybe id setPort desiredPort $ diff --git a/test/ServerTest.hs b/test/ServerTest.hs --- a/test/ServerTest.hs +++ b/test/ServerTest.hs @@ -5,6 +5,7 @@ This source code is licensed under the BSD-style license found in the LICENSE file in the root directory of this source tree. -} +{-# LANGUAGE TypeApplications #-} module ServerTest (main) where @@ -12,6 +13,10 @@ import Control.Monad import Control.Monad.Trans.Class import Data.Either +import Network.HTTP.Client (defaultRequest, httpLbs, responseBody, newManager, defaultManagerSettings) +import qualified Network.HTTP.Client as HTTP +import Network.HTTP.Types (ok200) +import qualified Network.Wai as Wai import Facebook.Init -- import Network (testServerHost) @@ -43,6 +48,7 @@ { httpHost = "localhost" --testServerHost , httpPort = port , httpProtocolId = protId + , httpUseHttps = False , httpResponseTimeout = Nothing } @@ -106,6 +112,30 @@ where val = "AAAAAAAAAA_DO_NOT_DELETE" +middlewareTest :: String -> ProtocolId -> Test +middlewareTest pname protId = + TestLabel (pname ++ " middlewareTest") $ TestCase $ do + withTestServer serverOptions $ \port -> do + let httpConfig = mkHTTPConfig port protId + withHTTPChannel @Echoer httpConfig $ do + -- normal functionality still works + res <- echo val + lift $ assertEqual "echo echoed" val res + + mgr <- lift $ newManager defaultManagerSettings + let req = mkRequest httpConfig + resp <- lift $ httpLbs req mgr + lift $ assertEqual "response" "bar" (responseBody resp) + + where + val = "AAAAAAAAAA_DO_NOT_DELETE" + mkRequest httpConfig = defaultRequest { HTTP.host = httpHost httpConfig, HTTP.port = httpPort httpConfig, HTTP.method = "GET", HTTP.path = "/foo" } + serverOptions = defaultOptions + { middleware = \app req respond -> case Wai.pathInfo req of + ["foo"] -> respond $ Wai.responseLBS ok200 [] "bar" + _ -> app req respond + } + portAlreadyBoundTest :: String -> ProtocolId -> Test portAlreadyBoundTest pname protId = TestLabel (pname ++ " portAlreadyBoundTest") $ TestCase $ do @@ -134,6 +164,7 @@ , multiTest , unimplementedTest , echoTest + , middlewareTest , portAlreadyBoundTest ] diff --git a/thrift-http.cabal b/thrift-http.cabal --- a/thrift-http.cabal +++ b/thrift-http.cabal @@ -3,7 +3,7 @@ -- Copyright (c) Facebook, Inc. and its affiliates. name: thrift-http -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Support for Thrift-over-HTTP server and client homepage: https://github.com/facebookincubator/hsthrift bug-reports: https://github.com/facebookincubator/hsthrift/issues @@ -81,12 +81,13 @@ async ^>=2.2.1, utf8-string >= 1.0.2 && < 1.1, containers >= 0.6 && < 0.7, - wai >= 3.2.4 && < 3.3, - warp >= 3.3.30 && < 3.5, + wai >= 3.2.3 && < 3.3, + warp >= 3.3.25 && < 3.5, streaming-commons >= 0.2.2 && < 0.3, - network >= 3.2.7 && < 3.3, - http-client >= 0.7.18 && < 0.8, - http-types >= 0.12.4 && < 0.13 + network >= 3.1.4 && < 3.3, + http-client >= 0.7.15 && < 0.8, + http-client-tls > 0.3 && < 0.4, + http-types >= 0.12.3 && < 0.13 default-language: Haskell2010 @@ -102,21 +103,21 @@ base >=4.11.1 && <4.20, aeson >= 2.0.3 && < 2.3, bytestring, - data-default >= 0.8.0 && < 0.9, + data-default >= 0.7.1 && < 0.9, deepseq >= 1.4.4 && < 1.6, fb-stubs >= 0.1.0 && < 0.2, fb-util, - hashable >= 1.4.4 && < 1.5, - hspec >= 2.11.10 && < 2.12, + hashable >= 1.4.3 && < 1.5, + hspec >= 2.10.10 && < 2.12, hspec-contrib >= 0.5.2 && < 0.6, ghc-prim >= 0.5.3 && < 0.12, HUnit ^>= 1.6.1, - STMonadTrans >= 0.4.8 && < 0.5, + STMonadTrans >= 0.4.7 && < 0.5, text, thrift-lib, thrift-lib:test-helpers, transformers >= 0.5.6 && < 0.7, - unordered-containers >= 0.2.20 && < 0.3 + unordered-containers >= 0.2.19 && < 0.3 if flag(tests_use_ipv4) -- for test/Network.hs @@ -142,7 +143,7 @@ common test-common import: test-deps hs-source-dirs: test - build-depends: thrift-http:test-lib, thrift-http + build-depends: thrift-http:test-lib, thrift-http, http-client, wai, http-types ghc-options: -threaded test-suite server