{-# LANGUAGE OverloadedStrings,TemplateHaskell #-}
{-|
Module      : IP2ProxyWebService
Description : IP2Proxy 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 determine if it was being used as open proxy, web proxy, VPN anonymizer and TOR exits.

IP2Proxy Web Service API subscription at https://www.ip2location.com/web-service/ip2proxy
-}
module IP2ProxyWebService (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 Text.Regex.Base

-- import Text.Regex.TDFA


-- | Contains the web service configuration.

data WSConfig = WSConfig {
    -- | Web service API key

    WSConfig -> String
apiKey  :: String,
    -- | API package

    WSConfig -> String
apiPackage :: String,
    -- | Use SSL

    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)

-- | Contains the web service results.

data WSResult = WSResult {
    -- | Response status or error

    WSResult -> String
response  :: String,
    -- | Country code

    WSResult -> Maybe String
countryCode :: Maybe String,
    -- | Country name

    WSResult -> Maybe String
countryName :: Maybe String,
    -- | Region name

    WSResult -> Maybe String
regionName :: Maybe String,
    -- | City name

    WSResult -> Maybe String
cityName :: Maybe String,
    -- | ISP name

    WSResult -> Maybe String
isp :: Maybe String,
    -- | Domain

    WSResult -> Maybe String
domain :: Maybe String,
    -- | Usage type

    WSResult -> Maybe String
usageType :: Maybe String,
    -- | Autonomous System Number

    WSResult -> Maybe String
asn :: Maybe String,
    -- | Autonomous System

    WSResult -> Maybe String
as :: Maybe String,
    -- | Proxy last seen in days

    WSResult -> Maybe String
lastSeen :: Maybe String,
    -- | Proxy type

    WSResult -> Maybe String
proxyType :: Maybe String,
    -- | Threat type

    WSResult -> Maybe String
threat :: Maybe String,
    -- | Whether is a proxy

    WSResult -> Maybe String
isProxy :: Maybe String,
    -- | VPN provider name

    WSResult -> Maybe String
provider :: Maybe String
} 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"
    --- 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 =~ ("^PX[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 :: 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)

{-|
    The 'lookUp' function returns an WSResult containing proxy 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 :: 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.ip2proxy.com/?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

{-|
    The 'getCredit' function returns an WSResult 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 WSResult
getCredit :: WSConfig -> IO WSResult
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.ip2proxy.com/?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 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