packages feed

reqcatcher (empty) → 0.1.0.0

raw patch · 5 files changed

+247/−0 lines, 5 filesdep +HUnitdep +basedep +http-clientsetup-changed

Dependencies added: HUnit, base, http-client, http-types, lens, network, reqcatcher, tasty, tasty-hunit, text, wai, warp, wreq

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ reqcatcher.cabal view
@@ -0,0 +1,47 @@+name:                reqcatcher+version:             0.1.0.0+synopsis:            A local http server to catch the HTTP redirect+description:         Manage an http server in your local PC to catch the HTTP+                     redirect request from the browser. Especially, you can+                     catch the redirect from oauth providor and will get+                     oauth_verifier.+homepage:            http://github.com/hiratara/hs-reqcatcher+license:             BSD3+license-file:        LICENSE+author:              Masahiro Honma+maintainer:          hiratara@cpan.org+category:            Web+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Web.ReqCatcher+  build-depends:       base >= 4.7 && < 4.9+                     , http-types >= 0.8 && < 1.0+                     , network >= 2.6 && < 2.7+                     , text >= 1.2 && < 1.3+                     , wai >= 3.0 && < 3.3+                     , warp >= 3.0 && < 3.3+  default-language:    Haskell2010++test-suite reqcatcher-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             reqcatcher-test.hs+  build-depends:       base+                     , http-client >= 0.4 && < 0.5+                     , http-types+                     , HUnit >= 1.2 && < 1.4+                     , lens >= 4.7 && < 4.14+                     , reqcatcher+                     , tasty >= 0.10 && < 0.12+                     , tasty-hunit >= 0.9 && < 1.0+                     , wai+                     , wreq >= 0.3 && < 0.5+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/hiratara/hs-reqcatcher
+ src/Web/ReqCatcher.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Web.ReqCatcher+Description : A tiny tool to catch HTTP redirects from the browser+Copyright   : (c) 2016- hiratara+License     : BSD-style+Maintainer  : hiratara@cpan.org+Stability   : experimental++Web.ReqCatcher starts a local HTTP server which handles just one request and+returns that request to the client program. It is useful for CLI program to+capture HTTP redirects from outer WEB services by using browser.++@+  import Web.Authenticate.OAuth++  oauth :: OAuth+  manager :: Manager++  main :: IO ()+  main = do+    c <- newCatcher+    let url = pack (catcherUrl c)+        oauth' = oauth {oauthCallback = Just url}++    credential <- getTemporaryCredential oauth' manager+    putStrLn $ "Access to:\\n" ++ (authorizeUrl oauth credential)+    req <- catchRedirect c++    let (Just (Just verifier)) = lookup "oauth_verifier" (queryString req)+    ...+@+-}+module Web.ReqCatcher+       ( Catcher (catcherUrl)+       , newCatcher+       , newCatcherWithPort+       , catchRedirect+       ) where+import qualified Control.Concurrent as CONC+import qualified Control.Exception as EX+import qualified Network.HTTP.Types as HTTP+import qualified Network.Socket as NW+import qualified Network.Wai as WAI+import qualified Network.Wai.Handler.Warp as WARP+import qualified Data.Text.Lazy as LTXT+import qualified Data.Text.Lazy.Encoding as LTXT++-- | Catcher holds the HTTP server instance and wait for a request.+data Catcher = Catcher+  { catcherUrl :: String -- ^ Target URL of this Catcher+  , catcherWarpThread :: CONC.ThreadId+  , catcherSocket :: NW.Socket+  , catcherCought :: CONC.MVar WAI.Request+  }++-- | Creates the new Catcher instance.+newCatcher :: IO Catcher+newCatcher = newCatcherWithPort =<< pickPort++-- | Creates the new Catcher instance with the specific port.+newCatcherWithPort :: WARP.Port -> IO Catcher+newCatcherWithPort port = do+  mvar <- CONC.newEmptyMVar+  mvarSocket <- CONC.newEmptyMVar++  let set = WARP.setOnException (\_ _ -> return ())+          . WARP.setPort port+          $ WARP.defaultSettings+  tid <- CONC.forkIO (httpWorker mvarSocket set (newCatchApp mvar))+  socket <- CONC.takeMVar mvarSocket++  return $ Catcher (buildURL port) tid socket mvar++httpWorker :: CONC.MVar NW.Socket -> WARP.Settings -> WAI.Application -> IO ()+httpWorker mvar set app =+  EX.bracket+    (NW.socket NW.AF_INET NW.Stream NW.defaultProtocol)+    NW.sClose+    (\socket -> do+        -- TODO: set Close-On-Exec to socket+        NW.setSocketOption socket NW.ReuseAddr 1+        let addr = NW.SockAddrInet (toEnum $ WARP.getPort set) 0+        NW.bindSocket socket addr+        NW.listen socket 1 -- Handle Just 1 connection+        CONC.putMVar mvar socket+        WARP.runSettingsSocket set socket app+        return ())++-- | Returns the HTTP request cought by Catcher.+--   This function blocks until Catcher catches some requests.+catchRedirect :: Catcher -> IO WAI.Request+catchRedirect catcher = do+  req <- CONC.takeMVar (catcherCought catcher)+  NW.sClose (catcherSocket catcher)+  return req++pickPort :: IO WARP.Port+pickPort =+  EX.bracket+    (NW.socket NW.AF_INET NW.Stream NW.defaultProtocol)+    NW.sClose+    (\sock -> do+        NW.setSocketOption sock NW.ReuseAddr 1+        NW.bindSocket sock (NW.SockAddrInet 0 0)+        port <- NW.socketPort sock+        NW.sClose sock+        return (fromEnum port))++buildURL :: WARP.Port -> String+buildURL port = "http://localhost:" ++ show port++newCatchApp :: CONC.MVar WAI.Request -> WAI.Application+newCatchApp mvar req respond = do+  CONC.putMVar mvar req+  respond $ WAI.responseLBS+    HTTP.status200+    [("Content-Type", "text/plain")]+    (LTXT.encodeUtf8 $ LTXT.pack $ show req)
+ test/reqcatcher-test.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}+import qualified Control.Exception as EX+import Control.Lens ((.~), (&), (^.))+import qualified Data.List as LS+import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Types.Status as HTTP+import qualified Network.Wai as WAI+import qualified Network.Wreq as WR+import Test.HUnit (assertFailure)+import Test.Tasty (defaultMain, TestTree, testGroup)+import Test.Tasty.HUnit (testCaseSteps, (@?), (@=?))++import qualified Web.ReqCatcher as RC++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [unitTests]++unitTests :: TestTree+unitTests = testGroup "Unit Tests" [testReqCatcher]++testReqCatcher :: TestTree+testReqCatcher = testCaseSteps "General usage of ReqCatcher" $ \step -> do+  step "new instance"+  catcher <- RC.newCatcher++  step "check URL"+  let url = RC.catcherUrl catcher+  "http" `LS.isPrefixOf` url @? "Invalid URL: " ++ url++  step "Throw an http request to URL"+  let opts = WR.defaults & WR.param "foo" .~ ["bar"]+  r <- WR.getWith opts url+  (r ^. WR.responseStatus) @=? HTTP.ok200++  step "Catch the request"+  r' <- RC.catchRedirect catcher+  let Just (Just bar) = lookup "foo" (WAI.queryString r')+  bar @=? "bar"++  step "Shutdown the server"+  EX.handle+    (\e -> let e' = e :: HTTP.HttpException in return ()) $+    do r <- WR.getWith opts url+       assertFailure ("The http server is alive: " ++ show r)++  return ()