{-# LANGUAGE OverloadedStrings #-}
module System.ZMQ4.Endpoint (
    parseAttoEndpoint
  , parseAttoTCPEndpoint
  , parseAttoUDPEndpoint
  , pTransport
  , pEndpoint
  , endpointAddr
  , endpointPort
  , endpointTransport
  , newEndpoint
  , newEndpointPort
  , newEndpointAddrInfo
  , newEndpointPortAddrInfo
  , newTCPEndpoint
  , newTCPEndpointAddrInfo
  , newUDPEndpoint
  , toAddrInfo
  , Port
  , Address
  , Transport(..)
  , Endpoint(..)) where

import Control.Applicative
import Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
import Data.Char (toLower)

import Network.Socket  -- only need addrAddress
import Network.SockAddr (showSockAddrBS)

type Port = Int
type Address = B.ByteString
data Transport = TCP | UDP | IPC | InProc | PGM | EPGM
  deriving (Int -> Transport -> ShowS
[Transport] -> ShowS
Transport -> String
(Int -> Transport -> ShowS)
-> (Transport -> String)
-> ([Transport] -> ShowS)
-> Show Transport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transport] -> ShowS
$cshowList :: [Transport] -> ShowS
show :: Transport -> String
$cshow :: Transport -> String
showsPrec :: Int -> Transport -> ShowS
$cshowsPrec :: Int -> Transport -> ShowS
Show, Transport -> Transport -> Bool
(Transport -> Transport -> Bool)
-> (Transport -> Transport -> Bool) -> Eq Transport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transport -> Transport -> Bool
$c/= :: Transport -> Transport -> Bool
== :: Transport -> Transport -> Bool
$c== :: Transport -> Transport -> Bool
Eq, Eq Transport
Eq Transport =>
(Transport -> Transport -> Ordering)
-> (Transport -> Transport -> Bool)
-> (Transport -> Transport -> Bool)
-> (Transport -> Transport -> Bool)
-> (Transport -> Transport -> Bool)
-> (Transport -> Transport -> Transport)
-> (Transport -> Transport -> Transport)
-> Ord Transport
Transport -> Transport -> Bool
Transport -> Transport -> Ordering
Transport -> Transport -> Transport
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Transport -> Transport -> Transport
$cmin :: Transport -> Transport -> Transport
max :: Transport -> Transport -> Transport
$cmax :: Transport -> Transport -> Transport
>= :: Transport -> Transport -> Bool
$c>= :: Transport -> Transport -> Bool
> :: Transport -> Transport -> Bool
$c> :: Transport -> Transport -> Bool
<= :: Transport -> Transport -> Bool
$c<= :: Transport -> Transport -> Bool
< :: Transport -> Transport -> Bool
$c< :: Transport -> Transport -> Bool
compare :: Transport -> Transport -> Ordering
$ccompare :: Transport -> Transport -> Ordering
$cp1Ord :: Eq Transport
Ord)

data Endpoint = Endpoint Transport Address (Maybe Port)
  deriving (Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
(Int -> Endpoint -> ShowS)
-> (Endpoint -> String) -> ([Endpoint] -> ShowS) -> Show Endpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endpoint] -> ShowS
$cshowList :: [Endpoint] -> ShowS
show :: Endpoint -> String
$cshow :: Endpoint -> String
showsPrec :: Int -> Endpoint -> ShowS
$cshowsPrec :: Int -> Endpoint -> ShowS
Show, Endpoint -> Endpoint -> Bool
(Endpoint -> Endpoint -> Bool)
-> (Endpoint -> Endpoint -> Bool) -> Eq Endpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endpoint -> Endpoint -> Bool
$c/= :: Endpoint -> Endpoint -> Bool
== :: Endpoint -> Endpoint -> Bool
$c== :: Endpoint -> Endpoint -> Bool
Eq, Eq Endpoint
Eq Endpoint =>
(Endpoint -> Endpoint -> Ordering)
-> (Endpoint -> Endpoint -> Bool)
-> (Endpoint -> Endpoint -> Bool)
-> (Endpoint -> Endpoint -> Bool)
-> (Endpoint -> Endpoint -> Bool)
-> (Endpoint -> Endpoint -> Endpoint)
-> (Endpoint -> Endpoint -> Endpoint)
-> Ord Endpoint
Endpoint -> Endpoint -> Bool
Endpoint -> Endpoint -> Ordering
Endpoint -> Endpoint -> Endpoint
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Endpoint -> Endpoint -> Endpoint
$cmin :: Endpoint -> Endpoint -> Endpoint
max :: Endpoint -> Endpoint -> Endpoint
$cmax :: Endpoint -> Endpoint -> Endpoint
>= :: Endpoint -> Endpoint -> Bool
$c>= :: Endpoint -> Endpoint -> Bool
> :: Endpoint -> Endpoint -> Bool
$c> :: Endpoint -> Endpoint -> Bool
<= :: Endpoint -> Endpoint -> Bool
$c<= :: Endpoint -> Endpoint -> Bool
< :: Endpoint -> Endpoint -> Bool
$c< :: Endpoint -> Endpoint -> Bool
compare :: Endpoint -> Endpoint -> Ordering
$ccompare :: Endpoint -> Endpoint -> Ordering
$cp1Ord :: Eq Endpoint
Ord)

pTransport :: Show a => a -> B.ByteString
pTransport :: a -> ByteString
pTransport x :: a
x = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x

pEndpoint :: Endpoint -> B.ByteString
pEndpoint :: Endpoint -> ByteString
pEndpoint (Endpoint t :: Transport
t a :: ByteString
a Nothing) = [ByteString] -> ByteString
B.concat [Transport -> ByteString
forall a. Show a => a -> ByteString
pTransport Transport
t, "://" , ByteString
a]
pEndpoint (Endpoint t :: Transport
t a :: ByteString
a (Just p :: Int
p)) = [ByteString] -> ByteString
B.concat [Transport -> ByteString
forall a. Show a => a -> ByteString
pTransport Transport
t, "://" , ByteString
a, ":", String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
p]

newEndpoint :: Transport -> Address -> Endpoint
newEndpoint :: Transport -> ByteString -> Endpoint
newEndpoint transport :: Transport
transport addr :: ByteString
addr = Transport -> ByteString -> Maybe Int -> Endpoint
newEndpointPort' Transport
transport ByteString
addr Maybe Int
forall a. Maybe a
Nothing

newEndpointAddrInfo :: Transport -> AddrInfo -> Endpoint
newEndpointAddrInfo :: Transport -> AddrInfo -> Endpoint
newEndpointAddrInfo transport :: Transport
transport addr :: AddrInfo
addr = Transport -> AddrInfo -> Maybe Int -> Endpoint
newEndpointPortAddrInfo' Transport
transport AddrInfo
addr Maybe Int
forall a. Maybe a
Nothing

newEndpointPort' :: Transport -> Address -> Maybe Port -> Endpoint
newEndpointPort' :: Transport -> ByteString -> Maybe Int -> Endpoint
newEndpointPort' transport :: Transport
transport addr :: ByteString
addr port :: Maybe Int
port = Transport -> ByteString -> Maybe Int -> Endpoint
Endpoint Transport
transport ByteString
addr Maybe Int
port

newEndpointPortAddrInfo' :: Transport -> AddrInfo -> Maybe Port -> Endpoint
newEndpointPortAddrInfo' :: Transport -> AddrInfo -> Maybe Int -> Endpoint
newEndpointPortAddrInfo' transport :: Transport
transport addr :: AddrInfo
addr port :: Maybe Int
port = Transport -> ByteString -> Maybe Int -> Endpoint
newEndpointPort' Transport
transport (SockAddr -> ByteString
showSockAddrBS (SockAddr -> ByteString) -> SockAddr -> ByteString
forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
addrAddress AddrInfo
addr) Maybe Int
port

newEndpointPort :: Transport -> Address -> Port -> Endpoint
newEndpointPort :: Transport -> ByteString -> Int -> Endpoint
newEndpointPort transport :: Transport
transport addr :: ByteString
addr port :: Int
port = Transport -> ByteString -> Maybe Int -> Endpoint
newEndpointPort' Transport
transport ByteString
addr (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
port)

newEndpointPortAddrInfo :: Transport -> AddrInfo -> Port -> Endpoint
newEndpointPortAddrInfo :: Transport -> AddrInfo -> Int -> Endpoint
newEndpointPortAddrInfo transport :: Transport
transport addr :: AddrInfo
addr port :: Int
port = Transport -> AddrInfo -> Maybe Int -> Endpoint
newEndpointPortAddrInfo' Transport
transport AddrInfo
addr (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
port)

newTCPEndpoint :: Address -> Port -> Endpoint
newTCPEndpoint :: ByteString -> Int -> Endpoint
newTCPEndpoint addr :: ByteString
addr port :: Int
port = Transport -> ByteString -> Int -> Endpoint
newEndpointPort Transport
TCP ByteString
addr Int
port

newUDPEndpoint :: Address -> Port -> Endpoint
newUDPEndpoint :: ByteString -> Int -> Endpoint
newUDPEndpoint addr :: ByteString
addr port :: Int
port = Transport -> ByteString -> Int -> Endpoint
newEndpointPort Transport
UDP ByteString
addr Int
port

newTCPEndpointAddrInfo :: AddrInfo -> Port -> Endpoint
newTCPEndpointAddrInfo :: AddrInfo -> Int -> Endpoint
newTCPEndpointAddrInfo addr :: AddrInfo
addr port :: Int
port = Transport -> AddrInfo -> Int -> Endpoint
newEndpointPortAddrInfo Transport
TCP AddrInfo
addr Int
port

toAddrInfo :: Endpoint -> IO [AddrInfo]
toAddrInfo :: Endpoint -> IO [AddrInfo]
toAddrInfo (Endpoint _ a :: ByteString
a (Just p :: Int
p)) = Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo Maybe AddrInfo
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B.unpack ByteString
a) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
p)
toAddrInfo (Endpoint _ a :: ByteString
a _) = Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo Maybe AddrInfo
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B.unpack ByteString
a) Maybe String
forall a. Maybe a
Nothing

parseTransport :: Parser Transport
parseTransport :: Parser Transport
parseTransport = do
  ByteString
t <- (Char -> Bool) -> Parser ByteString
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=':')
  ByteString
_ <- ByteString -> Parser ByteString
string "://"
  Transport
r <- case ByteString
t of
    "tcp"    -> Transport -> Parser Transport
forall (f :: * -> *) a. Applicative f => a -> f a
pure Transport
TCP
    "udp"    -> Transport -> Parser Transport
forall (f :: * -> *) a. Applicative f => a -> f a
pure Transport
UDP
    "ipc"    -> Transport -> Parser Transport
forall (f :: * -> *) a. Applicative f => a -> f a
pure Transport
IPC
    "inproc" -> Transport -> Parser Transport
forall (f :: * -> *) a. Applicative f => a -> f a
pure Transport
InProc
    "pgm"    -> Transport -> Parser Transport
forall (f :: * -> *) a. Applicative f => a -> f a
pure Transport
PGM
    "epgm"   -> Transport -> Parser Transport
forall (f :: * -> *) a. Applicative f => a -> f a
pure Transport
EPGM
    _ -> String -> Parser Transport
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Transport) -> String -> Parser Transport
forall a b. (a -> b) -> a -> b
$ "Unknown transport " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ByteString -> String
B.unpack ByteString
t)

  Transport -> Parser Transport
forall (m :: * -> *) a. Monad m => a -> m a
return Transport
r

parseAddress :: Parser Address
parseAddress :: Parser ByteString
parseAddress = (Char -> Bool) -> Parser ByteString
A.takeWhile(Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=':')

parsePort :: Parser Port
parsePort :: Parser Int
parsePort = do
  Char
_ <- Char -> Parser Char
char ':'
  Int
d <- Parser Int
forall a. Integral a => Parser a
decimal
  Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
d

parseEndpoint :: Parser Endpoint
parseEndpoint :: Parser Endpoint
parseEndpoint = Transport -> ByteString -> Maybe Int -> Endpoint
Endpoint (Transport -> ByteString -> Maybe Int -> Endpoint)
-> Parser Transport
-> Parser ByteString (ByteString -> Maybe Int -> Endpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Transport
parseTransport Parser ByteString (ByteString -> Maybe Int -> Endpoint)
-> Parser ByteString -> Parser ByteString (Maybe Int -> Endpoint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
parseAddress Parser ByteString (Maybe Int -> Endpoint)
-> Parser ByteString (Maybe Int) -> Parser Endpoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
parsePort

parseTCPEndpoint :: Parser Endpoint
parseTCPEndpoint :: Parser Endpoint
parseTCPEndpoint = Transport -> ByteString -> Maybe Int -> Endpoint
Endpoint (Transport -> ByteString -> Maybe Int -> Endpoint)
-> Parser Transport
-> Parser ByteString (ByteString -> Maybe Int -> Endpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transport -> Parser Transport
forall (f :: * -> *) a. Applicative f => a -> f a
pure Transport
TCP Parser ByteString (ByteString -> Maybe Int -> Endpoint)
-> Parser ByteString -> Parser ByteString (Maybe Int -> Endpoint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
parseAddress Parser ByteString (Maybe Int -> Endpoint)
-> Parser ByteString (Maybe Int) -> Parser Endpoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
parsePort

parseUDPEndpoint :: Parser Endpoint
parseUDPEndpoint :: Parser Endpoint
parseUDPEndpoint = Transport -> ByteString -> Maybe Int -> Endpoint
Endpoint (Transport -> ByteString -> Maybe Int -> Endpoint)
-> Parser Transport
-> Parser ByteString (ByteString -> Maybe Int -> Endpoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transport -> Parser Transport
forall (f :: * -> *) a. Applicative f => a -> f a
pure Transport
UDP Parser ByteString (ByteString -> Maybe Int -> Endpoint)
-> Parser ByteString -> Parser ByteString (Maybe Int -> Endpoint)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
parseAddress Parser ByteString (Maybe Int -> Endpoint)
-> Parser ByteString (Maybe Int) -> Parser Endpoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
parsePort

parseAttoEndpoint :: B.ByteString -> Either String Endpoint
parseAttoEndpoint :: ByteString -> Either String Endpoint
parseAttoEndpoint = Parser Endpoint -> ByteString -> Either String Endpoint
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser Endpoint
parseEndpoint

parseAttoTCPEndpoint :: B.ByteString -> Either String Endpoint
parseAttoTCPEndpoint :: ByteString -> Either String Endpoint
parseAttoTCPEndpoint = Parser Endpoint -> ByteString -> Either String Endpoint
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser Endpoint
parseTCPEndpoint

parseAttoUDPEndpoint :: B.ByteString -> Either String Endpoint
parseAttoUDPEndpoint :: ByteString -> Either String Endpoint
parseAttoUDPEndpoint = Parser Endpoint -> ByteString -> Either String Endpoint
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser Endpoint
parseUDPEndpoint

endpointAddr :: Endpoint -> Address
endpointAddr :: Endpoint -> ByteString
endpointAddr (Endpoint _ a :: ByteString
a _) = ByteString
a

endpointPort :: Endpoint -> Maybe Port
endpointPort :: Endpoint -> Maybe Int
endpointPort (Endpoint _ _ p :: Maybe Int
p) = Maybe Int
p

endpointTransport :: Endpoint -> Transport
endpointTransport :: Endpoint -> Transport
endpointTransport (Endpoint t :: Transport
t _ _) = Transport
t