{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, DataKinds, TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Database.PostgreSQL.Typed.Inet where
import Control.Monad (void, guard, liftM2)
import qualified Data.ByteString.Char8 as BSC
import Data.Bits (shiftL, (.|.))
import Data.Maybe (fromJust)
import Data.Word (Word8, Word16, Word32)
import Foreign.Marshal.Array (withArray)
import Foreign.Ptr (castPtr)
import Foreign.Storable (peek)
import qualified Network.Socket as Net
import Numeric (readDec, readHex)
import System.IO.Unsafe (unsafeDupablePerformIO)
import qualified Text.ParserCombinators.ReadP as RP
import qualified Text.ParserCombinators.ReadPrec as RP (lift)
import Text.Read (Read(readPrec))
import Database.PostgreSQL.Typed.Types
data PGInet
= PGInet
{ PGInet -> Word32
pgInetAddr :: !Net.HostAddress
, PGInet -> Word8
pgInetMask :: !Word8
}
| PGInet6
{ PGInet -> HostAddress6
pgInetAddr6 :: !Net.HostAddress6
, pgInetMask :: !Word8
}
deriving (PGInet -> PGInet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PGInet -> PGInet -> Bool
$c/= :: PGInet -> PGInet -> Bool
== :: PGInet -> PGInet -> Bool
$c== :: PGInet -> PGInet -> Bool
Eq)
sockAddrPGInet :: Net.SockAddr -> Maybe PGInet
sockAddrPGInet :: SockAddr -> Maybe PGInet
sockAddrPGInet (Net.SockAddrInet PortNumber
_ Word32
a) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word32 -> Word8 -> PGInet
PGInet Word32
a Word8
32
sockAddrPGInet (Net.SockAddrInet6 PortNumber
_ Word32
_ HostAddress6
a Word32
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ HostAddress6 -> Word8 -> PGInet
PGInet6 HostAddress6
a Word8
128
sockAddrPGInet SockAddr
_ = forall a. Maybe a
Nothing
bton32 :: (Word8, Word8, Word8, Word8) -> Word32
bton32 :: (Word8, Word8, Word8, Word8) -> Word32
bton32 (Word8
b1, Word8
b2, Word8
b3, Word8
b4) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Word8
b1, Word8
b2, Word8
b3, Word8
b4] (forall a. Storable a => Ptr a -> IO a
peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)
instance Show PGInet where
show :: PGInet -> String
show (PGInet Word32
a Word8
32) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
[NameInfoFlag]
-> Bool -> Bool -> SockAddr -> IO (Maybe String, Maybe String)
Net.getNameInfo [NameInfoFlag
Net.NI_NUMERICHOST] Bool
True Bool
False (PortNumber -> Word32 -> SockAddr
Net.SockAddrInet PortNumber
0 Word32
a)
show (PGInet Word32
a Word8
m) = forall a. Show a => a -> String
show (Word32 -> Word8 -> PGInet
PGInet Word32
a Word8
32) forall a. [a] -> [a] -> [a]
++ Char
'/' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Word8
m
show (PGInet6 HostAddress6
a Word8
128) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
[NameInfoFlag]
-> Bool -> Bool -> SockAddr -> IO (Maybe String, Maybe String)
Net.getNameInfo [NameInfoFlag
Net.NI_NUMERICHOST] Bool
True Bool
False (PortNumber -> Word32 -> HostAddress6 -> Word32 -> SockAddr
Net.SockAddrInet6 PortNumber
0 Word32
0 HostAddress6
a Word32
0)
show (PGInet6 HostAddress6
a Word8
m) = forall a. Show a => a -> String
show (HostAddress6 -> Word8 -> PGInet
PGInet6 HostAddress6
a Word8
128) forall a. [a] -> [a] -> [a]
++ Char
'/' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Word8
m
instance Read PGInet where
readPrec :: ReadPrec PGInet
readPrec = forall a. ReadP a -> ReadPrec a
RP.lift forall a b. (a -> b) -> a -> b
$ ReadP PGInet
r4 forall a. ReadP a -> ReadP a -> ReadP a
RP.+++ ReadP PGInet
r6 where
r4i :: ReadP (Word8, Word8, Word8, Word8)
r4i = do
Word8
o1 <- ReadP Word8
rdec
Char
_ <- Char -> ReadP Char
RP.char Char
'.'
Word8
o2 <- ReadP Word8
rdec
Char
_ <- Char -> ReadP Char
RP.char Char
'.'
Word8
o3 <- ReadP Word8
rdec
Char
_ <- Char -> ReadP Char
RP.char Char
'.'
Word8
o4 <- ReadP Word8
rdec
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
o1, Word8
o2, Word8
o3, Word8
o4)
r4 :: ReadP PGInet
r4 = do
(Word8, Word8, Word8, Word8)
q <- ReadP (Word8, Word8, Word8, Word8)
r4i
Word8
m <- Word8 -> ReadP Word8
mask Word8
32
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word32 -> Word8 -> PGInet
PGInet ((Word8, Word8, Word8, Word8) -> Word32
bton32 (Word8, Word8, Word8, Word8)
q) Word8
m
r64 :: ReadP [Word16]
r64 = do
(Word8
b1, Word8
b2, Word8
b3, Word8
b4) <- ReadP (Word8, Word8, Word8, Word8)
r4i
forall (m :: * -> *) a. Monad m => a -> m a
return [Word8 -> Word8 -> Word16
jb Word8
b1 Word8
b2, Word8 -> Word8 -> Word16
jb Word8
b3 Word8
b4]
r6l :: Int -> ReadP [Word16]
r6l Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
r6l Int
2 = ReadP ()
colon forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ReadP [Word16]
r6lc Int
2 forall a. ReadP a -> ReadP a -> ReadP a
RP.+++ ReadP [Word16]
r64
r6l Int
n = ReadP ()
colon forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ReadP [Word16]
r6lc Int
n
r6lc :: Int -> ReadP [Word16]
r6lc Int
n = Int -> ReadP [Word16]
r6lp Int
n forall a. ReadP a -> ReadP a -> ReadP a
RP.+++ Int -> ReadP [Word16]
r6b Int
n
r6lp :: Int -> ReadP [Word16]
r6lp Int
n = ReadP [Word16] -> ReadP [Word16]
r6w (Int -> ReadP [Word16]
r6l (forall a. Enum a => a -> a
pred Int
n))
r6b :: Int -> ReadP [Word16]
r6b Int
n = do
ReadP ()
colon
[Word16]
r <- forall {a}. (Ord a, Num a, Enum a) => a -> ReadP [Word16]
r6rp (forall a. Enum a => a -> a
pred Int
n) forall a. ReadP a -> ReadP a -> ReadP a
RP.<++ forall (m :: * -> *) a. Monad m => a -> m a
return []
let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word16]
r
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- Int
l) Word16
0 forall a. [a] -> [a] -> [a]
++ [Word16]
r
r6r :: a -> ReadP [Word16]
r6r a
0 = forall (m :: * -> *) a. Monad m => a -> m a
return []
r6r a
n = (ReadP ()
colon forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> ReadP [Word16]
r6rp a
n) forall a. ReadP a -> ReadP a -> ReadP a
RP.<++ forall (m :: * -> *) a. Monad m => a -> m a
return []
r6rp :: a -> ReadP [Word16]
r6rp a
n
| a
n forall a. Ord a => a -> a -> Bool
>= a
2 = a -> ReadP [Word16]
r6rc a
n forall a. ReadP a -> ReadP a -> ReadP a
RP.+++ ReadP [Word16]
r64
| Bool
otherwise = a -> ReadP [Word16]
r6rc a
n
r6rc :: a -> ReadP [Word16]
r6rc a
n = ReadP [Word16] -> ReadP [Word16]
r6w (a -> ReadP [Word16]
r6r (forall a. Enum a => a -> a
pred a
n))
r6w :: ReadP [Word16] -> ReadP [Word16]
r6w = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ReadP Word16
rhex
r6 :: ReadP PGInet
r6 = do
[Word16
w1, Word16
w2, Word16
w3, Word16
w4, Word16
w5, Word16
w6, Word16
w7, Word16
w8] <- Int -> ReadP [Word16]
r6lp Int
8 forall a. ReadP a -> ReadP a -> ReadP a
RP.<++ (ReadP ()
colon forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ReadP [Word16]
r6b Int
8)
Word8
m <- Word8 -> ReadP Word8
mask Word8
128
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HostAddress6 -> Word8 -> PGInet
PGInet6 (Word16 -> Word16 -> Word32
jw Word16
w1 Word16
w2, Word16 -> Word16 -> Word32
jw Word16
w3 Word16
w4, Word16 -> Word16 -> Word32
jw Word16
w5 Word16
w6, Word16 -> Word16 -> Word32
jw Word16
w7 Word16
w8) Word8
m
colon :: ReadP ()
colon = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
RP.char Char
':'
mask :: Word8 -> ReadP Word8
mask Word8
m = forall a. a -> ReadP a -> ReadP a
RP.option Word8
m forall a b. (a -> b) -> a -> b
$ do
Char
_ <- Char -> ReadP Char
RP.char Char
'/'
Word8
n <- ReadP Word8
rdec
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
n forall a. Ord a => a -> a -> Bool
<= Word8
m)
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
n
rdec :: RP.ReadP Word8
rdec :: ReadP Word8
rdec = forall a. ReadS a -> ReadP a
RP.readS_to_P forall a. (Eq a, Num a) => ReadS a
readDec
rhex :: RP.ReadP Word16
rhex :: ReadP Word16
rhex = forall a. ReadS a -> ReadP a
RP.readS_to_P forall a. (Eq a, Num a) => ReadS a
readHex
jw :: Word16 -> Word16 -> Word32
jw :: Word16 -> Word16 -> Word32
jw Word16
x Word16
y = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x forall a. Bits a => a -> Int -> a
`shiftL` Int
16 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y
jb :: Word8 -> Word8 -> Word16
jb :: Word8 -> Word8 -> Word16
jb Word8
x Word8
y = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
y
instance PGType "inet" where
type PGVal "inet" = PGInet
instance PGType "cidr" where
type PGVal "cidr" = PGInet
instance PGParameter "inet" PGInet where
pgEncode :: PGTypeID "inet" -> PGInet -> ByteString
pgEncode PGTypeID "inet"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance PGParameter "cidr" PGInet where
pgEncode :: PGTypeID "cidr" -> PGInet -> ByteString
pgEncode PGTypeID "cidr"
_ = String -> ByteString
BSC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance PGColumn "inet" PGInet where
pgDecode :: PGTypeID "inet" -> ByteString -> PGInet
pgDecode PGTypeID "inet"
_ = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack
instance PGColumn "cidr" PGInet where
pgDecode :: PGTypeID "cidr" -> ByteString -> PGInet
pgDecode PGTypeID "cidr"
_ = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack