persistent-ip (empty) → 0.6.0
raw patch · 6 files changed
+211/−0 lines, 6 filesdep +attoparsecdep +basedep +ipsetup-changed
Dependencies added: attoparsec, base, ip, persistent, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- persistent-ip.cabal +33/−0
- src/Database/Persist/Net/PostgreSQL.hs +71/−0
- src/Database/Persist/Net/Simple.hs +47/−0
- src/Net/IPv4/Unnormalized.hs +28/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Andrew Martin (c) 2016++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 Andrew Martin 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ persistent-ip.cabal view
@@ -0,0 +1,33 @@+cabal-version: >=1.10+name: persistent-ip +version: 0.6.0+synopsis: Code for using the ip package with yesod+description: Please see README.md+homepage: https://github.com/andrewthad/yesod-ip#readme+license: BSD3+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2016 Andrew Martin+category: web+build-type: Simple+-- extra-source-files:++library+ hs-source-dirs: src+ other-modules:+ Net.IPv4.Unnormalized+ exposed-modules:+ Database.Persist.Net.Simple+ Database.Persist.Net.PostgreSQL+ build-depends:+ base >= 4.7 && < 5+ , ip >= 1.4.1 && < 1.8+ , persistent >= 2.1 && < 2.15+ , text >= 1.2+ , attoparsec < 0.15+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/andrewthad/yesod-ip
+ src/Database/Persist/Net/PostgreSQL.hs view
@@ -0,0 +1,71 @@+-- | This module provides orphan instances for data types+-- from the @ip@ package. These instances only work for+-- PostgresSQL. The following PostgreSQL column types are+-- used for each data types:+--+-- * 'IPv4': @inet@+-- * 'Mac': @macaddr@+--+module Database.Persist.Net.PostgreSQL+ () where++import Data.Monoid+import Data.Text (Text)+import Database.Persist+import Database.Persist.Class+import Database.Persist.Sql+import Net.IPv4.Unnormalized (unnormalizedDecodeRange)+import Net.Types (IPv4,IPv4Range,Mac)++import qualified Data.Text as Text+import qualified Data.Text.Encoding as TE+import qualified Net.IPv4 as IPv4+import qualified Net.Mac as Mac++instance PersistField IPv4 where+ toPersistValue = toPersistValue . IPv4.encode+ fromPersistValue v = case v of+ PersistDbSpecific s -> case IPv4.decodeUtf8 s of+ Just x -> Right x+ Nothing -> Left (Text.pack "PersistValue IPv4: Invalid format")+ PersistText t -> case IPv4.decode t of+ Just x -> Right x+ Nothing -> Left (Text.pack "PersistValue IPv4: Invalid format")+ y -> Left $ Text.pack "PersistValue IPv4: Not a PersistDbSpecific: " <> Text.pack (show y)++-- | This does not normalize the range. Since PostgreSQL allows+-- the user to store nonnormalized ranges, this instance preserves+-- this behavior.+instance PersistField IPv4Range where+ toPersistValue = toPersistValue . IPv4.encodeRange+ fromPersistValue v = case v of+ PersistDbSpecific s -> case TE.decodeUtf8' s of+ Right t -> case unnormalizedDecodeRange t of+ Just x -> Right x+ Nothing -> Left (Text.pack "PersistValue IPv4Range: Invalid format")+ Left _ -> Left (Text.pack "PersistValue IPv4Range: Invalid format")+ PersistText t -> case unnormalizedDecodeRange t of+ Just x -> Right x+ Nothing -> Left (Text.pack "PersistValue IPv4Range: Invalid format")+ y -> Left $ Text.pack "PersistValue IPv4: Not a PersistDbSpecific: " <> Text.pack (show y)+ ++instance PersistFieldSql IPv4 where+ sqlType _ = SqlOther (Text.pack "inet")++instance PersistFieldSql IPv4Range where+ sqlType _ = SqlOther (Text.pack "inet")++instance PersistField Mac where+ toPersistValue = toPersistValue . Mac.encode+ fromPersistValue v = case v of+ PersistDbSpecific s -> case Mac.decodeUtf8 s of+ Just x -> Right x+ Nothing -> Left (Text.pack "PersistValue MAC: Invalid format")+ PersistText t -> case Mac.decode t of+ Just x -> Right x+ Nothing -> Left (Text.pack "PersistValue MAC: Invalid format")+ y -> Left $ Text.pack "PersistValue MAC: Not a PersistDbSpecific: " <> Text.pack (show y)++instance PersistFieldSql Mac where+ sqlType _ = SqlOther (Text.pack "macaddr")
+ src/Database/Persist/Net/Simple.hs view
@@ -0,0 +1,47 @@+ {-# LANGUAGE OverloadedStrings #-}++-- | This module provides orphan instances for the typeclasses+-- 'PersistField' and 'PersistFieldSql'. The instances provided+-- are for the data types 'IPv4' and 'Mac' from the @ip@ package.+-- These instances will choose the+-- standard text type for the database column. If you are+-- using PostgreSQL, you may want to consider importing+-- the @Database.Persist.Net.PostgreSQL@ module instead.+module Database.Persist.Net.Simple+ () where++import Data.Monoid+import Data.Text (Text)+import Database.Persist+import Database.Persist.Class+import Database.Persist.Sql+import Net.Types (IPv4, Mac)++import qualified Data.Text as Text+import qualified Net.IPv4 as IPv4+import qualified Net.Mac as Mac++instance PersistField IPv4 where+ toPersistValue = toPersistValueTextShow IPv4.encode+ fromPersistValue = fromPersistValueTextRead IPv4.decode++instance PersistFieldSql IPv4 where+ sqlType _ = SqlString++instance PersistField Mac where+ toPersistValue = toPersistValueTextShow Mac.encode+ fromPersistValue = fromPersistValueTextRead Mac.decode++instance PersistFieldSql Mac where+ sqlType _ = SqlString++fromPersistValueTextRead :: (Text -> Maybe a) -> PersistValue -> Either Text a+fromPersistValueTextRead fromText z = do+ t <- fromPersistValueText z+ case fromText t of+ Nothing -> Left $ "Could not parse the following text:" <> Text.pack (show t)+ Just v -> Right v++toPersistValueTextShow :: (a -> Text) -> a -> PersistValue+toPersistValueTextShow f a = PersistText (f a)+
+ src/Net/IPv4/Unnormalized.hs view
@@ -0,0 +1,28 @@+module Net.IPv4.Unnormalized+ ( unnormalizedDecodeRange+ ) where++import Data.Text (Text)+import Net.Types (IPv4, IPv4Range(..), Mac)++import qualified Net.IPv4 as IPv4+import qualified Data.Attoparsec.Text as AT++-- Decode an 'IPv4Range' from 'Text'.+unnormalizedDecodeRange :: Text -> Maybe IPv4Range+unnormalizedDecodeRange =+ either (const Nothing) Just . AT.parseOnly (unnormalizedParserRange <* AT.endOfInput)++-- The same this as parserRange except that it does not+-- do any normalization of the range.+unnormalizedParserRange :: AT.Parser IPv4Range+unnormalizedParserRange = do+ ip <- IPv4.parser+ _ <- AT.char '/'+ theMask <- AT.decimal >>= limitSize+ return (IPv4Range ip theMask)+ where+ limitSize i =+ if i > 32+ then fail "An IPv4 range length must be between 0 and 32"+ else return i