diff --git a/Database/Persist/IP.hs b/Database/Persist/IP.hs new file mode 100644 --- /dev/null +++ b/Database/Persist/IP.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | This module adds support for some of PostgreSQL operators on IP addresses +-- and networks. See +-- for more detailed documentation +module Database.Persist.IP ( (<:<.) + , (>:>.) + , (<:<=) + , (>:>=) + , (<.<.) + , (>.>.) + , IP + , IPRange + ) where + +import Data.IP +import Database.Persist +import Database.Persist.Instances.IP () +import Unsafe.Coerce (unsafeCoerce) + +-- | The record range is contained within the specified range. Corresponds to PgSQL operator <<. +(<:<.) :: EntityField record IPRange -> IPRange -> Filter record +field <:<. range = Filter field (Left range) (BackendSpecificFilter "<<") + +-- | The record range contains the specified range. Corresponds to PgSQL operator >>. +(>:>.) :: EntityField record IPRange -> IPRange -> Filter record +field >:>. range = Filter field (Left range) (BackendSpecificFilter ">>") + +-- | The record range is contained within or equals to the specified range. Corresponds to PgSQL operator <<=. +(<:<=) :: EntityField record IPRange -> IPRange -> Filter record +field <:<= range = Filter field (Left range) (BackendSpecificFilter "<<=") + +-- | The record range contains or equals to the specified range. Corresponds to PgSQL operator >>=. +(>:>=) :: EntityField record IPRange -> IPRange -> Filter record +field >:>= range = Filter field (Left range) (BackendSpecificFilter ">>=") + +-- | The record address is contained within the specified range. Corresponds to PgSQL operator <<. +(<.<.) :: EntityField record IP -> IPRange -> Filter record +field <.<. range = Filter (unsafeCoerce field :: EntityField record IPRange) (Left range) (BackendSpecificFilter "<<") + +-- | The record range contains the specified address. Corresponds to PgSQL operator >>. +(>.>.) :: EntityField record IPRange -> IP -> Filter record +field >.>. ip = Filter (unsafeCoerce field :: EntityField record IP) (Left ip) (BackendSpecificFilter ">>") diff --git a/Database/Persist/Instances/IP.hs b/Database/Persist/Instances/IP.hs new file mode 100644 --- /dev/null +++ b/Database/Persist/Instances/IP.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Database.Persist.Instances.IP where + +#if __GLASGOW_HASKELL__ <= 708 +import Control.Applicative (pure, (<$>)) +#endif +import Data.Aeson.IP () +import Data.ByteString.Char8 (pack,unpack) +import Data.IP (IPRange, IP) +import Data.Maybe (fromMaybe) +import qualified Data.Text as T +import Database.Persist +import Database.Persist.Sql +import Text.Read (readMaybe) +import Web.HttpApiData (ToHttpApiData(..),FromHttpApiData(..)) +import Web.PathPieces (PathPiece(..)) + +instance PersistField IP where + toPersistValue = PersistDbSpecific . pack . show + + fromPersistValue (PersistDbSpecific v) = fromMaybe (Left "Unable to parse IP") (pure <$> readMaybe (unpack v)) + fromPersistValue _ = Left "IP must be converted from PersistDbSpecific" + +instance PersistFieldSql IP where + sqlType _ = SqlOther "INET" + +instance PersistField IPRange where + toPersistValue = PersistDbSpecific . pack . show + + fromPersistValue (PersistDbSpecific v) = fromMaybe (Left "Unable to parse IPRange") (pure <$> readMaybe (unpack v)) + fromPersistValue _ = Left "IPRange must be converted from PersistDbSpecific" + +instance PersistFieldSql IPRange where + sqlType _ = SqlOther "CIDR" + + +-- The following instances don't really make sense, but persistent +-- requires them so I defined them anyway. +instance PathPiece IPRange where + fromPathPiece = readMaybe . T.unpack + toPathPiece = T.pack . show + +instance PathPiece IP where + fromPathPiece = readMaybe . T.unpack + toPathPiece = T.pack . show + +instance ToHttpApiData IP where + toUrlPiece = T.pack . show + +instance ToHttpApiData IPRange where + toUrlPiece = T.pack . show + +instance FromHttpApiData IP where + parseUrlPiece txt + | Just ip <- readMaybe $ T.unpack txt = Right ip + | otherwise = Left "Unable to parse IP" + +instance FromHttpApiData IPRange where + parseUrlPiece txt + | Just ip <- readMaybe $ T.unpack txt = Right ip + | otherwise = Left "Unable to parse IPRange" diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Lana Black + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Lana Black nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/persistent-iproute.cabal b/persistent-iproute.cabal new file mode 100644 --- /dev/null +++ b/persistent-iproute.cabal @@ -0,0 +1,31 @@ +name: persistent-iproute +version: 0.2.1 +synopsis: Persistent instances for types in iproute +description: Persistent instances and operators for types in iproute to use with PostgreSQL. +license: BSD3 +license-file: LICENSE +author: Lana Black +maintainer: lanablack@amok.cc +homepage: https://github.com/greydot/persistent-iproute +category: Database +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Database.Persist.IP + other-modules: Database.Persist.Instances.IP + build-depends: base >=4 && <5, + aeson >= 0.8, + aeson-iproute >= 0.1, + bytestring, + iproute >= 1.5, + http-api-data, + path-pieces, + persistent, + text + default-language: Haskell2010 + ghc-options: -Wall -fno-warn-orphans + +source-repository head + type: git + location: https://github.com/greydot/persistent-iproute.git