From 6ed0cbc384d765c9069dc098cb9e951c94fc7c1a Mon Sep 17 00:00:00 2001 From: 3noch Date: Wed, 15 Mar 2017 13:39:48 -0400 Subject: [PATCH] core v0.2.0.0; client v0.3.0.0 --- ziptastic-client/CHANGELOG.md | 5 +++ ziptastic-client/src/Ziptastic/Client.hs | 49 ++++++++++++++++-------- ziptastic-client/test/Spec.hs | 34 ++++++++++++++++ ziptastic-client/ziptastic-client.cabal | 23 +++++++++-- ziptastic-core/CHANGELOG.md | 5 +++ ziptastic-core/src/Ziptastic/Core.hs | 17 +------- ziptastic-core/test/Spec.hs | 5 +-- ziptastic-core/ziptastic-core.cabal | 4 +- 8 files changed, 101 insertions(+), 41 deletions(-) create mode 100644 ziptastic-client/test/Spec.hs diff --git a/ziptastic-client/CHANGELOG.md b/ziptastic-client/CHANGELOG.md index a9d187c..2301457 100644 --- a/ziptastic-client/CHANGELOG.md +++ b/ziptastic-client/CHANGELOG.md @@ -1,5 +1,10 @@ # Changelog +## 0.3.0.0 + + * Detect if a `Manager` supports TLS and switch between HTTP and HTTPS automatically. + * Change LANGUAGE pragma formatting to support older GHCs. + ## 0.2.0.0 * For failures, provide full `ServantError` instead converting it to `String`. diff --git a/ziptastic-client/src/Ziptastic/Client.hs b/ziptastic-client/src/Ziptastic/Client.hs index ea3f08c..747d50d 100644 --- a/ziptastic-client/src/Ziptastic/Client.hs +++ b/ziptastic-client/src/Ziptastic/Client.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE - DataKinds - , TypeOperators - , OverloadedStrings -#-} +{-# LANGUAGE DataKinds, TypeOperators, OverloadedStrings #-} -- | This module provides a simple interface to Ziptastic's forward and reverse geocoding API -- (). @@ -33,26 +29,31 @@ module Ziptastic.Client import Data.ISO3166_CountryCodes (CountryCode) import Data.Proxy (Proxy(..)) import Data.Text (Text) -import Network.HTTP.Client (Manager) import Servant.API ((:<|>)(..)) import Servant.Client - ( BaseUrl(..), ClientEnv(..), ClientM, Scheme(..), ServantError + ( BaseUrl(..), ClientEnv(..), ClientM, Scheme(..), ServantError(..) , client, runClientM ) import Ziptastic.Core (ApiKey, ForApi(..), LocaleInfo) import qualified Ziptastic.Core as Core +-- TODO: Needed for hack (see below). +import Network.HTTP.Client + ( Manager, HttpException(HttpExceptionRequest), HttpExceptionContent(TlsNotSupported) ) +import Control.Exception (fromException) + -- | Performs a forward geocode lookup at the given country and postal code. -- -- The success result is a list because in rare cases you may receive multiple records. -- If the request fails the result will be 'Left' with an error. forwardGeocode :: ApiKey - -> Manager -- ^ HTTP connection manager + -> Manager -- ^ HTTP connection manager (if TLS is supported, request will be made over HTTPS) -> CountryCode -- ^ country -> Text -- ^ postal code -> IO (Either ServantError [LocaleInfo]) -forwardGeocode apiKey manager countryCode postalCode = runClientM func (ClientEnv manager baseUrl) +forwardGeocode apiKey manager countryCode postalCode = + tryTlsOrDegrade $ \scheme -> runClientM func (ClientEnv manager $ baseUrl scheme) where func = forwardGeocode' (apiClient apiKey) (ForApi countryCode) postalCode -- | Performs a reverse geocode lookup at the given coordinates using a default radius of 5000 meters. @@ -60,7 +61,7 @@ forwardGeocode apiKey manager countryCode postalCode = runClientM func (ClientEn -- The success result is a list because in rare cases you may receive multiple records. -- If the request fails the result will be 'Left' with an error. reverseGeocode :: ApiKey - -> Manager -- ^ HTTP connection manager + -> Manager -- ^ HTTP connection manager (if TLS is supported, request will be made over HTTPS) -> Double -- ^ latitude -> Double -- ^ longitude -> IO (Either ServantError [LocaleInfo]) @@ -71,12 +72,13 @@ reverseGeocode apiKey manager lat long = reverseGeocodeWithRadius apiKey manager -- The success result is a list because in rare cases you may receive multiple records. -- If the request fails the result will be 'Left' with an error. reverseGeocodeWithRadius :: ApiKey - -> Manager -- ^ HTTP connection manager + -> Manager -- ^ HTTP connection manager (if TLS is supported, request will be made over HTTPS) -> Double -- ^ latitude -> Double -- ^ longitude -> Int -- ^ radius (in meters) -> IO (Either ServantError [LocaleInfo]) -reverseGeocodeWithRadius apiKey manager lat long radius = runClientM func (ClientEnv manager baseUrl) +reverseGeocodeWithRadius apiKey manager lat long radius = + tryTlsOrDegrade $ \scheme -> runClientM func (ClientEnv manager $ baseUrl scheme) where func = reverseGeocodeWithRadius' (mkReverseGeocode (apiClient apiKey) lat long) radius @@ -104,11 +106,26 @@ apiClient apiKey = ApiClient where withRadius :<|> withDefaultRadius = reverseGeocodeApi lat long -baseUrl :: BaseUrl -baseUrl = BaseUrl - { baseUrlScheme = if Core.baseUrlIsHttps then Https else Http +baseUrl :: Scheme -> BaseUrl +baseUrl scheme = BaseUrl + { baseUrlScheme = scheme , baseUrlHost = Core.baseUrlHost - , baseUrlPort = Core.baseUrlPort + , baseUrlPort = case scheme of + Http -> 80 + Https -> 443 , baseUrlPath = Core.baseUrlPath } + +-- TODO: Hack to detect if a Manager supports TLS. +-- See https://github.com/snoyberg/http-client/issues/266 +tryTlsOrDegrade :: (Scheme -> IO (Either ServantError a)) -> IO (Either ServantError a) +tryTlsOrDegrade req = do + secureResponse <- req Https + case secureResponse of + Left (ConnectionError connE) -> case fromException connE of + Just (ConnectionError connE2) -> case fromException connE2 of + Just (HttpExceptionRequest _ TlsNotSupported) -> req Http + _ -> pure secureResponse + _ -> pure secureResponse + _ -> pure secureResponse diff --git a/ziptastic-client/test/Spec.hs b/ziptastic-client/test/Spec.hs new file mode 100644 index 0000000..889e44d --- /dev/null +++ b/ziptastic-client/test/Spec.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE LambdaCase, OverloadedStrings #-} + +module Main (main) where + +import Data.ISO3166_CountryCodes (CountryCode(US)) +import Network.HTTP.Client (newManager) +import Network.HTTP.Client (defaultManagerSettings) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Types.Status (unauthorized401) +import Servant.Client (ServantError(..)) +import Test.Hspec +import Ziptastic.Client + +apiKey :: ApiKey +apiKey = "fake-key" + +main :: IO () +main = do + insecureManager <- newManager defaultManagerSettings + secureManager <- newManager tlsManagerSettings + hspec $ + describe "http client machinery" $ do + it "can make requests with secure manager" $ do + response <- forwardGeocode apiKey secureManager US "48867" + response `shouldSatisfy` \case + Left (FailureResponse{responseStatus=status}) -> status == unauthorized401 + _ -> False + + it "can make requests with insecure manager" $ do + response <- forwardGeocode apiKey insecureManager US "48867" + response `shouldSatisfy` \case + Left (FailureResponse{responseStatus=status}) -> status == unauthorized401 + _ -> False + diff --git a/ziptastic-client/ziptastic-client.cabal b/ziptastic-client/ziptastic-client.cabal index fee0ea0..bcc0c11 100644 --- a/ziptastic-client/ziptastic-client.cabal +++ b/ziptastic-client/ziptastic-client.cabal @@ -1,5 +1,5 @@ name: ziptastic-client -version: 0.2.0.0 +version: 0.3.0.0 synopsis: A type-safe client for the Ziptastic API for doing forward and reverse geocoding. description: @@ -18,7 +18,7 @@ category: Web build-type: Simple extra-source-files: README.md cabal-version: >=1.10 -tested-with: GHC==8.0.2 +tested-with: GHC == 8.0.2 extra-source-files: CHANGELOG.md README.md @@ -33,7 +33,7 @@ library , servant >= 0.9 && <= 0.11 , servant-client >= 0.9 && <= 0.11 , text - , ziptastic-core == 0.1.0.1 + , ziptastic-core == 0.2.0.0 default-language: Haskell2010 other-extensions: DataKinds @@ -41,6 +41,23 @@ library OverloadedStrings ghc-options: -Wall +test-suite test-client + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: + base + , hspec + , http-client + , http-client-tls + , http-types + , iso3166-country-codes + , servant-client + , ziptastic-client + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + + source-repository head type: git location: https://github.com/Ziptastic/ziptastic-haskell diff --git a/ziptastic-core/CHANGELOG.md b/ziptastic-core/CHANGELOG.md index 1a18810..ce1db42 100644 --- a/ziptastic-core/CHANGELOG.md +++ b/ziptastic-core/CHANGELOG.md @@ -1,5 +1,10 @@ # Changelog +## 0.2.0.0 + + * Don't export scheme and port for base URL since Ziptastic supports both HTTP and HTTPS. + * Change LANGUAGE pragma formatting to support older GHCs. + ## 0.1.0.1 * Add version bounds. diff --git a/ziptastic-core/src/Ziptastic/Core.hs b/ziptastic-core/src/Ziptastic/Core.hs index 5867410..974822b 100644 --- a/ziptastic-core/src/Ziptastic/Core.hs +++ b/ziptastic-core/src/Ziptastic/Core.hs @@ -1,11 +1,4 @@ -{-# LANGUAGE - DataKinds - , DeriveGeneric - , FlexibleInstances - , GeneralizedNewtypeDeriving - , OverloadedStrings - , TypeOperators -#-} +{-# LANGUAGE DataKinds, DeriveGeneric, FlexibleInstances, GeneralizedNewtypeDeriving, OverloadedStrings, TypeOperators #-} -- | This module provides a complete and type-safe API specification for -- Ziptastic's forward and reverse geocoding API using Servant @@ -19,9 +12,7 @@ module Ziptastic.Core , LocaleCoords(..) , LocaleInfo(..) , baseUrlHost - , baseUrlIsHttps , baseUrlPath - , baseUrlPort ) where import Control.Monad (when) @@ -125,14 +116,8 @@ type ReverseGeocodingApi -- API URL components -baseUrlIsHttps :: Bool -baseUrlIsHttps = True - baseUrlHost :: String baseUrlHost = "zip.getziptastic.com" -baseUrlPort :: Int -baseUrlPort = 443 - baseUrlPath :: String baseUrlPath = "" diff --git a/ziptastic-core/test/Spec.hs b/ziptastic-core/test/Spec.hs index a97df16..c0f161a 100644 --- a/ziptastic-core/test/Spec.hs +++ b/ziptastic-core/test/Spec.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE - OverloadedStrings - , QuasiQuotes -#-} +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} module Main (main) where diff --git a/ziptastic-core/ziptastic-core.cabal b/ziptastic-core/ziptastic-core.cabal index ec39f41..7784e50 100644 --- a/ziptastic-core/ziptastic-core.cabal +++ b/ziptastic-core/ziptastic-core.cabal @@ -1,5 +1,5 @@ name: ziptastic-core -version: 0.1.0.1 +version: 0.2.0.0 synopsis: Core Servant specification for the Ziptastic API for doing forward and reverse geocoding. description: @@ -20,7 +20,7 @@ category: Web build-type: Simple extra-source-files: README.md cabal-version: >=1.10 -tested-with: GHC==8.0.2 +tested-with: GHC == 8.0.2 extra-source-files: CHANGELOG.md README.md