{-# LANGUAGE DeriveGeneric,OverloadedStrings,DuplicateRecordFields #-}
{-|
Module      : IPGeolocation
Description : IP2Location.io Haskell package
Copyright   : (c) IP2Location, 2025
License     : MIT
Maintainer  : sales@ip2location.com
Stability   : experimental

This module allows users to query an IP address to get geolocation & proxy info.

IP2Location.io API subscription at https://www.ip2location.io
-}
module IPGeolocation (IPResult(..), ResponseObj(..), ErrorObj(..), ErrorInfo(..), Continent(..), Translation(..), Country(..), Currency(..), Language(..), Region(..), City(..), TimeZoneInfo(..), GeoTargeting(..), ProxyObj(..), lookUpIP) where

import Control.Exception
import System.Exit
import Data.Aeson as DA
import Data.Aeson.Types (Result(..), Parser)
import Network.HTTP.Client
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types.Status (statusCode)
import Network.URI.Encode as URIE
import Configuration
import GHC.Generics (Generic)
import Control.Applicative ((<|>))

-- | Translation

data Translation = Translation {
    Translation -> Maybe [Char]
lang :: Maybe String,
    Translation -> Maybe [Char]
value :: Maybe String
} deriving (Int -> Translation -> ShowS
[Translation] -> ShowS
Translation -> [Char]
(Int -> Translation -> ShowS)
-> (Translation -> [Char])
-> ([Translation] -> ShowS)
-> Show Translation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Translation -> ShowS
showsPrec :: Int -> Translation -> ShowS
$cshow :: Translation -> [Char]
show :: Translation -> [Char]
$cshowList :: [Translation] -> ShowS
showList :: [Translation] -> ShowS
Show, (forall x. Translation -> Rep Translation x)
-> (forall x. Rep Translation x -> Translation)
-> Generic Translation
forall x. Rep Translation x -> Translation
forall x. Translation -> Rep Translation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Translation -> Rep Translation x
from :: forall x. Translation -> Rep Translation x
$cto :: forall x. Rep Translation x -> Translation
to :: forall x. Rep Translation x -> Translation
Generic)

-- | Continent

data Continent = Continent {
    Continent -> [Char]
name :: String,
    Continent -> [Char]
code :: String,
    Continent -> [[Char]]
hemisphere :: [String],
    Continent -> Translation
translation :: Translation
} deriving (Int -> Continent -> ShowS
[Continent] -> ShowS
Continent -> [Char]
(Int -> Continent -> ShowS)
-> (Continent -> [Char])
-> ([Continent] -> ShowS)
-> Show Continent
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Continent -> ShowS
showsPrec :: Int -> Continent -> ShowS
$cshow :: Continent -> [Char]
show :: Continent -> [Char]
$cshowList :: [Continent] -> ShowS
showList :: [Continent] -> ShowS
Show, (forall x. Continent -> Rep Continent x)
-> (forall x. Rep Continent x -> Continent) -> Generic Continent
forall x. Rep Continent x -> Continent
forall x. Continent -> Rep Continent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Continent -> Rep Continent x
from :: forall x. Continent -> Rep Continent x
$cto :: forall x. Rep Continent x -> Continent
to :: forall x. Rep Continent x -> Continent
Generic)

-- | Currency

data Currency = Currency {
    Currency -> [Char]
code :: String,
    Currency -> [Char]
name :: String,
    Currency -> [Char]
symbol :: String
} deriving (Int -> Currency -> ShowS
[Currency] -> ShowS
Currency -> [Char]
(Int -> Currency -> ShowS)
-> (Currency -> [Char]) -> ([Currency] -> ShowS) -> Show Currency
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Currency -> ShowS
showsPrec :: Int -> Currency -> ShowS
$cshow :: Currency -> [Char]
show :: Currency -> [Char]
$cshowList :: [Currency] -> ShowS
showList :: [Currency] -> ShowS
Show, (forall x. Currency -> Rep Currency x)
-> (forall x. Rep Currency x -> Currency) -> Generic Currency
forall x. Rep Currency x -> Currency
forall x. Currency -> Rep Currency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Currency -> Rep Currency x
from :: forall x. Currency -> Rep Currency x
$cto :: forall x. Rep Currency x -> Currency
to :: forall x. Rep Currency x -> Currency
Generic)

-- | Language

data Language = Language {
    Language -> [Char]
code :: String,
    Language -> [Char]
name :: String
} deriving (Int -> Language -> ShowS
[Language] -> ShowS
Language -> [Char]
(Int -> Language -> ShowS)
-> (Language -> [Char]) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> [Char]
show :: Language -> [Char]
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show, (forall x. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Language -> Rep Language x
from :: forall x. Language -> Rep Language x
$cto :: forall x. Rep Language x -> Language
to :: forall x. Rep Language x -> Language
Generic)

-- | Country

data Country = Country {
    Country -> [Char]
name :: String,
    Country -> [Char]
alpha3_code :: String,
    Country -> Int
numeric_code :: Int,
    Country -> [Char]
demonym :: String,
    Country -> [Char]
flag :: String,
    Country -> [Char]
capital :: String,
    Country -> Int
total_area :: Int,
    Country -> Int
population :: Int,
    Country -> Currency
currency :: Currency,
    Country -> Language
language :: Language,
    Country -> [Char]
tld :: String,
    Country -> Translation
translation :: Translation
} deriving (Int -> Country -> ShowS
[Country] -> ShowS
Country -> [Char]
(Int -> Country -> ShowS)
-> (Country -> [Char]) -> ([Country] -> ShowS) -> Show Country
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Country -> ShowS
showsPrec :: Int -> Country -> ShowS
$cshow :: Country -> [Char]
show :: Country -> [Char]
$cshowList :: [Country] -> ShowS
showList :: [Country] -> ShowS
Show, (forall x. Country -> Rep Country x)
-> (forall x. Rep Country x -> Country) -> Generic Country
forall x. Rep Country x -> Country
forall x. Country -> Rep Country x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Country -> Rep Country x
from :: forall x. Country -> Rep Country x
$cto :: forall x. Rep Country x -> Country
to :: forall x. Rep Country x -> Country
Generic)

-- | Region

data Region = Region {
    Region -> [Char]
name :: String,
    Region -> [Char]
code :: String,
    Region -> Translation
translation :: Translation
} deriving (Int -> Region -> ShowS
[Region] -> ShowS
Region -> [Char]
(Int -> Region -> ShowS)
-> (Region -> [Char]) -> ([Region] -> ShowS) -> Show Region
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Region -> ShowS
showsPrec :: Int -> Region -> ShowS
$cshow :: Region -> [Char]
show :: Region -> [Char]
$cshowList :: [Region] -> ShowS
showList :: [Region] -> ShowS
Show, (forall x. Region -> Rep Region x)
-> (forall x. Rep Region x -> Region) -> Generic Region
forall x. Rep Region x -> Region
forall x. Region -> Rep Region x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Region -> Rep Region x
from :: forall x. Region -> Rep Region x
$cto :: forall x. Rep Region x -> Region
to :: forall x. Rep Region x -> Region
Generic)

-- | City

data City = City {
    City -> [Char]
name :: String,
    City -> Translation
translation :: Translation
} deriving (Int -> City -> ShowS
[City] -> ShowS
City -> [Char]
(Int -> City -> ShowS)
-> (City -> [Char]) -> ([City] -> ShowS) -> Show City
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> City -> ShowS
showsPrec :: Int -> City -> ShowS
$cshow :: City -> [Char]
show :: City -> [Char]
$cshowList :: [City] -> ShowS
showList :: [City] -> ShowS
Show, (forall x. City -> Rep City x)
-> (forall x. Rep City x -> City) -> Generic City
forall x. Rep City x -> City
forall x. City -> Rep City x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. City -> Rep City x
from :: forall x. City -> Rep City x
$cto :: forall x. Rep City x -> City
to :: forall x. Rep City x -> City
Generic)

-- | Time zone info

data TimeZoneInfo = TimeZoneInfo {
    TimeZoneInfo -> [Char]
olson :: String,
    TimeZoneInfo -> [Char]
current_time :: String,
    TimeZoneInfo -> Int
gmt_offset :: Int,
    TimeZoneInfo -> Bool
is_dst :: Bool,
    TimeZoneInfo -> [Char]
sunrise :: String,
    TimeZoneInfo -> [Char]
sunset :: String
} deriving (Int -> TimeZoneInfo -> ShowS
[TimeZoneInfo] -> ShowS
TimeZoneInfo -> [Char]
(Int -> TimeZoneInfo -> ShowS)
-> (TimeZoneInfo -> [Char])
-> ([TimeZoneInfo] -> ShowS)
-> Show TimeZoneInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeZoneInfo -> ShowS
showsPrec :: Int -> TimeZoneInfo -> ShowS
$cshow :: TimeZoneInfo -> [Char]
show :: TimeZoneInfo -> [Char]
$cshowList :: [TimeZoneInfo] -> ShowS
showList :: [TimeZoneInfo] -> ShowS
Show, (forall x. TimeZoneInfo -> Rep TimeZoneInfo x)
-> (forall x. Rep TimeZoneInfo x -> TimeZoneInfo)
-> Generic TimeZoneInfo
forall x. Rep TimeZoneInfo x -> TimeZoneInfo
forall x. TimeZoneInfo -> Rep TimeZoneInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeZoneInfo -> Rep TimeZoneInfo x
from :: forall x. TimeZoneInfo -> Rep TimeZoneInfo x
$cto :: forall x. Rep TimeZoneInfo x -> TimeZoneInfo
to :: forall x. Rep TimeZoneInfo x -> TimeZoneInfo
Generic)

-- | Geotargeting

data GeoTargeting = GeoTargeting {
    GeoTargeting -> Maybe [Char]
metro :: Maybe String
} deriving (Int -> GeoTargeting -> ShowS
[GeoTargeting] -> ShowS
GeoTargeting -> [Char]
(Int -> GeoTargeting -> ShowS)
-> (GeoTargeting -> [Char])
-> ([GeoTargeting] -> ShowS)
-> Show GeoTargeting
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeoTargeting -> ShowS
showsPrec :: Int -> GeoTargeting -> ShowS
$cshow :: GeoTargeting -> [Char]
show :: GeoTargeting -> [Char]
$cshowList :: [GeoTargeting] -> ShowS
showList :: [GeoTargeting] -> ShowS
Show, (forall x. GeoTargeting -> Rep GeoTargeting x)
-> (forall x. Rep GeoTargeting x -> GeoTargeting)
-> Generic GeoTargeting
forall x. Rep GeoTargeting x -> GeoTargeting
forall x. GeoTargeting -> Rep GeoTargeting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GeoTargeting -> Rep GeoTargeting x
from :: forall x. GeoTargeting -> Rep GeoTargeting x
$cto :: forall x. Rep GeoTargeting x -> GeoTargeting
to :: forall x. Rep GeoTargeting x -> GeoTargeting
Generic)

-- | Proxy

data ProxyObj = ProxyObj {
    ProxyObj -> Int
last_seen :: Int,
    ProxyObj -> [Char]
proxy_type :: String,
    ProxyObj -> [Char]
threat :: String,
    ProxyObj -> [Char]
provider :: String,
    ProxyObj -> Bool
is_vpn :: Bool,
    ProxyObj -> Bool
is_tor :: Bool,
    ProxyObj -> Bool
is_data_center :: Bool,
    ProxyObj -> Bool
is_public_proxy :: Bool,
    ProxyObj -> Bool
is_web_proxy :: Bool,
    ProxyObj -> Bool
is_web_crawler :: Bool,
    ProxyObj -> Bool
is_residential_proxy :: Bool,
    ProxyObj -> Bool
is_consumer_privacy_network :: Bool,
    ProxyObj -> Bool
is_enterprise_private_network :: Bool,
    ProxyObj -> Bool
is_spammer :: Bool,
    ProxyObj -> Bool
is_scanner :: Bool,ProxyObj -> Bool
is_botnet :: Bool
} deriving (Int -> ProxyObj -> ShowS
[ProxyObj] -> ShowS
ProxyObj -> [Char]
(Int -> ProxyObj -> ShowS)
-> (ProxyObj -> [Char]) -> ([ProxyObj] -> ShowS) -> Show ProxyObj
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProxyObj -> ShowS
showsPrec :: Int -> ProxyObj -> ShowS
$cshow :: ProxyObj -> [Char]
show :: ProxyObj -> [Char]
$cshowList :: [ProxyObj] -> ShowS
showList :: [ProxyObj] -> ShowS
Show, (forall x. ProxyObj -> Rep ProxyObj x)
-> (forall x. Rep ProxyObj x -> ProxyObj) -> Generic ProxyObj
forall x. Rep ProxyObj x -> ProxyObj
forall x. ProxyObj -> Rep ProxyObj x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProxyObj -> Rep ProxyObj x
from :: forall x. ProxyObj -> Rep ProxyObj x
$cto :: forall x. Rep ProxyObj x -> ProxyObj
to :: forall x. Rep ProxyObj x -> ProxyObj
Generic)

-- | Main response type

data ResponseObj = ResponseObj {
    ResponseObj -> [Char]
ip :: String,
    ResponseObj -> [Char]
country_code :: String,
    ResponseObj -> [Char]
country_name :: String,
    ResponseObj -> [Char]
region_name :: String,
    ResponseObj -> [Char]
city_name :: String,
    ResponseObj -> Float
latitude :: Float,
    ResponseObj -> Float
longitude :: Float,
    ResponseObj -> [Char]
zip_code :: String,
    ResponseObj -> [Char]
time_zone :: String,
    ResponseObj -> [Char]
asn :: String,
    ResponseObj -> [Char]
as :: String,
    ResponseObj -> Maybe [Char]
isp :: Maybe String,
    ResponseObj -> Maybe [Char]
domain :: Maybe String,
    ResponseObj -> Maybe [Char]
net_speed :: Maybe String,
    ResponseObj -> Maybe [Char]
idd_code :: Maybe String,
    ResponseObj -> Maybe [Char]
area_code :: Maybe String,
    ResponseObj -> Maybe [Char]
weather_station_code :: Maybe String,
    ResponseObj -> Maybe [Char]
weather_station_name :: Maybe String,
    ResponseObj -> Maybe [Char]
mcc :: Maybe String,
    ResponseObj -> Maybe [Char]
mnc :: Maybe String,
    ResponseObj -> Maybe [Char]
mobile_brand :: Maybe String,
    ResponseObj -> Maybe Int
elevation :: Maybe Int,
    ResponseObj -> Maybe [Char]
usage_type :: Maybe String,
    ResponseObj -> Maybe [Char]
address_type :: Maybe String,
    ResponseObj -> Maybe Continent
continent :: Maybe Continent,
    ResponseObj -> Maybe Country
country :: Maybe Country,
    ResponseObj -> Maybe Region
region :: Maybe Region,
    ResponseObj -> Maybe City
city :: Maybe City,
    ResponseObj -> Maybe TimeZoneInfo
time_zone_info :: Maybe TimeZoneInfo,
    ResponseObj -> Maybe GeoTargeting
geotargeting :: Maybe GeoTargeting,
    ResponseObj -> Maybe [Char]
ads_category :: Maybe String,
    ResponseObj -> Maybe [Char]
ads_category_name :: Maybe String,
    ResponseObj -> Maybe [Char]
district :: Maybe String,
    ResponseObj -> Bool
is_proxy :: Bool,
    ResponseObj -> Maybe Int
fraud_score :: Maybe Int,
    ResponseObj -> Maybe ProxyObj
proxy :: Maybe ProxyObj
} deriving (Int -> ResponseObj -> ShowS
[ResponseObj] -> ShowS
ResponseObj -> [Char]
(Int -> ResponseObj -> ShowS)
-> (ResponseObj -> [Char])
-> ([ResponseObj] -> ShowS)
-> Show ResponseObj
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseObj -> ShowS
showsPrec :: Int -> ResponseObj -> ShowS
$cshow :: ResponseObj -> [Char]
show :: ResponseObj -> [Char]
$cshowList :: [ResponseObj] -> ShowS
showList :: [ResponseObj] -> ShowS
Show, (forall x. ResponseObj -> Rep ResponseObj x)
-> (forall x. Rep ResponseObj x -> ResponseObj)
-> Generic ResponseObj
forall x. Rep ResponseObj x -> ResponseObj
forall x. ResponseObj -> Rep ResponseObj x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResponseObj -> Rep ResponseObj x
from :: forall x. ResponseObj -> Rep ResponseObj x
$cto :: forall x. Rep ResponseObj x -> ResponseObj
to :: forall x. Rep ResponseObj x -> ResponseObj
Generic)

-- | Define the error detail structure

data ErrorInfo = ErrorInfo {
    ErrorInfo -> Int
error_code :: Int,
    ErrorInfo -> [Char]
error_message :: String
} deriving (Int -> ErrorInfo -> ShowS
[ErrorInfo] -> ShowS
ErrorInfo -> [Char]
(Int -> ErrorInfo -> ShowS)
-> (ErrorInfo -> [Char])
-> ([ErrorInfo] -> ShowS)
-> Show ErrorInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorInfo -> ShowS
showsPrec :: Int -> ErrorInfo -> ShowS
$cshow :: ErrorInfo -> [Char]
show :: ErrorInfo -> [Char]
$cshowList :: [ErrorInfo] -> ShowS
showList :: [ErrorInfo] -> ShowS
Show, (forall x. ErrorInfo -> Rep ErrorInfo x)
-> (forall x. Rep ErrorInfo x -> ErrorInfo) -> Generic ErrorInfo
forall x. Rep ErrorInfo x -> ErrorInfo
forall x. ErrorInfo -> Rep ErrorInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ErrorInfo -> Rep ErrorInfo x
from :: forall x. ErrorInfo -> Rep ErrorInfo x
$cto :: forall x. Rep ErrorInfo x -> ErrorInfo
to :: forall x. Rep ErrorInfo x -> ErrorInfo
Generic)

-- | Define the error structure

data ErrorObj = ErrorObj {
    ErrorObj -> ErrorInfo
error :: ErrorInfo
} deriving (Int -> ErrorObj -> ShowS
[ErrorObj] -> ShowS
ErrorObj -> [Char]
(Int -> ErrorObj -> ShowS)
-> (ErrorObj -> [Char]) -> ([ErrorObj] -> ShowS) -> Show ErrorObj
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorObj -> ShowS
showsPrec :: Int -> ErrorObj -> ShowS
$cshow :: ErrorObj -> [Char]
show :: ErrorObj -> [Char]
$cshowList :: [ErrorObj] -> ShowS
showList :: [ErrorObj] -> ShowS
Show, (forall x. ErrorObj -> Rep ErrorObj x)
-> (forall x. Rep ErrorObj x -> ErrorObj) -> Generic ErrorObj
forall x. Rep ErrorObj x -> ErrorObj
forall x. ErrorObj -> Rep ErrorObj x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ErrorObj -> Rep ErrorObj x
from :: forall x. ErrorObj -> Rep ErrorObj x
$cto :: forall x. Rep ErrorObj x -> ErrorObj
to :: forall x. Rep ErrorObj x -> ErrorObj
Generic)

-- | Define the wrapper type for Response or Error

data IPResult
    = IPResponse ResponseObj
    | IPError ErrorObj
    deriving (Int -> IPResult -> ShowS
[IPResult] -> ShowS
IPResult -> [Char]
(Int -> IPResult -> ShowS)
-> (IPResult -> [Char]) -> ([IPResult] -> ShowS) -> Show IPResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IPResult -> ShowS
showsPrec :: Int -> IPResult -> ShowS
$cshow :: IPResult -> [Char]
show :: IPResult -> [Char]
$cshowList :: [IPResult] -> ShowS
showList :: [IPResult] -> ShowS
Show, (forall x. IPResult -> Rep IPResult x)
-> (forall x. Rep IPResult x -> IPResult) -> Generic IPResult
forall x. Rep IPResult x -> IPResult
forall x. IPResult -> Rep IPResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IPResult -> Rep IPResult x
from :: forall x. IPResult -> Rep IPResult x
$cto :: forall x. Rep IPResult x -> IPResult
to :: forall x. Rep IPResult x -> IPResult
Generic)

-- Derive FromJSON instances

instance FromJSON Translation
instance FromJSON Continent
instance FromJSON Currency
instance FromJSON Language
instance FromJSON Country
instance FromJSON Region
instance FromJSON City
instance FromJSON TimeZoneInfo
instance FromJSON GeoTargeting
instance FromJSON ProxyObj
instance FromJSON ResponseObj
instance FromJSON ErrorInfo
instance FromJSON ErrorObj
instance FromJSON IPResult where
    parseJSON :: Value -> Parser IPResult
parseJSON Value
v = 
        (ResponseObj -> IPResult
IPResponse (ResponseObj -> IPResult) -> Parser ResponseObj -> Parser IPResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ResponseObj
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) Parser IPResult -> Parser IPResult -> Parser IPResult
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ErrorObj -> IPResult
IPError (ErrorObj -> IPResult) -> Parser ErrorObj -> Parser IPResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ErrorObj
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

{-|
    The 'lookUpIP' function returns an IPResult containing geolocation & proxy data for an IP address
    It takes 3 arguments; the API configuration, either IPv4 or IPv6 address (String), lang
-}
lookUpIP :: Config -> String -> String -> IO IPResult
lookUpIP :: Config -> [Char] -> [Char] -> IO IPResult
lookUpIP Config
myconfig [Char]
ip [Char]
lang = do
    let format :: [Char]
format = [Char]
"json"
    let mySource :: [Char]
mySource = Config -> [Char]
source Config
myconfig
    let myVersion :: [Char]
myVersion = Config -> [Char]
version Config
myconfig
    let myKey :: [Char]
myKey = Config -> [Char]
apiKey Config
myconfig

    let langStr :: [Char]
langStr = if [Char]
lang [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
""
        then [Char]
""
        else [Char]
"&lang=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
URIE.encode [Char]
lang)

    let url :: [Char]
url = [Char]
"https://api.ip2location.io/?key=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
URIE.encode [Char]
myKey) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"&source=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
mySource [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"&source-version=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
myVersion [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"&format=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
format [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"&ip=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
URIE.encode [Char]
ip) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
langStr
    Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    Request
httprequest <- [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest ([Char] -> IO Request) -> [Char] -> IO Request
forall a b. (a -> b) -> a -> b
$ [Char]
url
    Response ByteString
httpresponse <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
httprequest Manager
manager
    let json :: ByteString
json = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
httpresponse

    case ByteString -> Either [Char] IPResult
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
json of
        Right IPResult
result -> IPResult -> IO IPResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPResult
result
        Left [Char]
err -> [Char] -> IO IPResult
forall a. [Char] -> IO a
die([Char]
"ERROR: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err)