{-# LANGUAGE OverloadedStrings,TemplateHaskell #-}
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)
data WSConfig = WSConfig {
WSConfig -> String
apiKey :: String,
WSConfig -> String
apiPackage :: String,
WSConfig -> Bool
useSSL :: Bool
} deriving (Int -> WSConfig -> ShowS
[WSConfig] -> ShowS
WSConfig -> String
(Int -> WSConfig -> ShowS)
-> (WSConfig -> String) -> ([WSConfig] -> ShowS) -> Show WSConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WSConfig] -> ShowS
$cshowList :: [WSConfig] -> ShowS
show :: WSConfig -> String
$cshow :: WSConfig -> String
showsPrec :: Int -> WSConfig -> ShowS
$cshowsPrec :: Int -> WSConfig -> ShowS
Show)
data WSResult = WSResult {
WSResult -> String
response :: String,
WSResult -> Maybe String
country_code :: Maybe String,
WSResult -> Maybe String
country_name :: Maybe String,
WSResult -> Maybe String
region_name :: Maybe String,
WSResult -> Maybe String
city_name :: Maybe String,
WSResult -> Maybe Float
latitude :: Maybe Float,
WSResult -> Maybe Float
longitude :: Maybe Float,
WSResult -> Maybe String
zip_code :: Maybe String,
WSResult -> Maybe String
time_zone :: Maybe String,
WSResult -> Maybe String
isp :: Maybe String,
WSResult -> Maybe String
domain :: Maybe String,
WSResult -> Maybe String
net_speed :: Maybe String,
WSResult -> Maybe String
idd_code :: Maybe String,
WSResult -> Maybe String
area_code :: Maybe String,
WSResult -> Maybe String
weather_station_code :: Maybe String,
WSResult -> Maybe String
weather_station_name :: Maybe String,
WSResult -> Maybe String
mcc :: Maybe String,
WSResult -> Maybe String
mnc :: Maybe String,
WSResult -> Maybe String
mobile_brand :: Maybe String,
WSResult -> Maybe Float
elevation :: Maybe Float,
WSResult -> Maybe String
usage_type :: Maybe String,
WSResult -> Maybe String
address_type :: Maybe String,
WSResult -> Maybe String
category :: Maybe String,
WSResult -> Maybe String
category_name :: Maybe String,
WSResult -> Maybe Float
credits_consumed :: Maybe Float
} deriving (Int -> WSResult -> ShowS
[WSResult] -> ShowS
WSResult -> String
(Int -> WSResult -> ShowS)
-> (WSResult -> String) -> ([WSResult] -> ShowS) -> Show WSResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WSResult] -> ShowS
$cshowList :: [WSResult] -> ShowS
show :: WSResult -> String
$cshow :: WSResult -> String
showsPrec :: Int -> WSResult -> ShowS
$cshowsPrec :: Int -> WSResult -> ShowS
Show, WSResult -> WSResult -> Bool
(WSResult -> WSResult -> Bool)
-> (WSResult -> WSResult -> Bool) -> Eq WSResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WSResult -> WSResult -> Bool
$c/= :: WSResult -> WSResult -> Bool
== :: WSResult -> WSResult -> Bool
$c== :: WSResult -> WSResult -> Bool
Eq)
$(deriveJSON defaultOptions ''WSResult)
checkparams :: String -> String -> IO String
checkparams :: String -> String -> IO String
checkparams String
apikey String
apipackage = do
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"OK"
openWS :: String -> String -> Bool -> IO WSConfig
openWS :: String -> String -> Bool -> IO WSConfig
openWS String
apikey String
apipackage Bool
usessl = do
String
paramok <- String -> String -> IO String
checkparams String
apikey String
apipackage
WSConfig -> IO WSConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String -> Bool -> WSConfig
WSConfig String
apikey String
apipackage Bool
usessl)
lookUp :: WSConfig -> String -> IO WSResult
lookUp :: WSConfig -> String -> IO WSResult
lookUp WSConfig
myconfig String
ip = do
let key :: String
key = WSConfig -> String
apiKey WSConfig
myconfig
let package :: String
package = WSConfig -> String
apiPackage WSConfig
myconfig
let usessl :: Bool
usessl = WSConfig -> Bool
useSSL WSConfig
myconfig
String
paramok <- String -> String -> IO String
checkparams String
key String
package
let protocol :: String
protocol = if Bool
usessl Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True
then String
"https"
else String
"http"
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
Request
httprequest <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ String
protocol String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"://api.ip2location.com/v2/?key=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&package=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
package String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&ip=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
URIE.encode String
ip)
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
let Just WSResult
result = ByteString -> Maybe WSResult
forall a. FromJSON a => ByteString -> Maybe a
DA.decode ByteString
json :: Maybe WSResult
WSResult -> IO WSResult
forall (m :: * -> *) a. Monad m => a -> m a
return WSResult
result
bsToString :: BS.ByteString -> String
bsToString :: ByteString -> String
bsToString ByteString
bs = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Enum a => a -> Int
fromEnum) ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
bs
getCredit :: WSConfig -> IO String
getCredit :: WSConfig -> IO String
getCredit WSConfig
myconfig = do
let key :: String
key = WSConfig -> String
apiKey WSConfig
myconfig
let package :: String
package = WSConfig -> String
apiPackage WSConfig
myconfig
let usessl :: Bool
usessl = WSConfig -> Bool
useSSL WSConfig
myconfig
String
paramok <- String -> String -> IO String
checkparams String
key String
package
let protocol :: String
protocol = if Bool
usessl Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True
then String
"https"
else String
"http"
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
Request
httprequest <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ String
protocol String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"://api.ip2location.com/v2/?key=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&check=true"
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
let part :: String
part = [String] -> String
forall a. [a] -> a
head (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"}" (ByteString -> String
bsToString ByteString
json))
let result :: String
result = [String] -> String
forall a. [a] -> a
last (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
":" String
part)
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
result