ip2location 8.3.1 → 8.4.0

raw patch · 4 files changed

+174/−4 lines, 4 filesdep +aesondep +http-clientdep +http-client-tlsPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, http-client, http-client-tls, http-types, split, uri-encode

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• IP2Location.hs +1/−1
• IP2LocationWebService.hs +162/−0
• ip2location.cabal +3/−3

@@ -1,5 +1,13 @@ # Revision history for ip2location +## 8.4.0  -- 2021-11-29++* Added support for IP2Location Web Service.++## 8.3.1  -- 2021-06-24++* Fixed Hackage build depedencies issue.+ ## 8.3.0  -- 2021-06-23  * Added support for address type and IAB category. Added exception handling for wrong BIN file.

@@ -136,7 +136,7 @@     The 'getAPIVersion' function returns a string containing the API version.
 -}
 getAPIVersion :: String
-getAPIVersion = "8.3.0"
+getAPIVersion = "8.4.0"
 
 ipToOcts :: IP -> [Int]
 ipToOcts (IPv4 ip) = fromIPv4 ip

@@ -0,0 +1,162 @@+{-# LANGUAGE OverloadedStrings,TemplateHaskell #-}
+{-|
+Module      : IP2LocationWebService
+Description : IP2Location Haskell package
+Copyright   : (c) IP2Location, 2021
+License     : MIT
+Maintainer  : sales@ip2location.com
+Stability   : experimental
+
+This Haskell package allows users to query an IP address to get geolocation info.
+
+IP2Location Web Service API subscription at https://www.ip2location.com/web-service/ip2location
+-}
+module IP2LocationWebService (WSResult(..), WSConfig, openWS, lookUp, getCredit) where
+
+import Control.Exception
+import System.Exit
+import Data.Aeson as DA
+import Data.Aeson.TH
+import Network.HTTP.Client
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Network.HTTP.Types.Status (statusCode)
+import Data.Maybe
+import Network.URI.Encode as URIE
+import Data.List.Split
+import Data.ByteString.Lazy as BS (ByteString, unpack)
+import Data.Char (chr)
+
+-- | Contains the web service configuration.
+data WSConfig = WSConfig {
+    -- | Web service API key
+    apiKey :: String,
+    -- | API package
+    apiPackage :: String,
+    -- | Use SSL
+    useSSL :: Bool
+} deriving (Show)
+
+-- | Contains the web service results.
+data WSResult = WSResult {
+    -- | Response status or error
+    response :: String,
+    -- | Country code
+    country_code :: Maybe String,
+    -- | Country name
+    country_name :: Maybe String,
+    -- | Region name
+    region_name :: Maybe String,
+    -- | City name
+    city_name :: Maybe String,
+    -- | Latitude
+    latitude :: Maybe Float,
+    -- | Longitude
+    longitude :: Maybe Float,
+    -- | ZIP code
+    zip_code :: Maybe String,
+    -- | Time zone
+    time_zone :: Maybe String,
+    -- | ISP name
+    isp :: Maybe String,
+    -- | Domain
+    domain :: Maybe String,
+    -- | Net speed
+    net_speed :: Maybe String,
+    -- | IDD code
+    idd_code :: Maybe String,
+    -- | Area code
+    area_code :: Maybe String,
+    -- | Weather station code
+    weather_station_code :: Maybe String,
+    -- | Weather station name
+    weather_station_name :: Maybe String,
+    -- | MCC
+    mcc :: Maybe String,
+    -- | MNC
+    mnc :: Maybe String,
+    -- | Mobile brand
+    mobile_brand :: Maybe String,
+    -- | Elevation
+    elevation :: Maybe Float,
+    -- | Usage type
+    usage_type :: Maybe String,
+    -- | Address type
+    address_type :: Maybe String,
+    -- | IAB category code
+    category :: Maybe String,
+    -- | IAB category name
+    category_name :: Maybe String,
+    -- | Credits consumed
+    credits_consumed :: Maybe Float
+} deriving (Show, Eq)
+
+$(deriveJSON defaultOptions ''WSResult)
+
+checkparams :: String -> String -> IO String
+checkparams apikey apipackage = do
+    return "OK"
+    --- regex part commented out due to cabal dependency issues
+    -- let apikeyok = apikey =~ ("^[0-9A-Z]{10}$" :: String) :: Bool
+    -- if apikeyok == False
+        -- then die(show "Invalid API key.")
+        -- else do
+            -- let apipackageok = apipackage =~ ("^WS[0-9]+$" :: String) :: Bool
+            -- if apipackageok == False
+                -- then die(show "Invalid package name.")
+                -- else return "OK"
+
+{-|
+    The 'openWS' function initializes the web service configuration.
+    It takes 3 arguments; the web service API key, the API package to call & whether to use SSL.
+-}
+openWS :: String -> String -> Bool -> IO WSConfig
+openWS apikey apipackage usessl = do
+    paramok <- checkparams apikey apipackage
+    return (WSConfig apikey apipackage usessl)
+
+{-|
+    The 'lookUp' function returns an WSResult containing geolocation data for an IP address
+    It takes 2 arguments; the web service configuration from 'openWS' function (WSConfig record), either IPv4 or IPv6 address (String)
+-}
+lookUp :: WSConfig -> String -> IO WSResult
+lookUp myconfig ip = do
+    let key = apiKey myconfig
+    let package = apiPackage myconfig
+    let usessl = useSSL myconfig
+
+    paramok <- checkparams key package
+    let protocol = if usessl == True
+        then "https"
+        else "http"
+    manager <- newManager tlsManagerSettings
+    httprequest <- parseRequest $ protocol ++ "://api.ip2location.com/v2/?key=" ++ key ++ "&package=" ++ package ++ "&ip=" ++ (URIE.encode ip)
+    httpresponse <- httpLbs httprequest manager
+    let json = responseBody httpresponse
+    let Just result = DA.decode json :: Maybe WSResult
+    return result
+
+bsToString :: BS.ByteString -> String
+bsToString bs = map (chr . fromEnum) . BS.unpack $ bs
+
+{-|
+    The 'getCredit' function returns an IO String containing web service credit balance for the API key.
+    It takes 1 argument; the web service configuration from 'openWS' function (WSConfig record).
+-}
+getCredit :: WSConfig -> IO String
+getCredit myconfig = do
+    let key = apiKey myconfig
+    let package = apiPackage myconfig
+    let usessl = useSSL myconfig
+
+    paramok <- checkparams key package
+    let protocol = if usessl == True
+        then "https"
+        else "http"
+    manager <- newManager tlsManagerSettings
+    httprequest <- parseRequest $ protocol ++ "://api.ip2location.com/v2/?key=" ++ key ++ "&check=true"
+    httpresponse <- httpLbs httprequest manager
+    let json = responseBody httpresponse
+    -- using splitOn to extract the response field to bypass the Haskell duplicate field name issues
+    let part = head (splitOn "}" (bsToString json))
+    let result = last (splitOn ":" part)
+    return result

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             8.3.1+version:             8.4.0  -- A short (one-line) description of the package. synopsis:            IP2Location Haskell package for IP geolocation.@@ -51,7 +51,7 @@  library   -- Modules exported by the library.-  exposed-modules:     IP2Location+  exposed-modules:     IP2Location, IP2LocationWebService      -- Modules included in this library but not exported.   -- other-modules:       @@ -60,7 +60,7 @@   -- other-extensions:          -- Other library packages from which modules are imported.-  build-depends:       base >=4.9 && <=4.15, bytestring >=0.10 && <0.12, binary >=0.8.4 && <0.9, iproute >=1.7 && <1.8+  build-depends:       base >=4.9 && <=4.15, bytestring >=0.10 && <0.12, binary >=0.8.4 && <0.9, iproute >=1.7 && <1.8, aeson >=1.5 && <1.6, http-types >=0.12 && <0.13, http-client >=0.6 && <0.7, http-client-tls >=0.3 && <0.4, uri-encode >=1.5 && <1.6, split <=0.2.3.4      -- Directories containing source files.   -- hs-source-dirs: