{-# LANGUAGE TemplateHaskell #-}
{-|
Module: IHP.Postgres.Inet
Description: Adds support for storing IP addresses in INET fields. CIDR Notation is not suppported at the moment.
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.Postgres.Inet where

import BasicPrelude

import qualified Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.ToField
import Database.PostgreSQL.Simple.FromField
import qualified Database.PostgreSQL.Simple.Types
import Database.PostgreSQL.Simple.TypeInfo as TI
import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI
import Database.PostgreSQL.Simple.TypeInfo.Macro as TI
import Data.ByteString.Builder (byteString, char8)
import Data.Attoparsec.ByteString.Char8 as Attoparsec
import Data.String.Conversions (cs)

-- We use the @ip@ package for representing IP addresses
import qualified Net.IP as IP
import Net.IP (IP)

instance FromField IP where
    fromField :: FieldParser IP
fromField Field
f Maybe ByteString
v =
        if Field -> Oid
typeOid Field
f Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
/= $(inlineTypoid TI.inet)
        then (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion IP
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
""
        else case Maybe ByteString
v of
               Maybe ByteString
Nothing -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion IP
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f String
""
               Just ByteString
bs ->
                   case Parser IP -> ByteString -> Either String IP
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser IP
parser ByteString
bs of
                     Left  String
err -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion IP
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
err
                     Right IP
val -> IP -> Conversion IP
forall (f :: * -> *) a. Applicative f => a -> f a
pure IP
val
      where
        parser :: Parser IP
parser = do
            ByteString
ip <- (Char -> Bool) -> Parser ByteString
Attoparsec.takeWhile (\Char
char -> Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ')
            case Text -> Maybe IP
IP.decode (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
ip) of
                Just IP
ip -> IP -> Parser IP
forall (f :: * -> *) a. Applicative f => a -> f a
pure IP
ip
                Maybe IP
Nothing -> String -> Parser IP
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid IP"

instance ToField IP where
    toField :: IP -> Action
toField IP
ip = Text -> Action
forall a. ToField a => a -> Action
toField (IP -> Text
IP.encode IP
ip)