{-|
Module      : IP2Proxy
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 LITE BIN databases are available for free at http://lite.ip2location.com/
-}
module IP2Proxy (Meta, IP2ProxyRecord(..), getModuleVersion, getPackageVersion, getDatabaseVersion, open, getAll, getCountryShort, getCountryLong, getRegion, getCity, getISP, getProxyType, getDomain, getUsageType, getASN, getAS, getLastSeen, getThreat, getProvider, isProxy) where

import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS8
import Data.Word
import Data.Bits
import Data.Binary.Get
import Data.IP
import Control.Exception
import System.Exit

-- | Contains proxy results.

data IP2ProxyRecord = IP2ProxyRecord {
    -- | Country code

    IP2ProxyRecord -> String
country_short :: String,
    -- | Country name

    IP2ProxyRecord -> String
country_long :: String,
    -- | Region name

    IP2ProxyRecord -> String
region :: String,
    -- | City name

    IP2ProxyRecord -> String
city :: String,
    -- | ISP name

    IP2ProxyRecord -> String
isp :: String,
    -- | Proxy type

    IP2ProxyRecord -> String
proxy_type :: String,
    -- | Domain

    IP2ProxyRecord -> String
domain :: String,
    -- | Usage type

    IP2ProxyRecord -> String
usage_type :: String,
    -- | ASN

    IP2ProxyRecord -> String
asn :: String,
    -- | AS

    IP2ProxyRecord -> String
as :: String,
    -- | Last seen

    IP2ProxyRecord -> String
last_seen :: String,
    -- | Threat

    IP2ProxyRecord -> String
threat :: String,
    -- | Provider

    IP2ProxyRecord -> String
provider :: String,
    -- | Is proxy

    IP2ProxyRecord -> Int
is_proxy :: Int
} deriving (Int -> IP2ProxyRecord -> ShowS
[IP2ProxyRecord] -> ShowS
IP2ProxyRecord -> String
(Int -> IP2ProxyRecord -> ShowS)
-> (IP2ProxyRecord -> String)
-> ([IP2ProxyRecord] -> ShowS)
-> Show IP2ProxyRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IP2ProxyRecord] -> ShowS
$cshowList :: [IP2ProxyRecord] -> ShowS
show :: IP2ProxyRecord -> String
$cshow :: IP2ProxyRecord -> String
showsPrec :: Int -> IP2ProxyRecord -> ShowS
$cshowsPrec :: Int -> IP2ProxyRecord -> ShowS
Show)

-- | Contains the BIN database file metadata.

data Meta = Meta {
    -- | Database type

    Meta -> Int
databasetype :: Int,
    -- | Number of columns

    Meta -> Int
databasecolumn :: Int,
    -- | Database year

    Meta -> Int
databaseyear :: Int,
    -- | Database month

    Meta -> Int
databasemonth :: Int,
    -- | Database day

    Meta -> Int
databaseday :: Int,
    -- | IPv4 data count

    Meta -> Int
ipv4databasecount :: Int,
    -- | IPv4 data base address

    Meta -> Int
ipv4databaseaddr :: Int,
    -- | IPv6 data count

    Meta -> Int
ipv6databasecount :: Int,
    -- | IPv6 data base address

    Meta -> Int
ipv6databaseaddr :: Int,
    -- | IPv4 index base address

    Meta -> Int
ipv4indexbaseaddr :: Int,
    -- | IPv6 index base address

    Meta -> Int
ipv6indexbaseaddr :: Int,
    -- | IPv4 column size

    Meta -> Int
ipv4columnsize :: Int,
    -- | IPv6 column size

    Meta -> Int
ipv6columnsize :: Int,
    -- | Wrong BIN

    Meta -> Int
wrongbin :: Int
} deriving (Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
(Int -> Meta -> ShowS)
-> (Meta -> String) -> ([Meta] -> ShowS) -> Show Meta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meta] -> ShowS
$cshowList :: [Meta] -> ShowS
show :: Meta -> String
$cshow :: Meta -> String
showsPrec :: Int -> Meta -> ShowS
$cshowsPrec :: Int -> Meta -> ShowS
Show)

getMeta :: Get Meta
getMeta = do
    Word8
databasetype <- Get Word8
getWord8
    Word8
databasecolumn <- Get Word8
getWord8
    Word8
databaseyear <- Get Word8
getWord8
    Word8
databasemonth <- Get Word8
getWord8
    Word8
databaseday <- Get Word8
getWord8
    Word32
ipv4databasecount <- Get Word32
getWord32le
    Word32
ipv4databaseaddr <- Get Word32
getWord32le
    Word32
ipv6databasecount <- Get Word32
getWord32le
    Word32
ipv6databaseaddr <- Get Word32
getWord32le
    Word32
ipv4indexbaseaddr <- Get Word32
getWord32le
    Word32
ipv6indexbaseaddr <- Get Word32
getWord32le
    Word8
productcode <- Get Word8
getWord8
    Word8
producttype <- Get Word8
getWord8
    Word32
filesize <- Get Word32
getWord32le
    
    -- check if is correct BIN (should be 2 for IP2Proxy BIN file), also checking for zipped file (PK being the first 2 chars)

    let wrongbin :: Int
wrongbin = if (Word8
productcode Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
2 Bool -> Bool -> Bool
&& Word8
databaseyear Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
21) Bool -> Bool -> Bool
|| (Word8
databasetype Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
80 Bool -> Bool -> Bool
&& Word8
databasecolumn Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
75)
        then do
            Int
1
        else do
            Int
0

    let ipv4columnsize :: Int
ipv4columnsize = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
databasecolumn Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2 -- 4 bytes each column

    let ipv6columnsize :: Int
ipv6columnsize = Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
databasecolumn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) -- 4 bytes each column, except IPFrom column which is 16 bytes

    let meta :: Meta
meta = Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Meta
Meta (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
databasetype) (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
databasecolumn) (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
databaseyear) (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
databasemonth) (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
databaseday) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ipv4databasecount) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ipv4databaseaddr) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ipv6databasecount) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ipv6databaseaddr) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ipv4indexbaseaddr) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ipv6indexbaseaddr) Int
ipv4columnsize Int
ipv6columnsize Int
wrongbin
    Meta -> Get Meta
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
meta

{-|
    The 'getModuleVersion' function returns a string containing the module version.
-}
getModuleVersion :: String
getModuleVersion :: String
getModuleVersion = String
"3.1.0"

{-|
    The 'getPackageVersion' function returns a string containing the package version.
    It takes 1 argument; the metadata from 'open' function (Meta record).
-}
getPackageVersion :: Meta -> String
getPackageVersion :: Meta -> String
getPackageVersion Meta
meta = (Int -> String
forall a. Show a => a -> String
show (Meta -> Int
databasetype Meta
meta))

{-|
    The 'getDatabaseVersion' function returns a string containing the database version.
    It takes 1 argument; the metadata from 'open' function (Meta record).
-}
getDatabaseVersion :: Meta -> String
getDatabaseVersion :: Meta -> String
getDatabaseVersion Meta
meta = String
"20" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Meta -> Int
databaseyear Meta
meta)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Meta -> Int
databasemonth Meta
meta)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Meta -> Int
databaseday Meta
meta))

ipToOcts :: IP -> [Int]
ipToOcts :: IP -> [Int]
ipToOcts (IPv4 IPv4
ip) = IPv4 -> [Int]
fromIPv4 IPv4
ip
ipToOcts (IPv6 IPv6
ip) = IPv6 -> [Int]
fromIPv6b IPv6
ip

ipToInteger :: IP -> Integer
ipToInteger :: IP -> Integer
ipToInteger = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer) -> (IP -> [Integer]) -> IP -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, Int) -> Integer) -> [(Integer, Int)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
n,Int
o) -> Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
o Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
256 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
n) ([(Integer, Int)] -> [Integer])
-> (IP -> [(Integer, Int)]) -> IP -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Int] -> [(Integer, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([Int] -> [(Integer, Int)])
-> (IP -> [Int]) -> IP -> [(Integer, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> (IP -> [Int]) -> IP -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IP -> [Int]
ipToOcts

ipStringToInteger :: String -> Integer
ipStringToInteger :: String -> Integer
ipStringToInteger = IP -> Integer
ipToInteger (IP -> Integer) -> (String -> IP) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IP
forall a. Read a => String -> a
read

{-|
    The 'open' function returns the Meta record containing metadata from the BIN database file.
    It takes one argument, of type 'String', which is the path to the BIN database file.
-}
open :: String -> IO Meta
open :: String -> IO Meta
open String
myfile = do
    ByteString
contents <- String -> IO ByteString
BS.readFile String
myfile
    let stuff :: Meta
stuff = Get Meta -> ByteString -> Meta
forall a. Get a -> ByteString -> a
runGet Get Meta
getMeta ByteString
contents
    let iswrong :: String
iswrong = (Int -> String
forall a. Show a => a -> String
show (Meta -> Int
wrongbin Meta
stuff))
    if String
iswrong String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1"
        then do
            String -> IO Meta
forall a. String -> IO a
die(ShowS
forall a. Show a => a -> String
show String
"Incorrect IP2Proxy BIN file format. Please make sure that you are using the latest IP2Proxy BIN file.")
        else do
            Meta -> IO Meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> IO Meta) -> Meta -> IO Meta
forall a b. (a -> b) -> a -> b
$ Meta
stuff

readuint32 :: BS.ByteString -> Int -> Int
readuint32 :: ByteString -> Int -> Int
readuint32 ByteString
contents Int
startpos = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
runGet Get Word32
getWord32le (Int64 -> ByteString -> ByteString
BS.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startpos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) ByteString
contents))

readuint32row :: BS.ByteString -> Int -> Int
readuint32row :: ByteString -> Int -> Int
readuint32row ByteString
row Int
startpos = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
runGet Get Word32
getWord32le (Int64 -> ByteString -> ByteString
BS.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startpos) ByteString
row))

getuint128 :: Get Integer
getuint128 = do
    Word64
uint64A <- Get Word64
getWord64le
    Word64
uint64B <- Get Word64
getWord64le
    let uint128 :: Integer
uint128 = (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
uint64A) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ ((Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
uint64B) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`rotateL` Int
64)
    Integer -> Get Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
uint128

readuint128 :: BS.ByteString -> Int -> Integer
readuint128 :: ByteString -> Int -> Integer
readuint128 ByteString
contents Int
startpos = Get Integer -> ByteString -> Integer
forall a. Get a -> ByteString -> a
runGet Get Integer
getuint128 (Int64 -> ByteString -> ByteString
BS.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startpos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) ByteString
contents)

readstr :: BS.ByteString -> Int -> String
readstr :: ByteString -> Int -> String
readstr ByteString
contents Int
startpos = do
    let len :: Word8
len = Get Word8 -> ByteString -> Word8
forall a. Get a -> ByteString -> a
runGet Get Word8
getWord8 (Int64 -> ByteString -> ByteString
BS.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startpos) ByteString
contents)
    Char
str <- ByteString -> String
BS8.unpack (Int64 -> ByteString -> ByteString
BS.take (Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len) (Int64 -> ByteString -> ByteString
BS.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startpos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) ByteString
contents))
    Char -> String
forall (m :: * -> *) a. Monad m => a -> m a
return Char
str

readcolcountryrow :: BS.ByteString -> BS.ByteString -> Int -> [Int] -> (String, String)
readcolcountryrow :: ByteString -> ByteString -> Int -> [Int] -> (String, String)
readcolcountryrow ByteString
contents ByteString
row Int
dbtype [Int]
col = do
    let x :: String
x = String
"NOT SUPPORTED"
    let [Int
colpos] = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
col)
    
    if Int
colpos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then do
            (String
x, String
x)
        else do
            let coloffset :: Int
coloffset = (Int
colpos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2
            let x0 :: Int
x0 = ByteString -> Int -> Int
readuint32row ByteString
row Int
coloffset
            let x1 :: String
x1 = ByteString -> Int -> String
readstr ByteString
contents  Int
x0
            let x2 :: String
x2 = ByteString -> Int -> String
readstr ByteString
contents (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
            (String
x1, String
x2)

readcolstringrow :: BS.ByteString -> BS.ByteString -> Int -> [Int] -> String
readcolstringrow :: ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
col = do
    let [Int
colpos] = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
col)
    
    if Int
colpos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then do
            String
"NOT SUPPORTED"
        else do
            let coloffset :: Int
coloffset = (Int
colpos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2
            ByteString -> Int -> String
readstr ByteString
contents (ByteString -> Int -> Int
readuint32row ByteString
row Int
coloffset)

countif :: (a -> Bool) -> [a] -> Int
countif :: (a -> Bool) -> [a] -> Int
countif a -> Bool
f = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
f 

readrecord :: BS.ByteString -> Int -> Int -> Int -> IP2ProxyRecord
readrecord :: ByteString -> Int -> Int -> Int -> IP2ProxyRecord
readrecord ByteString
contents Int
dbtype Int
rowoffset Int
mode = do
    let country_position :: [Int]
country_position = [Int
0, Int
2, Int
3, Int
3, Int
3, Int
3, Int
3, Int
3, Int
3, Int
3, Int
3, Int
3]
    let region_position :: [Int]
region_position = [Int
0, Int
0, Int
0, Int
4, Int
4, Int
4, Int
4, Int
4, Int
4, Int
4, Int
4, Int
4]
    let city_position :: [Int]
city_position = [Int
0, Int
0, Int
0, Int
5, Int
5, Int
5, Int
5, Int
5, Int
5, Int
5, Int
5, Int
5]
    let isp_position :: [Int]
isp_position = [Int
0, Int
0, Int
0, Int
0, Int
6, Int
6, Int
6, Int
6, Int
6, Int
6, Int
6, Int
6]
    let proxytype_position :: [Int]
proxytype_position = [Int
0, Int
0, Int
2, Int
2, Int
2, Int
2, Int
2, Int
2, Int
2, Int
2, Int
2, Int
2]
    let domain_position :: [Int]
domain_position = [Int
0, Int
0, Int
0, Int
0, Int
0, Int
7, Int
7, Int
7, Int
7, Int
7, Int
7, Int
7]
    let usagetype_position :: [Int]
usagetype_position = [Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
8, Int
8, Int
8, Int
8, Int
8, Int
8]
    let asn_position :: [Int]
asn_position = [Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
9, Int
9, Int
9, Int
9, Int
9]
    let as_position :: [Int]
as_position = [Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
10, Int
10, Int
10, Int
10, Int
10]
    let lastseen_position :: [Int]
lastseen_position = [Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
11, Int
11, Int
11, Int
11]
    let threat_position :: [Int]
threat_position = [Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
12, Int
12, Int
12]
    let provider_position :: [Int]
provider_position = [Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
13]
     
    let countryshort_field :: Int
countryshort_field = Int
1
    let countrylong_field :: Int
countrylong_field = Int
2
    let region_field :: Int
region_field = Int
4
    let city_field :: Int
city_field = Int
8
    let isp_field :: Int
isp_field = Int
16
    let proxytype_field :: Int
proxytype_field = Int
32
    let isproxy_field :: Int
isproxy_field = Int
64
    let domain_field :: Int
domain_field = Int
128
    let usagetype_field :: Int
usagetype_field = Int
256
    let asn_field :: Int
asn_field = Int
512
    let as_field :: Int
as_field = Int
1024
    let lastseen_field :: Int
lastseen_field = Int
2048
    let threat_field :: Int
threat_field = Int
4096
    let provider_field :: Int
provider_field = Int
8192
    
    let allcols :: [Int]
allcols = (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
country_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
region_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
city_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
isp_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
proxytype_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
domain_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
usagetype_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
asn_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
as_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
lastseen_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
threat_position)) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
dbtype [Int]
provider_position))
    let cols :: Int
cols = ((Int -> Bool) -> [Int] -> Int
forall a. (a -> Bool) -> [a] -> Int
countif (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) [Int]
allcols) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2
    let row :: ByteString
row = Int64 -> ByteString -> ByteString
BS.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols) (Int64 -> ByteString -> ByteString
BS.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rowoffset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) ByteString
contents)
    
    let proxy_type :: String
proxy_type = if ((Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
proxytype_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Bool -> Bool -> Bool
|| ((Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
isproxy_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
proxytype_position
        else String
""
    
    let (String
country_short, String
country_long) = if ((Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
countryshort_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Bool -> Bool -> Bool
|| ((Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
countrylong_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Bool -> Bool -> Bool
|| ((Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
isproxy_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
        then ByteString -> ByteString -> Int -> [Int] -> (String, String)
readcolcountryrow ByteString
contents ByteString
row Int
dbtype [Int]
country_position
        else (String
"", String
"")
    
    let region :: String
region = if (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
region_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
region_position
        else String
""
    
    let city :: String
city = if (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
city_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
city_position
        else String
""
    
    let isp :: String
isp = if (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
isp_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
isp_position
        else String
""
    
    let domain :: String
domain = if (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
domain_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
domain_position
        else String
""
    
    let usage_type :: String
usage_type = if (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
usagetype_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
usagetype_position
        else String
""
    
    let asn :: String
asn = if (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
asn_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
asn_position
        else String
""
    
    let as :: String
as = if (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
as_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
as_position
        else String
""
    
    let last_seen :: String
last_seen = if (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
lastseen_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
lastseen_position
        else String
""
    
    let threat :: String
threat = if (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
threat_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
threat_position
        else String
""
    
    let provider :: String
provider = if (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.&.) Int
mode Int
provider_field) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ByteString -> ByteString -> Int -> [Int] -> String
readcolstringrow ByteString
contents ByteString
row Int
dbtype [Int]
provider_position
        else String
""
    
    let is_proxy :: Int
is_proxy = if (String
country_short String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-") Bool -> Bool -> Bool
|| (String
proxy_type String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-")
        then Int
0
        else if (String
proxy_type String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"DCH") Bool -> Bool -> Bool
|| (String
proxy_type String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"SES")
            then Int
2
            else Int
1
    
    String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> Int
-> IP2ProxyRecord
IP2ProxyRecord String
country_short String
country_long String
region String
city String
isp String
proxy_type String
domain String
usage_type String
asn String
as String
last_seen String
threat String
provider Int
is_proxy

searchtree :: BS.ByteString -> Integer -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> IP2ProxyRecord
searchtree :: ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
searchtree ByteString
contents Integer
ipnum Int
dbtype Int
low Int
high Int
baseaddr Int
colsize Int
iptype Int
mode = do
    if Int
low Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
high
        then do
            let mid :: Int
mid = ((Int
low Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
high) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
            let rowoffset :: Int
rowoffset = Int
baseaddr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
colsize)
            let rowoffset2 :: Int
rowoffset2 = Int
rowoffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
colsize
            
            let ipfrom :: Integer
ipfrom = if (Int
iptype Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4)
                then Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Int
readuint32 ByteString
contents Int
rowoffset
                else ByteString -> Int -> Integer
readuint128 ByteString
contents Int
rowoffset
            
            let ipto :: Integer
ipto = if (Int
iptype Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4)
                then Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Int
readuint32 ByteString
contents Int
rowoffset2
                else ByteString -> Int -> Integer
readuint128 ByteString
contents Int
rowoffset2
            
            if Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
ipfrom Bool -> Bool -> Bool
&& Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
ipto
                then do
                    if Int
iptype Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
                        then
                            ByteString -> Int -> Int -> Int -> IP2ProxyRecord
readrecord ByteString
contents Int
dbtype (Int
rowoffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
mode
                        else
                            ByteString -> Int -> Int -> Int -> IP2ProxyRecord
readrecord ByteString
contents Int
dbtype (Int
rowoffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16) Int
mode
                else if Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
ipfrom
                    then
                        ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
searchtree ByteString
contents Integer
ipnum Int
dbtype Int
low (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
baseaddr Int
colsize Int
iptype Int
mode
                    else
                        ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
searchtree ByteString
contents Integer
ipnum Int
dbtype (Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
high Int
baseaddr Int
colsize Int
iptype Int
mode
        else do
            let x :: String
x = String
"INVALID IP ADDRESS"
            String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> Int
-> IP2ProxyRecord
IP2ProxyRecord String
x String
x String
x String
x String
x String
x String
x String
x String
x String
x String
x String
x String
x (-Int
1)
        
search4 :: BS.ByteString -> Integer -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> IP2ProxyRecord
search4 :: ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
search4 ByteString
contents Integer
ipnum Int
dbtype Int
low Int
high Int
baseaddr Int
indexbaseaddr Int
colsize Int
mode = do
    if Int
indexbaseaddr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        then do
            let indexpos :: Int
indexpos = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (((Integer
ipnum Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`rotateR` Int
16) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`rotateL` Int
3) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
indexbaseaddr))
            let low2 :: Int
low2 = ByteString -> Int -> Int
readuint32 ByteString
contents Int
indexpos
            let high2 :: Int
high2 = ByteString -> Int -> Int
readuint32 ByteString
contents (Int
indexpos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
            ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
searchtree ByteString
contents Integer
ipnum Int
dbtype Int
low2 Int
high2 Int
baseaddr Int
colsize Int
4 Int
mode
        else
            ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
searchtree ByteString
contents Integer
ipnum Int
dbtype Int
low Int
high Int
baseaddr Int
colsize Int
4 Int
mode

search6 :: BS.ByteString -> Integer -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> IP2ProxyRecord
search6 :: ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
search6 ByteString
contents Integer
ipnum Int
dbtype Int
low Int
high Int
baseaddr Int
indexbaseaddr Int
colsize Int
mode = do
    if Int
indexbaseaddr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        then do
            let indexpos :: Int
indexpos = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (((Integer
ipnum Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`rotateR` Int
112) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`rotateL` Int
3) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
indexbaseaddr))
            let low2 :: Int
low2 = ByteString -> Int -> Int
readuint32 ByteString
contents Int
indexpos
            let high2 :: Int
high2 = ByteString -> Int -> Int
readuint32 ByteString
contents (Int
indexpos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
            ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
searchtree ByteString
contents Integer
ipnum Int
dbtype Int
low2 Int
high2 Int
baseaddr Int
colsize Int
6 Int
mode
        else
            ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
searchtree ByteString
contents Integer
ipnum Int
dbtype Int
low Int
high Int
baseaddr Int
colsize Int
6 Int
mode

tryfirst :: String -> IO Integer
tryfirst String
myIP = do
    Either SomeException Integer
result <- IO Integer -> IO (Either SomeException Integer)
forall e a. Exception e => IO a -> IO (Either e a)
try (Integer -> IO Integer
forall a. a -> IO a
evaluate (String -> Integer
ipStringToInteger String
myIP)) :: IO (Either SomeException Integer)
    case Either SomeException Integer
result of
        Left SomeException
ex -> Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2)
        Right Integer
val -> Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
val

{-|
    The 'getAll' function returns an IP2ProxyRecord containing proxy data for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getAll :: String -> Meta -> String -> IO IP2ProxyRecord
getAll :: String -> Meta -> String -> IO IP2ProxyRecord
getAll String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
16383
    IP2ProxyRecord -> IO IP2ProxyRecord
forall (m :: * -> *) a. Monad m => a -> m a
return IP2ProxyRecord
result

{-|
    The 'getCountryShort' function returns the country code for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getCountryShort :: String -> Meta -> String -> IO String
getCountryShort :: String -> Meta -> String -> IO String
getCountryShort String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
1
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
country_short IP2ProxyRecord
result))

{-|
    The 'getCountryLong' function returns the country name for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getCountryLong :: String -> Meta -> String -> IO String
getCountryLong :: String -> Meta -> String -> IO String
getCountryLong String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
2
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
country_long IP2ProxyRecord
result))

{-|
    The 'getRegion' function returns the region name for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getRegion :: String -> Meta -> String -> IO String
getRegion :: String -> Meta -> String -> IO String
getRegion String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
4
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
region IP2ProxyRecord
result))

{-|
    The 'getCity' function returns the city name for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getCity :: String -> Meta -> String -> IO String
getCity :: String -> Meta -> String -> IO String
getCity String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
8
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
city IP2ProxyRecord
result))

{-|
    The 'getISP' function returns the ISP name for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getISP :: String -> Meta -> String -> IO String
getISP :: String -> Meta -> String -> IO String
getISP String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
16
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
isp IP2ProxyRecord
result))

{-|
    The 'getProxyType' function returns the proxy type for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getProxyType :: String -> Meta -> String -> IO String
getProxyType :: String -> Meta -> String -> IO String
getProxyType String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
32
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
proxy_type IP2ProxyRecord
result))

{-|
    The 'getDomain' function returns the domain name for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getDomain :: String -> Meta -> String -> IO String
getDomain :: String -> Meta -> String -> IO String
getDomain String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
128
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
domain IP2ProxyRecord
result))

{-|
    The 'getUsageType' function returns the usage type for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getUsageType :: String -> Meta -> String -> IO String
getUsageType :: String -> Meta -> String -> IO String
getUsageType String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
256
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
usage_type IP2ProxyRecord
result))

{-|
    The 'getASN' function returns the autonomous system number for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getASN :: String -> Meta -> String -> IO String
getASN :: String -> Meta -> String -> IO String
getASN String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
512
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
asn IP2ProxyRecord
result))

{-|
    The 'getAS' function returns the autonomous system name for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getAS :: String -> Meta -> String -> IO String
getAS :: String -> Meta -> String -> IO String
getAS String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
1024
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
as IP2ProxyRecord
result))

{-|
    The 'getLastSeen' function returns the number of days last seen for an IP address.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getLastSeen :: String -> Meta -> String -> IO String
getLastSeen :: String -> Meta -> String -> IO String
getLastSeen String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
2048
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
last_seen IP2ProxyRecord
result))

{-|
    The 'getThreat' function returns the threat type of the proxy.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getThreat :: String -> Meta -> String -> IO String
getThreat :: String -> Meta -> String -> IO String
getThreat String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
4096
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
threat IP2ProxyRecord
result))

{-|
    The 'getProvider' function returns the provider of the proxy.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
getProvider :: String -> Meta -> String -> IO String
getProvider :: String -> Meta -> String -> IO String
getProvider String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
8192
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
forall a. Show a => a -> String
show (IP2ProxyRecord -> String
provider IP2ProxyRecord
result))

{-|
    The 'isProxy' function returns 0 if IP is not a proxy, 1 if is a proxy and not data center IP, 2 if is a proxy and is a data center IP, -1 if error.
    It takes 3 arguments; the BIN database file path (String), the metadata from 'open' function (Meta record) & either IPv4 or IPv6 address (String).
-}
isProxy :: String -> Meta -> String -> IO String
isProxy :: String -> Meta -> String -> IO String
isProxy String
myfile Meta
meta String
myip = do
    IP2ProxyRecord
result <- String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
64
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> String
forall a. Show a => a -> String
show (IP2ProxyRecord -> Int
is_proxy IP2ProxyRecord
result))

doQuery :: String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery :: String -> Meta -> String -> Int -> IO IP2ProxyRecord
doQuery String
myfile Meta
meta String
myip Int
mode = do
    ByteString
contents <- String -> IO ByteString
BS.readFile String
myfile
    let fromV4Mapped :: Integer
fromV4Mapped = Integer
281470681743360
    let toV4Mapped :: Integer
toV4Mapped = Integer
281474976710655
    let fromV4Compatible :: Integer
fromV4Compatible = Integer
0
    let toV4Compatible :: Integer
toV4Compatible = Integer
4294967295
    let from6To4 :: Integer
from6To4 = Integer
42545680458834377588178886921629466624
    let to6To4 :: Integer
to6To4 = Integer
42550872755692912415807417417958686719
    let fromTeredo :: Integer
fromTeredo = Integer
42540488161975842760550356425300246528
    let toTeredo :: Integer
toTeredo = Integer
42540488241204005274814694018844196863
    let last32Bits :: Integer
last32Bits = Integer
4294967295
    
    Integer
ipnum <- String -> IO Integer
tryfirst String
myip
    if Integer
ipnum Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== -Integer
1
        then do
            let x :: String
x = String
"INVALID IP ADDRESS"
            IP2ProxyRecord -> IO IP2ProxyRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (IP2ProxyRecord -> IO IP2ProxyRecord)
-> IP2ProxyRecord -> IO IP2ProxyRecord
forall a b. (a -> b) -> a -> b
$ String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> Int
-> IP2ProxyRecord
IP2ProxyRecord String
x String
x String
x String
x String
x String
x String
x String
x String
x String
x String
x String
x String
x (-Int
1)
        else if Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
fromV4Mapped Bool -> Bool -> Bool
&& Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
toV4Mapped
            then do
                IP2ProxyRecord -> IO IP2ProxyRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (IP2ProxyRecord -> IO IP2ProxyRecord)
-> IP2ProxyRecord -> IO IP2ProxyRecord
forall a b. (a -> b) -> a -> b
$ ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
search4 ByteString
contents (Integer
ipnum Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
fromV4Mapped)) (Meta -> Int
databasetype Meta
meta) Int
0 (Meta -> Int
ipv4databasecount Meta
meta) (Meta -> Int
ipv4databaseaddr Meta
meta) (Meta -> Int
ipv4indexbaseaddr Meta
meta) (Meta -> Int
ipv4columnsize Meta
meta) Int
mode
            else if Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
from6To4 Bool -> Bool -> Bool
&& Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
to6To4
                then do
                    IP2ProxyRecord -> IO IP2ProxyRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (IP2ProxyRecord -> IO IP2ProxyRecord)
-> IP2ProxyRecord -> IO IP2ProxyRecord
forall a b. (a -> b) -> a -> b
$ ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
search4 ByteString
contents ((Integer
ipnum Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`rotateR` Int
80) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
last32Bits) (Meta -> Int
databasetype Meta
meta) Int
0 (Meta -> Int
ipv4databasecount Meta
meta) (Meta -> Int
ipv4databaseaddr Meta
meta) (Meta -> Int
ipv4indexbaseaddr Meta
meta) (Meta -> Int
ipv4columnsize Meta
meta) Int
mode
                else if Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
fromTeredo Bool -> Bool -> Bool
&& Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
toTeredo
                    then do
                        IP2ProxyRecord -> IO IP2ProxyRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (IP2ProxyRecord -> IO IP2ProxyRecord)
-> IP2ProxyRecord -> IO IP2ProxyRecord
forall a b. (a -> b) -> a -> b
$ ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
search4 ByteString
contents ((Integer -> Integer
forall a. Bits a => a -> a
complement Integer
ipnum) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
last32Bits) (Meta -> Int
databasetype Meta
meta) Int
0 (Meta -> Int
ipv4databasecount Meta
meta) (Meta -> Int
ipv4databaseaddr Meta
meta) (Meta -> Int
ipv4indexbaseaddr Meta
meta) (Meta -> Int
ipv4columnsize Meta
meta) Int
mode
                    else if Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
fromV4Compatible Bool -> Bool -> Bool
&& Integer
ipnum Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
toV4Compatible
                        then do
                            IP2ProxyRecord -> IO IP2ProxyRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (IP2ProxyRecord -> IO IP2ProxyRecord)
-> IP2ProxyRecord -> IO IP2ProxyRecord
forall a b. (a -> b) -> a -> b
$ ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
search4 ByteString
contents Integer
ipnum (Meta -> Int
databasetype Meta
meta) Int
0 (Meta -> Int
ipv4databasecount Meta
meta) (Meta -> Int
ipv4databaseaddr Meta
meta) (Meta -> Int
ipv4indexbaseaddr Meta
meta) (Meta -> Int
ipv4columnsize Meta
meta) Int
mode
                        else do
                            IP2ProxyRecord -> IO IP2ProxyRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (IP2ProxyRecord -> IO IP2ProxyRecord)
-> IP2ProxyRecord -> IO IP2ProxyRecord
forall a b. (a -> b) -> a -> b
$ ByteString
-> Integer
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> IP2ProxyRecord
search6 ByteString
contents Integer
ipnum (Meta -> Int
databasetype Meta
meta) Int
0 (Meta -> Int
ipv6databasecount Meta
meta) (Meta -> Int
ipv6databaseaddr Meta
meta) (Meta -> Int
ipv6indexbaseaddr Meta
meta) (Meta -> Int
ipv6columnsize Meta
meta) Int
mode