packages feed

postgresql-binary 0.9.3 → 0.10

raw patch · 6 files changed

+78/−105 lines, 6 filesdep +network-ip

Dependencies added: network-ip

Files

library/PostgreSQL/Binary/Data.hs view
@@ -3,7 +3,7 @@ module PostgreSQL.Binary.Data where  import PostgreSQL.Binary.Prelude-+import qualified Network.IP.Addr as IPAddr  -- |  -- A representation of a data serializable to the PostgreSQL array binary format.@@ -56,45 +56,3 @@ --  type Numeric =   (Int16, Word16, Vector Int16)---- |--- Representation of the PostgreSQL Network Address Type @inet@.------ The Inet type holds an IPv4 or IPv6 host address, and optionally its subnet.--- The subnet is represented by the number of network address bits present in the host address (the "netmask").--- If the subnet portion is missing, the netmask is 32 for IPv4 and 128 for IPv6.-data Inet-  = InetIPv4 IPv4-  | InetIPv4Subnet IPv4 Netmask-  | InetIPv6 IPv6-  | InetIPv6Subnet IPv6 Netmask-  deriving (Eq, Show)--type IPv4 = (Word8, Word8, Word8, Word8)--type IPv6 = (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)--type Netmask = Word8--maxNetmaskIPv4 :: Word8-maxNetmaskIPv4 = 32--maxNetmaskIPv6 :: Word8-maxNetmaskIPv6 = 128---- | Address family AF_INET-afInet :: Word8-afInet = 2---- | Address family AF_INET6-afInet6 :: Word8-afInet6 = 3--ipv4Size :: Int8-ipv4Size = 4--ipv6Size :: Int8-ipv6Size = 16--isCidr :: Word8-isCidr = 0
library/PostgreSQL/Binary/Decoder.hs view
@@ -60,6 +60,7 @@ import qualified PostgreSQL.Binary.Interval as Interval import qualified PostgreSQL.Binary.Numeric as Numeric import qualified PostgreSQL.Binary.Time as Time+import qualified PostgreSQL.Binary.Inet as Inet import qualified Data.Vector as Vector import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as LazyByteString@@ -69,6 +70,7 @@ import qualified Data.Text.Lazy.Encoding as LazyText import qualified Data.UUID as UUID import qualified Data.Aeson as Aeson+import qualified Network.IP.Addr as IPAddr   type Decoder =@@ -153,46 +155,33 @@ uuid =   UUID.fromWords <$> intOfSize 4 <*> intOfSize 4 <*> intOfSize 4 <*> intOfSize 4 -{-# INLINABLE ipv4 #-}-ipv4 :: Decoder Data.IPv4-ipv4 =-  (,,,) <$> intOfSize 1 <*> intOfSize 1 <*> intOfSize 1 <*> intOfSize 1+{-# INLINE ip4 #-}+ip4 :: Decoder IPAddr.IP4+ip4 =+  IPAddr.ip4FromOctets <$> intOfSize 1 <*> intOfSize 1 <*> intOfSize 1 <*> intOfSize 1 -{-# INLINABLE ipv6 #-}-ipv6 :: Decoder Data.IPv6-ipv6 =-  (,,,,,,,) <$> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2+{-# INLINE ip6 #-}+ip6 :: Decoder IPAddr.IP6+ip6 =+  IPAddr.ip6FromWords <$> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2 <*> intOfSize 2  {-# INLINABLE inet #-}-inet :: Decoder Data.Inet+inet :: Decoder (IPAddr.NetAddr IPAddr.IP) inet = do   af <- intOfSize 1   netmask <- intOfSize 1   isCidr <- intOfSize 1   ipSize <- intOfSize 1-  if af == Data.afInet-    then do-      ip <- ipv4-      return $ inetIPv4FromBytes af netmask isCidr ipSize ip-    else do-      ip <- ipv6-      return $ inetIPv6FromBytes af netmask isCidr ipSize ip--{-# INLINABLE inetIPv4FromBytes #-}-inetIPv4FromBytes:: Word8 -> Word8 -> Word8 -> Int8 -> Data.IPv4 -> Data.Inet-inetIPv4FromBytes _ netmask _ _ ip =-  if netmask == Data.maxNetmaskIPv4 then-    Data.InetIPv4 ip-  else-    Data.InetIPv4Subnet ip netmask--{-# INLINABLE inetIPv6FromBytes #-}-inetIPv6FromBytes:: Word8 -> Word8 -> Word8 -> Int8 -> Data.IPv6 -> Data.Inet-inetIPv6FromBytes _ netmask _ _ ip =-  if netmask == Data.maxNetmaskIPv6 then-    Data.InetIPv6 ip-  else-    Data.InetIPv6Subnet ip netmask+  if | af == Inet.inetAddressFamily ->+       do ip <- ip4+          return $ inetFromBytes af netmask isCidr ipSize (IPAddr.IPv4 ip)+     | af == Inet.inet6AddressFamily ->+       do ip <- ip6+          return $ inetFromBytes af netmask isCidr ipSize (IPAddr.IPv6 ip)+     | otherwise -> BinaryParser.failure ("Unknown address family: " <> fromString (show af))+  where+    inetFromBytes :: Word8 -> Word8 -> Word8 -> Int8 -> IPAddr.IP -> IPAddr.NetAddr IPAddr.IP+    inetFromBytes _ netmask _ _ ip = IPAddr.netAddr ip netmask  {-# INLINABLE json_ast #-} json_ast :: Decoder Aeson.Value
library/PostgreSQL/Binary/Encoder.hs view
@@ -70,7 +70,9 @@ import qualified PostgreSQL.Binary.Time as Time import qualified PostgreSQL.Binary.Interval as Interval import qualified PostgreSQL.Binary.BuilderPrim as BuilderPrim+import qualified PostgreSQL.Binary.Inet as Inet import qualified Control.Foldl as Foldl+import qualified Network.IP.Addr as IPAddr   type Encoder a =@@ -241,27 +243,35 @@ uuid =   premap UUID.toWords (tuple4 int4_word32 int4_word32 int4_word32 int4_word32) -{-# INLINABLE inetIPv4 #-}-inetIPv4 :: Encoder (Word8, Word8, Word8, Int8, Data.IPv4)-inetIPv4 =-  tuple5 int_word8 int_word8 int_word8 int_int8 $ tuple4 int_word8 int_word8 int_word8 int_word8+{-# INLINABLE ip4 #-}+ip4 :: Encoder IPAddr.IP4+ip4 =+  premap IPAddr.ip4ToOctets (tuple4 int_word8 int_word8 int_word8 int_word8) -{-# INLINABLE inetIPv6 #-}-inetIPv6 :: Encoder (Word8, Word8, Word8, Int8, Data.IPv6)-inetIPv6 =-  tuple5 int_word8 int_word8 int_word8 int_int8 $-  tuple8 int2_word16 int2_word16 int2_word16 int2_word16 int2_word16 int2_word16 int2_word16 int2_word16+{-# INLINABLE ip6 #-}+ip6 :: Encoder IPAddr.IP6+ip6 =+  premap IPAddr.ip6ToWords (tuple8 int2_word16 int2_word16 int2_word16 int2_word16 int2_word16 int2_word16 int2_word16 int2_word16)  {-# INLINABLE inet #-}-inet :: Encoder Data.Inet-inet i@(Data.InetIPv4 ipv4) =-  premap (const (Data.afInet, Data.maxNetmaskIPv4, Data.isCidr, Data.ipv4Size, ipv4)) inetIPv4 i-inet i@(Data.InetIPv4Subnet ipv4 netmask) =-  premap (const (Data.afInet, netmask, Data.isCidr, Data.ipv4Size, ipv4)) inetIPv4 i-inet i@(Data.InetIPv6 ipv6) =-  premap (const (Data.afInet6, Data.maxNetmaskIPv6, Data.isCidr, Data.ipv6Size, ipv6)) inetIPv6 i-inet i@(Data.InetIPv6Subnet ipv6 netmask) =-  premap (const (Data.afInet6, netmask, Data.isCidr, Data.ipv6Size, ipv6)) inetIPv6 i+inet :: Encoder (IPAddr.NetAddr IPAddr.IP)+inet i =+  case IPAddr.netHost i of+    IPAddr.IPv4 x -> inetAddressFamily <> netLength <> isCidr <> ip4Size <> ip4 x+    IPAddr.IPv6 x -> inet6AddressFamily <> netLength <> isCidr <> ip6Size <> ip6 x+    where+      inetAddressFamily =+        int_word8 Inet.inetAddressFamily+      inet6AddressFamily =+        int_word8 Inet.inet6AddressFamily+      netLength =+        int_word8 (IPAddr.netLength i)+      isCidr =+        int_word8 0+      ip4Size =+        int_int8 4+      ip6Size =+        int_int8 16  {-# INLINABLE json_ast #-} json_ast :: Encoder Aeson.Value
+ library/PostgreSQL/Binary/Inet.hs view
@@ -0,0 +1,14 @@+module PostgreSQL.Binary.Inet where++import PostgreSQL.Binary.Prelude+++-- | Address family AF_INET+inetAddressFamily :: Word8+inetAddressFamily =+  2++-- | Address family AF_INET6+inet6AddressFamily :: Word8+inet6AddressFamily =+  3
postgresql-binary.cabal view
@@ -1,7 +1,7 @@ name:   postgresql-binary version:-  0.9.3+  0.10 synopsis:   Encoders and decoders for the PostgreSQL's binary format description:@@ -57,17 +57,18 @@     Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples   default-language:     Haskell2010+  exposed-modules:+    PostgreSQL.Binary.Data+    PostgreSQL.Binary.Decoder+    PostgreSQL.Binary.Encoder   other-modules:     PostgreSQL.Binary.Prelude     PostgreSQL.Binary.Integral     PostgreSQL.Binary.Interval     PostgreSQL.Binary.Numeric     PostgreSQL.Binary.Time+    PostgreSQL.Binary.Inet     PostgreSQL.Binary.BuilderPrim-  exposed-modules:-    PostgreSQL.Binary.Data-    PostgreSQL.Binary.Decoder-    PostgreSQL.Binary.Encoder   build-depends:     -- parsing:     binary-parser >= 0.5 && < 0.6,@@ -79,6 +80,7 @@     bytestring >= 0.10.4 && < 0.11,     text >= 1 && < 2,     vector >= 0.10 && < 0.13,+    network-ip >= 0.2 && < 1,     -- errors:     loch-th == 0.2.*,     placeholders == 0.1.*,@@ -126,6 +128,7 @@     conversion == 1.*,     conversion-bytestring == 1.*,     conversion-text == 1.*,+    network-ip >= 0.2 && < 1,     -- debugging:     loch-th == 0.2.*,     placeholders == 0.1.*,
tasty/Main/Gens.hs view
@@ -13,6 +13,7 @@ import qualified PostgreSQL.Binary.Encoder as Encoder import qualified Data.Text as Text import qualified Data.Aeson as Aeson+import qualified Network.IP.Addr as IPAddr   -- * Generators@@ -120,15 +121,13 @@ uuid =   UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -inet :: Gen Data.Inet+inet :: Gen (IPAddr.NetAddr IPAddr.IP) inet = do   ipv6 <- choose (True, False)-  subnetOn <- choose (True, False)-  case (ipv6, subnetOn) of-    (False, False) -> Data.InetIPv4 <$> ((,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary)-    (False, True) ->  Data.InetIPv4Subnet <$> ((,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary) <*> choose (0, Data.maxNetmaskIPv4 - 1)-    (True, False) -> Data.InetIPv6 <$> ((,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary)-    (True, True) -> Data.InetIPv6Subnet <$> ((,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary) <*> choose (0, Data.maxNetmaskIPv6 - 1)+  if ipv6+    then IPAddr.netAddr <$> (IPAddr.IPv6 <$> (IPAddr.ip6FromWords <$>+         arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary)) <*> choose (0, 128)+    else IPAddr.netAddr <$> (IPAddr.IPv4 <$> (IPAddr.ip4FromOctets <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary)) <*> choose (0, 32)  arrayRep :: Gen (Word32, Data.Array) arrayRep =