packages feed

bloodhound-amazonka-auth (empty) → 0.1.0.0

raw patch · 8 files changed

+262/−0 lines, 8 filesdep +amazonka-coredep +amazonka-elasticsearchdep +basesetup-changed

Dependencies added: amazonka-core, amazonka-elasticsearch, base, bloodhound, bloodhound-amazonka-auth, exceptions, http-client, http-types, tasty, tasty-hunit, time, transformers, uri-bytestring

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Michael Xavier (c) 2015++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 Michael Xavier 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.
+ README.md view
@@ -0,0 +1,17 @@+# bloodhound-amazonka-auth+[![Build Status](https://travis-ci.org/MichaelXavier/bloodhound-amazonka-auth.svg?branch=master)](https://travis-ci.org/MichaelXavier/bloodhound-amazonka-auth)++Adds convenient Amazon ElasticSearch Service authentication to+Bloodhound.+++# Usage++```haskell+env <- newEnv region Discover+let auth = env ^. envAuth+let hook req = withAuth auth $ ae ->+                 either (liftIO . throwIO) return =<< amazonkaAuthHook ae region req+mgr <- newManager tlsManagerSettings+let bhe = (mkBHEnv server mgr) { bhRequestHook = hook }+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bloodhound-amazonka-auth.cabal view
@@ -0,0 +1,64 @@+name:                bloodhound-amazonka-auth+version:             0.1.0.0+synopsis:            Adds convenient Amazon ElasticSearch Service authentication to Bloodhound.+description:         Please see README.md+homepage:            http://github.com/MichaelXavier/bloodhound-amazonka-auth#readme+license:             BSD3+license-file:        LICENSE+author:              Michael Xavier+maintainer:          michael@michaelxavier.net+copyright:           2015 Michael Xavier+category:            Web+build-type:          Simple+extra-source-files:  README.md+                   , changelog.md+cabal-version:       >=1.10++flag lib-Werror+  default: False+  manual: True++library+  hs-source-dirs:      src+  exposed-modules:     Database.Bloodhound.Auth.Amazonka+                       Database.Bloodhound.Auth.Amazonka.Internal+  build-depends:       base >= 4.7 && < 5+                     , bloodhound >= 0.11+                     , http-client+                     , time+                     , amazonka-core >= 1.3.0 && < 1.4+                     , amazonka-elasticsearch >= 1.3.6 && < 1.4+                     , transformers+                     , http-types+                     , exceptions+                     , uri-bytestring+  default-language:    Haskell2010++  if flag(lib-Werror)+    ghc-options: -Werror++  ghc-options: -Wall++test-suite test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:     test+  default-language:   Haskell2010++  build-depends:    base+                  , bloodhound-amazonka-auth+                  , tasty+                  , tasty-hunit+                  , amazonka-core+                  , http-client+                  , time++  if flag(lib-Werror)+    ghc-options: -Werror++  ghc-options: -Wall+++source-repository head+  type:     git+  location: https://github.com/MichaelXavier/bloodhound-amazonka-auth
+ changelog.md view
+ src/Database/Bloodhound/Auth/Amazonka.hs view
@@ -0,0 +1,9 @@+module Database.Bloodhound.Auth.Amazonka+    ( amazonkaAuthHook+    , EsAmazonkaAuthError(..)+    ) where+++-------------------------------------------------------------------------------+import           Database.Bloodhound.Auth.Amazonka.Internal+-------------------------------------------------------------------------------
+ src/Database/Bloodhound/Auth/Amazonka/Internal.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Database.Bloodhound.Auth.Amazonka.Internal where+++-------------------------------------------------------------------------------+import           Control.Exception+import           Data.Bifunctor+import           Data.Time.Clock+import           Data.Typeable+import           Database.Bloodhound.Types+import           Network.AWS.Data.Body+import           Network.AWS.Data.ByteString+import           Network.AWS.Data.Path+import           Network.AWS.Data.Query+import qualified Network.AWS.Data.Query      as A+import           Network.AWS.ElasticSearch   (elasticSearch)+import           Network.AWS.Types           (AuthEnv, Region, sgRequest,+                                              sgSign)+import qualified Network.AWS.Types           as A+import           Network.HTTP.Client+import           Network.HTTP.Types.Method   (parseMethod)+import           URI.ByteString+-------------------------------------------------------------------------------+++-- | Request hook to install into your 'BHEnv'. Does not handle+-- streaming request bodies, which should not be an issue for+-- Bloodhound. The exception cases handled by 'EsAmazonkaAuthError'+-- are truly exceptional and should probably be thrown.+--+-- @+--    env <- newEnv region Discover+--    let auth = env ^. envAuth+--    let hook req = withAuth auth $ \ae ->+--                     either (liftIO . throwIO) return =<< amazonkaAuthHook ae region req+--    mgr <- newManager tlsManagerSettings+--    let bhe = (mkBHEnv server mgr) { bhRequestHook = hook }+-- @+amazonkaAuthHook :: AuthEnv -> Region -> Request -> IO (Either EsAmazonkaAuthError Request)+amazonkaAuthHook ae reg req = amazonkaAuthHook' ae reg req <$> getCurrentTime+++-------------------------------------------------------------------------------+amazonkaAuthHook' :: AuthEnv -> Region -> Request -> UTCTime -> Either EsAmazonkaAuthError Request+amazonkaAuthHook' ae reg req now = toReq <$> toAwsRequest req reg+  where algo = sgSign (A._svcSigner elasticSearch)+        toReq req' = sgRequest (algo req' ae reg now)+++-------------------------------------------------------------------------------+toAwsRequest :: Request -> Region -> Either EsAmazonkaAuthError (A.Request a)+toAwsRequest r reg = do+  meth <- first (const badMethod) (parseMethod bsMeth)+  rqb <- toRQBody (requestBody r)+  q <- toQS (queryString r)+  return (A.Request { A._rqService = svc+                    , A._rqMethod = meth+                    , A._rqPath = rawPath (path r)+                    , A._rqQuery = q+                    , A._rqHeaders = requestHeaders r+                    , A._rqBody = rqb})+  where bsMeth = method r+        badMethod = InvalidStdMethod bsMeth+        svc = elasticSearch { A._svcEndpoint = const endpoint}+        endpoint = requestEndpoint r reg+++-------------------------------------------------------------------------------+toQS :: ByteString -> Either EsAmazonkaAuthError A.QueryString+toQS bs = case parseRelativeRef laxURIParserOptions bs of+            Right rr -> Right (go (rrQuery rr))+            Left _ -> Left MalformedQueryString+  where go q = QList [ QPair k (QValue (Just v)) | (k, v) <- queryPairs q]++-------------------------------------------------------------------------------+requestEndpoint :: Request -> Region -> A.Endpoint+requestEndpoint r reg = A.Endpoint { A._endpointHost = host r+                                   , A._endpointSecure = secure r+                                   , A._endpointPort = port r+                                   , A._endpointScope = toBS reg}++-------------------------------------------------------------------------------+-- | These edge cases shouldn't come up in normal operation. The best+-- course of action is probably to throw these as an exception.+data EsAmazonkaAuthError = InvalidStdMethod Method+                         | StreamingBodyNotSupported+                         | MalformedQueryString deriving (Show, Eq, Typeable)+++instance Exception EsAmazonkaAuthError++-------------------------------------------------------------------------------+toRQBody :: RequestBody -> Either EsAmazonkaAuthError RqBody+toRQBody (RequestBodyLBS b) = Right (toBody b)+toRQBody (RequestBodyBS b) = Right (toBody b)+toRQBody _ = Left StreamingBodyNotSupported
+ test/Main.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}+module Main+    ( main+    ) where+++-------------------------------------------------------------------------------+import           Data.Time.Clock.POSIX+import           Network.AWS.Types+import           Network.HTTP.Client+import           Test.Tasty+import           Test.Tasty.HUnit+-------------------------------------------------------------------------------+import           Database.Bloodhound.Auth.Amazonka.Internal+-------------------------------------------------------------------------------+++main :: IO ()+main = defaultMain tests+++-------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "bloodhound-amazonka-auth"+  [+    amazonkaAuthHookTests+  ]+++-------------------------------------------------------------------------------+amazonkaAuthHookTests :: TestTree+amazonkaAuthHookTests = testGroup "amazonkaAuthHook"+  [+    testCase "does not mangle query parameters" $ do+      req <- parseUrl "http://localhost:9200/foo/foo/_search?scroll=1m&search_type=scan"+      let ae = AuthEnv (AccessKey "access key") (SecretKey "secret key") Nothing Nothing+      let now = posixSecondsToUTCTime 0+      let Right res = amazonkaAuthHook' ae NorthVirginia req now+      secure res @?= False+      host res @?= "localhost"+      port res @?= 9200+      path res @?= "/foo/foo/_search"+      queryString res @?= "?scroll=1m&search_type=scan"+  ]