IPv6DB 0.3.3.4 → 0.3.3.5
raw patch · 5 files changed
+112/−48 lines, 5 filesdep −attoparsecdep ~IPv6Addrdep ~aesondep ~hedisPVP ok
version bump matches the API change (PVP)
Dependencies removed: attoparsec
Dependency ranges changed: IPv6Addr, aeson, hedis
API changes (from Hackage documentation)
Files
- IPv6DB.cabal +18/−15
- LICENSE +1/−1
- README.md +1/−1
- app/Main.hs +26/−11
- app/Queries.hs +66/−20
IPv6DB.cabal view
@@ -1,23 +1,32 @@ name: IPv6DB-version: 0.3.3.4+version: 0.3.3.5 synopsis: A RESTful microService for IPv6-related data description: IPv6DB is a RESTful microservice using Redis as backend to store lists of IPv6 addresses and attach to each of them any valuable data in a schema-free valid JSON value. Each resource can be permanent or TTLed.-homepage: http://ipv6db.functor.cloud+homepage: https://github.com/MichelBoucey/IPv6DB license: BSD3 license-file: LICENSE author: Michel Boucey maintainer: michel.boucey@gmail.com-copyright: (c) 2017-2024 - Michel Boucey+copyright: (c) 2017-2026 - Michel Boucey category: network, database build-type: Simple cabal-version: >=1.10 extra-source-files: README.md , IPv6DB_APIv1.md -Tested-With: GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 || ==9.10.1+Tested-With:+ GHC ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.7+ || ==9.8.4+ || ==9.10.3+ || ==9.12.4 Source-Repository head Type: git@@ -26,15 +35,9 @@ library hs-source-dirs: src exposed-modules: Network.IPv6DB.Types - build-depends: aeson >= 0.7 && < 2.3- , attoparsec >= 0.13.1.0 && < 0.15+ build-depends: aeson >= 0.7 && < 2.4 , base >= 4.12 && < 5- , bytestring >= 0.10 && < 0.13 , IPv6Addr >= 2.0.5 && < 2.1- , hedis == 0.15.*- , http-types >= 0.9.1 && < 0.13- , unordered-containers >= 0.2.7 && < 0.3- , mtl >= 2.2.1 && < 2.4 , text >= 1.2.4.0 && < 2.2 , vector >= 0.11.0.0 && < 0.14 default-language: Haskell2010@@ -45,17 +48,17 @@ other-modules: Options , Queries , Types- build-depends: aeson >= 0.7 && < 2.3+ build-depends: aeson >= 0.7 && < 2.4 , base >= 4.12 && < 5 , bytestring >= 0.10 && < 0.13 , fast-logger >= 2.4.8 && < 3.3 , IPv6Addr >= 2.0 && < 2.1 , IPv6DB- , hedis == 0.15.*+ , hedis >= 0.15 && < 0.17 , http-types >= 0.9.1 && < 0.13 , unordered-containers >= 0.2.7 && < 0.3 , mtl >= 2.2.1 && < 2.4- , optparse-applicative >= 0.12.1.0 && < 0.19+ , optparse-applicative >= 0.12.1.0 && < 1 , text >= 1.2.4.0 && < 2.2 , vector >= 0.11.0.0 && < 0.14 , wai >= 3.2.1 && < 3.3@@ -69,7 +72,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: hspec.hs- build-depends: aeson >= 0.7 && < 2.3+ build-depends: aeson >= 0.7 && < 2.4 , hspec >= 2.1.10 && < 2.12 , base >= 4.12 && < 5 , IPv6DB
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2017-2018, Michel Boucey+Copyright (c) 2017-2026, Michel Boucey All rights reserved. Redistribution and use in source and binary forms, with or without
README.md view
@@ -6,7 +6,7 @@ ```bash [user@box ~]$ ipv6db --help-IPv6DB v0.3.3.1 APIv1, (c) Michel Boucey 2017-2024+IPv6DB v0.3.3.5 APIv1, (c) Michel Boucey 2017-2026 Usage: ipv6db [-h|--host ARG] [-p|--port ARG] [-l|--log-file ARG] [-o|--redis-host ARG] [-r|--redis-port ARG]
app/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -5,19 +6,26 @@ {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} import Control.Monad.Reader-import Data.Aeson as A-import qualified Data.ByteString.Lazy as BSL-import Data.Maybe (fromJust)-import Data.String (fromString)-import qualified Data.Vector as V-import Database.Redis hiding (String)-import Network.HTTP.Types hiding (noContent204)+import Data.Aeson+import qualified Data.ByteString.Lazy as BSL+import Data.Maybe (fromJust)+import Data.String (fromString)+import qualified Data.Vector as V+#if MIN_VERSION_hedis(0,16,0)+import Database.Redis hiding (String, decode, encode)+import Database.Redis.Commands ()+import Database.Redis.Connection ()+import Database.Redis.Types ()+#else+import Database.Redis hiding (String, decode, encode)+#endif+import Network.HTTP.Types hiding (noContent204) import Network.IPv6DB.Types import Network.Wai import Network.Wai.Handler.Warp import Network.Wai.Logger-import Options.Applicative (execParser)-import Prelude hiding (error)+import Options.Applicative (execParser)+import Prelude hiding (error) import System.Log.FastLogger import Text.IPv6Addr @@ -42,11 +50,18 @@ ipv6db logger req res = do Options{..} <- execParser opts conn <- checkedConnect $+#if MIN_VERSION_hedis(0,16,0) defaultConnectInfo+ { connectAddr = ConnectAddrHostPort redisHost (fromInteger redisPort)+ , connectAuth = redisAuth+ , connectDatabase = redisDatabase }+#else+ defaultConnectInfo { connectHost = redisHost , connectPort = PortNumber (fromInteger redisPort) , connectAuth = redisAuth , connectDatabase = redisDatabase }+#endif withEnv Env { redisConn = conn } $ case parseMethod (requestMethod req) of Right mtd ->@@ -68,7 +83,7 @@ withEnv = flip runReaderT maybeJSONBody :: FromJSON a => IO (Maybe a)- maybeJSONBody = A.decode <$> strictRequestBody req+ maybeJSONBody = decode <$> strictRequestBody req logWith status = liftIO (logger req status Nothing) @@ -171,7 +186,7 @@ Just src -> do ttls <- ttlSource redisConn list addr' case toResource list addr' ttls src of- Just rsrc -> jsonOk (A.encode rsrc)+ Just rsrc -> jsonOk (encode rsrc) Nothing -> jsonError "Can't Build Resource" Nothing -> jsonRes404 $
app/Queries.hs view
@@ -7,7 +7,7 @@ import Control.Monad (zipWithM) import Control.Monad.Reader-import Data.Aeson as A+import qualified Data.Aeson as A import qualified Data.Aeson.KeyMap as KM import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL@@ -15,7 +15,15 @@ import Data.Maybe (fromJust) import qualified Data.Text as T import Data.Text.Encoding-import Database.Redis as R hiding (decode)+#if MIN_VERSION_hedis(0,16,0)+import Database.Redis+import Database.Redis.Commands ()+import Database.Redis.Connection ()+import Database.Redis.Types ()+import qualified Data.List.NonEmpty as N+#else+import Database.Redis+#endif import Network.HTTP.Types (StdMethod (..)) import Network.IPv6DB.Types import Text.IPv6Addr@@ -27,7 +35,7 @@ -> [Maybe BS.ByteString] -> f BSL.ByteString fromEntries (Entries ents) msrcs =- encode <$> zipWithM toJson ents msrcs+ A.encode <$> zipWithM toJson ents msrcs where toJson Entry{..} (Just src) = do Env{..} <- ask@@ -41,7 +49,7 @@ -> [Maybe BS.ByteString] -> f BSL.ByteString fromAddresses list (Addresses addrs) msrcs =- encode <$> zipWithM toJson addrs msrcs+ A.encode <$> zipWithM toJson addrs msrcs where toJson addr (Just src) = do Env{..} <- ask@@ -58,12 +66,13 @@ mttl <- ttlSource conn list addr return (fromJust $ toResource list addr mttl src) -setSource ::Connection -> StdMethod -> Resource -> IO RedisResponse+setSource :: Connection -> StdMethod -> Resource -> IO RedisResponse setSource _ _ ResourceError{} = undefined setSource conn mtd Resource{ttl=ttlr,..} = do er <- runRedis conn $ setOpts (toKey list $ unIPv6Addr address)- (BSL.toStrict $ encode source)+ (BSL.toStrict $ A.encode source)+#if MIN_VERSION_hedis(0,16,0) SetOpts { setSeconds = ttlr , setMilliseconds = Nothing@@ -72,18 +81,32 @@ PUT -> Just Xx POST -> Just Nx _ -> Nothing+ , setUnixSeconds = Nothing+ , setUnixMilliseconds = Nothing+ , setKeepTTL = False }+#else+ SetOpts+ { setSeconds = ttlr+ , setMilliseconds = Nothing+ , setCondition =+ case mtd of+ PUT -> Just Xx+ POST -> Just Nx+ _ -> Nothing+ }+#endif return $ case er of Right s -> case s of- Ok -> RedisOk+ Ok -> RedisOk Status status -> toRedisError list address status Pong -> toRedisError list address "Ping!" Left r -> case r of- R.Error err -> toRedisError list address err- R.Bulk Nothing ->+ Error err -> toRedisError list address err+ Bulk Nothing -> case mtd of PUT -> toRedisError@@ -100,7 +123,7 @@ list address "HTTP Method Not Handled"- R.Bulk (Just bs) -> toRedisError list address bs+ Bulk (Just bs) -> toRedisError list address bs _ -> toRedisError list@@ -122,7 +145,7 @@ -> T.Text -> IO (Maybe Integer) ttlSource conn list addr = do- ettl <- R.runRedis conn (R.ttl $ toKey list addr)+ ettl <- runRedis conn (Database.Redis.ttl $ toKey list addr) return $ case ettl of Right i ->@@ -141,7 +164,12 @@ => T.Text -> T.Text -> m (f Integer)-delSource list addr = del [ toKey list addr ]+delSource list addr =+#if MIN_VERSION_hedis(0,16,0)+ del (N.fromList [ toKey list addr ])+#else+ del [ toKey list addr ]+#endif toResource :: T.Text -> T.Text@@ -149,7 +177,7 @@ -> BS.ByteString -> Maybe Resource toResource list addr mi bs =- decode (BSL.fromStrict bs) >>= \src ->+ A.decode (BSL.fromStrict bs) >>= \src -> Just Resource { list = list@@ -158,17 +186,17 @@ , source = Source src } -maybeResource :: Value- -> [(T.Text,Value)]+maybeResource :: A.Value+ -> [(T.Text,A.Value)] -> Maybe Resource maybeResource v prs = case v of- Object hm -> do+ A.Object hm -> do let hm' = if KM.member "ttl" hm then hm- else KM.insert "ttl" Null hm- case fromJSON (Object $ KM.union hm' $ KM.fromHashMapText $ fromList prs) of+ else KM.insert "ttl" A.Null hm+ case A.fromJSON (A.Object $ KM.union hm' $ KM.fromHashMapText $ fromList prs) of A.Success r -> Just r A.Error _ -> Nothing _ -> Nothing@@ -178,23 +206,41 @@ -> Addresses -> m (f [Maybe BS.ByteString]) getByAddresses list addrs =+#if MIN_VERSION_hedis(0,16,0)+ mget (N.fromList $ addressesToKeys list addrs)+#else mget (addressesToKeys list addrs)+#endif getByEntries :: RedisCtx m f => Entries -> m (f [Maybe BS.ByteString])-getByEntries ents = mget (fromEnts ents)+getByEntries ents =+#if MIN_VERSION_hedis(0,16,0)+ mget (N.fromList $ fromEnts ents)+#else+ mget (fromEnts ents)+#endif delByAddresses :: RedisCtx m f => T.Text -> Addresses -> m (f Integer) delByAddresses list addrs =+#if MIN_VERSION_hedis(0,16,0)+ del (N.fromList $ addressesToKeys list addrs)+#else del (addressesToKeys list addrs)+#endif delByEntries :: RedisCtx m f => Entries -> m (f Integer)-delByEntries ents = del (fromEnts ents)+delByEntries ents =+#if MIN_VERSION_hedis(0,16,0)+ del (N.fromList $ fromEnts ents)+#else+ del (fromEnts ents)+#endif addressesToKeys :: T.Text -> Addresses