diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,6 @@ +# 0.2.0.0 +Changed interface to normal Either String GeoResult + # 0.1.0.3 -> 0.1.0.4 - Removed lru - Switched from binary to cereal with a significant speedup diff --git a/Data/GeoIP2.hs b/Data/GeoIP2.hs --- a/Data/GeoIP2.hs +++ b/Data/GeoIP2.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -23,14 +24,17 @@ , GeoResult(..) ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), (<*>)) +#endif + import Control.Monad (unless, when) -import Data.Serialize import qualified Data.ByteString as BS import Data.Int import Data.IP (IP (..), ipv4ToIPv6) import qualified Data.Map as Map import Data.Maybe (fromMaybe, mapMaybe) +import Data.Serialize import qualified Data.Text as T import System.IO.MMap @@ -63,7 +67,7 @@ openGeoDB :: FilePath -> IO GeoDB openGeoDB geoFile = do bsmem <- mmapFileByteString geoFile Nothing - let (Right (DataMap hdr)) = decode (getHeaderBytes bsmem) + DataMap hdr <- either error return $ decode (getHeaderBytes bsmem) when (hdr .: "binary_format_major_version" /= (2 :: Int)) $ error "Unsupported database version, only v2 supported." unless (hdr .: "record_size" `elem` [24, 28, 32 :: Int]) $ error "Record size not supported." return $ GeoDB bsmem (hdr .: "database_type") @@ -74,7 +78,7 @@ -rawGeoData :: Monad m => GeoDB -> IP -> m GeoField +rawGeoData :: GeoDB -> IP -> Either String GeoField rawGeoData geodb addr = do bits <- coerceAddr offset <- fromIntegral <$> getDataOffset (geoMem geodb, geoDbNodeCount geodb, geoDbRecordSize geodb) bits @@ -85,12 +89,12 @@ -- Add caching dataAt offset = case decode (BS.drop (offset + dataSectionStart) (geoMem geodb)) of Right res -> return res - Left err -> fail err + Left err -> Left err coerceAddr | (IPv4 _) <- addr, GeoIPv4 <- geoDbAddrType geodb = return $ ipToBits addr | (IPv6 _) <- addr, GeoIPv6 <- geoDbAddrType geodb = return $ ipToBits addr | (IPv4 addrv4) <- addr, GeoIPv6 <- geoDbAddrType geodb = return $ ipToBits $ IPv6 (ipv4ToIPv6 addrv4) - | otherwise = fail "Cannot search IPv6 address in IPv4 database" + | otherwise = Left "Cannot search IPv6 address in IPv4 database" resolvePointers (DataPointer ptr) = dataAt (fromIntegral ptr) >>= resolvePointers -- TODO - limit recursion? resolvePointers (DataMap obj) = DataMap . Map.fromList <$> mapM resolveTuple (Map.toList obj) resolvePointers (DataArray arr) = DataArray <$> mapM resolvePointers arr @@ -108,12 +112,12 @@ , geoSubdivisions :: [(T.Text, T.Text)] } deriving (Show, Eq) --- | Search GeoIP database, monadic version (e.g. use with Maybe or Either) -findGeoData :: Monad m => +-- | Search GeoIP database +findGeoData :: GeoDB -- ^ Db handle -> T.Text -- ^ Language code (e.g. "en") -> IP -- ^ IP address to search - -> m GeoResult -- ^ Result, if something is found + -> Either String GeoResult -- ^ Result, if something is found findGeoData geodb lang ip = do (DataMap res) <- rawGeoData geodb ip let subdivmap = res .:? "subdivisions" :: Maybe [Map.Map GeoField GeoField] diff --git a/Data/GeoIP2/Fields.hs b/Data/GeoIP2/Fields.hs --- a/Data/GeoIP2/Fields.hs +++ b/Data/GeoIP2/Fields.hs @@ -1,10 +1,14 @@ {-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE CPP #-} module Data.GeoIP2.Fields where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) +#endif + import Control.Monad (replicateM) import Data.Serialize import Data.Bits (shift, (.&.)) diff --git a/Data/GeoIP2/SearchTree.hs b/Data/GeoIP2/SearchTree.hs --- a/Data/GeoIP2/SearchTree.hs +++ b/Data/GeoIP2/SearchTree.hs @@ -31,14 +31,14 @@ _ -> (fromIntegral (num `shift` negate recordbits), fromIntegral (num .&. ((1 `shift` recordbits) - 1))) -- | Get offset in the Data Section -getDataOffset :: Monad m => (BS.ByteString, Int64, Int) -> [Bool] -> m Int64 +getDataOffset :: (BS.ByteString, Int64, Int) -> [Bool] -> Either String Int64 getDataOffset (mem, nodeCount, recordSize) startbits = getnode startbits 0 where getnode _ index - | index == nodeCount = fail "Information for address does not exist." + | index == nodeCount = Left "Information for address does not exist." | index > nodeCount = return $ index - nodeCount - 16 - getnode [] _ = fail "IP address too short????" + getnode [] _ = Left "IP address too short????" getnode (bit:rest) index = getnode rest nextOffset where (left, right) = readNode mem recordSize index diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ GeoIP2 - library for accessing GeoIP2 database ========== +[![Build Status](https://travis-ci.org/ondrap/geoip2.svg?branch=master)](https://travis-ci.org/ondrap/geoip2) [![Hackage](https://img.shields.io/hackage/v/geoip2.svg)](https://hackage.haskell.org/package/geoip2) + GeoIP2 is a haskell binding to the MaxMind GeoIP2 database. It parses the database according to the MaxMind DB [specification](http://maxmind.github.io/MaxMind-DB), @@ -17,8 +19,8 @@ main = do geodb <- openGeoDB "GeoLite2-City.mmdb" let ip = IPv4 "23.253.242.70" - print $ (findGeoData geodb "en" ip :: Maybe GeoResult) + print $ (findGeoData geodb "en" ip) let ip2 = IPv6 "2001:4800:7817:104:be76:4eff:fe04:f608" - print $ (findGeoData geodb "en" ip2 :: Maybe GeoResult) + print $ (findGeoData geodb "en" ip2) ``` diff --git a/geoip2.cabal b/geoip2.cabal --- a/geoip2.cabal +++ b/geoip2.cabal @@ -1,5 +1,5 @@ name: geoip2 -version: 0.1.0.4 +version: 0.2.0.0 synopsis: Pure haskell interface to MaxMind GeoIP database description: GeoIP2 is a haskell binding to the MaxMind GeoIP2 database. @@ -23,7 +23,7 @@ library exposed-modules: Data.GeoIP2 other-modules: Data.GeoIP2.Fields, Data.GeoIP2.SearchTree - build-depends: base >=4.7 && <4.9 + build-depends: base >=4.7 && <4.10 , mmap , bytestring , cereal @@ -32,4 +32,4 @@ , iproute(>=1.4.0) , reinterpret-cast default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -fwarn-incomplete-uni-patterns