diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,9 +1,13 @@ +# 0.1.0.3 -> 0.1.0.4 +- Removed lru +- Switched from binary to cereal with a significant speedup + # 0.1.0.2 -> 0.1.0.3 - Changed bytestring-mmap to mmap - Add LRU caching to improve performance (10000 entries are cached) # 0.1.0.1 -> 0.1.0.2 - + - GHC-7.10 compatibiliy - Add Changelog.md - List Changelog.md and README.md in cabal's extra-source-files diff --git a/Data/GeoIP2.hs b/Data/GeoIP2.hs --- a/Data/GeoIP2.hs +++ b/Data/GeoIP2.hs @@ -25,17 +25,14 @@ import Control.Applicative ((<$>), (<*>)) import Control.Monad (unless, when) -import Data.Binary +import Data.Serialize import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BL -import qualified Data.Cache.LRU.IO as LRU import Data.Int import Data.IP (IP (..), ipv4ToIPv6) import qualified Data.Map as Map import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Text as T import System.IO.MMap -import System.IO.Unsafe (unsafePerformIO) import Data.GeoIP2.Fields import Data.GeoIP2.SearchTree @@ -46,7 +43,6 @@ -- | Handle for search operations data GeoDB = GeoDB { geoMem :: BS.ByteString - , geoLru :: LRU.AtomicLRU Int GeoField , geoDbType :: T.Text -- ^ String that indicates the structure of each data record associated with an IP address , geoDbLanguages :: [T.Text] -- ^ Languages supported in database , geoDbNodeCount :: Int64 @@ -67,11 +63,10 @@ openGeoDB :: FilePath -> IO GeoDB openGeoDB geoFile = do bsmem <- mmapFileByteString geoFile Nothing - let (DataMap hdr) = decode (BL.fromStrict $ getHeaderBytes bsmem) + let (Right (DataMap hdr)) = 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." - lru <- LRU.newAtomicLRU (Just 10000) - return $ GeoDB bsmem lru (hdr .: "database_type") + return $ GeoDB bsmem (hdr .: "database_type") (fromMaybe [] $ hdr .:? "languages") (hdr .: "node_count") (hdr .: "record_size") (if (hdr .: "ip_version") == (4 :: Int) then GeoIPv4 else GeoIPv6) @@ -88,20 +83,9 @@ where dataSectionStart = (geoDbRecordSize geodb `div` 4) * fromIntegral (geoDbNodeCount geodb) + 16 -- Add caching - dataAt offset = case lruget offset of - Right res -> return res - Left err -> fail err - lruget offset = unsafePerformIO $ do - cached <- LRU.lookup offset (geoLru geodb) - case cached of - Just result -> return (Right result) - Nothing -> do - let decres = decodeOrFail (BL.fromStrict $ BS.drop (offset + dataSectionStart) (geoMem geodb)) - case decres of - Left (_,_,err) -> return (Left err) - Right (_,_,result) -> do - LRU.insert offset result (geoLru geodb) - return (Right result) + dataAt offset = case decode (BS.drop (offset + dataSectionStart) (geoMem geodb)) of + Right res -> return res + Left err -> fail err coerceAddr | (IPv4 _) <- addr, GeoIPv4 <- geoDbAddrType geodb = return $ ipToBits addr | (IPv6 _) <- addr, GeoIPv6 <- geoDbAddrType geodb = return $ ipToBits addr diff --git a/Data/GeoIP2/Fields.hs b/Data/GeoIP2/Fields.hs --- a/Data/GeoIP2/Fields.hs +++ b/Data/GeoIP2/Fields.hs @@ -6,8 +6,7 @@ import Control.Applicative ((<$>)) import Control.Monad (replicateM) -import Data.Binary -import Data.Binary.Get +import Data.Serialize import Data.Bits (shift, (.&.)) import qualified Data.ByteString as BS import Data.Int @@ -16,11 +15,11 @@ import Data.ReinterpretCast (wordToDouble) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) -import Data.Word () +import Data.Word data GeoField = DataPointer Int64 - | DataString T.Text + | DataString !T.Text | DataDouble Double | DataInt Int64 | DataWord Word64 @@ -77,10 +76,10 @@ -- | Parse number of given length parseNumber :: Num a => Int64 -> Get a parseNumber fsize = do - bytes <- getByteString (fromIntegral fsize) + bytes <- getBytes (fromIntegral fsize) return $ BS.foldl' (\acc new -> fromIntegral new + 256 * acc) 0 bytes -instance Binary GeoField where +instance Serialize GeoField where put = undefined get = do control <- getWord8 @@ -104,7 +103,7 @@ case ftype of 1 -> return $ DataPointer fsize - 2 -> DataString . decodeUtf8 <$> getByteString (fromIntegral fsize) + 2 -> DataString . decodeUtf8 <$> getBytes (fromIntegral fsize) 3 -> DataDouble . wordToDouble <$> get 5 -> DataWord <$> parseNumber fsize 6 -> DataWord <$> parseNumber fsize @@ -119,5 +118,5 @@ 11 -> DataArray <$> replicateM (fromIntegral fsize) get 14 -> return $ DataBool (fsize == 0) _ -> do - _ <- getByteString (fromIntegral fsize) + _ <- getBytes (fromIntegral fsize) return $ DataUnknown ftype fsize diff --git a/Data/GeoIP2/SearchTree.hs b/Data/GeoIP2/SearchTree.hs --- a/Data/GeoIP2/SearchTree.hs +++ b/Data/GeoIP2/SearchTree.hs @@ -2,11 +2,11 @@ module Data.GeoIP2.SearchTree where -import Data.Binary -import Data.Bits (shift, testBit, (.&.), (.|.)) -import qualified Data.ByteString as BS +import Data.Bits (shift, testBit, (.&.), (.|.)) +import qualified Data.ByteString as BS import Data.Int -import Data.IP (IP (..), fromIPv4, fromIPv6b) +import Data.IP (IP (..), fromIPv4, fromIPv6b) +import Data.Word -- | Convert byte to list of bits starting from the most significant one byteToBits :: Int -> [Bool] diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ GeoIP2 is a haskell binding to the MaxMind GeoIP2 database. It parses the database according to the MaxMind DB -specification, +[specification](http://maxmind.github.io/MaxMind-DB), version 2 of the specification is supported. The free geolite2 database can be downloaded at http://dev.maxmind.com/geoip/geoip2/geolite2/. diff --git a/geoip2.cabal b/geoip2.cabal --- a/geoip2.cabal +++ b/geoip2.cabal @@ -1,5 +1,5 @@ name: geoip2 -version: 0.1.0.3 +version: 0.1.0.4 synopsis: Pure haskell interface to MaxMind GeoIP database description: GeoIP2 is a haskell binding to the MaxMind GeoIP2 database. @@ -26,11 +26,10 @@ build-depends: base >=4.7 && <4.9 , mmap , bytestring - , binary + , cereal , text , containers , iproute(>=1.4.0) , reinterpret-cast - , lrucache default-language: Haskell2010 ghc-options: -Wall