diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/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/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,6 +2,8 @@ [![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)](http://www.haskell.org) [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29) +[![Hackage](https://img.shields.io/hackage/v/ziptastic-client.svg)](http://hackage.haskell.org/package/ziptastic-client) +[![Hackage-Deps](https://img.shields.io/hackage-deps/v/ziptastic-client.svg)](http://packdeps.haskellers.com/feed?needle=ziptastic-client) A convenient and type-safe client library for the [Ziptastic](https://www.getziptastic.com/) API providing forward and reverse geocoding via country, zip code (postal code), latitude, and longitude. diff --git a/src/Ziptastic/Client.hs b/src/Ziptastic/Client.hs --- a/src/Ziptastic/Client.hs +++ b/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 @@ 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 @@ -- 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 @@ -- 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 @@ 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/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/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.cabal b/ziptastic-client.cabal --- a/ziptastic-client.cabal +++ b/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 @@ 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,13 +33,30 @@ , 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 TypeOperators 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