module Network.HostAndPort
    ( ConnectionDetail(..)
    , RemoteAddr
    , isIPv4Address
    , isIPv6Address
    , hostAndPort
    , detailedHostAndPort
    , maybeHostAndPort
    , defaultHostAndPort
    ) where


import Control.Monad
import Data.Maybe
import Control.Applicative hiding((<|>), many)
import Control.Arrow (second)
import Text.Parsec


data ConnectionDetail a = IPv4Address a
                        | IPv6Address a
                        | HostName a
    deriving(Show, Eq, Ord)


type Parser = Parsec String ()
type RemoteAddr = ConnectionDetail String


countMinMax :: (Stream s m t) => Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]
countMinMax m x p
    | m > 0 = do
        f <- p
        end <- countMinMax (m - 1) (x - 1) p
        return $ f : end
    | x <= 0 = return []
    | otherwise = option [] $ do
        f <- p
        end <- countMinMax 0 (x - 1) p
        return $ f : end


intDigits :: Int -> Int
intDigits = length . show


limitedInt :: Int -> String -> Parser String
limitedInt x e = do
    b <- countMinMax 1 (intDigits x) digit
    if (read b :: Int) > x
        then fail e
        else return b


byteNum :: Parser String
byteNum = limitedInt 255 "Value to large"


consequence :: (Monad m) => [m [a]] -> m [a]
consequence v = liftM concat $ sequence v


ipv4address :: Parser String
ipv4address = consequence [
    byteNum, string ".",
    byteNum, string ".",
    byteNum, string ".", byteNum] <?> "bad IPv4 address"


hexShortNum :: Parser String
hexShortNum = countMinMax 1 4 hexDigit


port :: Parser String
port = limitedInt 65535 "Port number to large"


ipv6address :: Parser String
ipv6address = do
    let ipv6variants = (try <$> skippedAtBegin)
                        ++ [try full]
                        ++ (try <$> skippedAtMiddle)
                        ++ (try <$> skippedAtEnd)
                        ++ [last2 False]
    choice ipv6variants <?> "bad IPv6 address"
  where
    h4s = (++) <$> hexShortNum <*> string ":"
    sh4 = (++) <$> string ":" <*> hexShortNum
    execNum 0 = return ""
    execNum n = concat <$> count n h4s
    partNum 0 = return ""
    partNum n = do
        f <- hexShortNum
        e <- countMinMax 0 (n - 1) (try sh4)
        return $ f ++ concat e

    maybeNum n = concat <$> countMinMax 0 n h4s
    last2f = try ipv4address <|> consequence [h4s, hexShortNum]
    last2 f = if f
        then last2f
        else choice [try last2f,
                     try $ consequence [string "::", hexShortNum],
                     consequence [hexShortNum, string "::"]]

    skippedAtBegin =
        map (\i -> consequence [string "::", execNum i, last2 True]) [5,4..0]

    skippedAtMiddle = [
        consequence [partNum 1, string "::", maybeNum 4, last2 True],
        consequence [partNum 2, string "::", maybeNum 3, last2 True],
        consequence [partNum 3, string "::", maybeNum 2, last2 True],
        consequence [partNum 4, string "::", maybeNum 1, last2 True],
        consequence [partNum 5, string "::", last2 True],
        consequence [partNum 6, string "::", hexShortNum]]

    skippedAtEnd = [consequence [partNum 7, string "::"]]

    full = consequence [concat <$> count 6 h4s, last2 True]


ipv6addressWithScope :: Parser String
ipv6addressWithScope = consequence [ipv6address, option "" scope]
  where
    scope = consequence [string "%", many1 asciiAlphaNum]


hostname :: Parser String
hostname = many1 $ alphaNum <|> oneOf ".-_"


isParsed :: Parser a -> String -> Bool
isParsed p s = case runParser p () "" s of
    (Right _) -> True
    (Left _) -> False


-- | This function will validate ipv4 address
-- and return True if string is valid adress
isIPv4Address :: String -> Bool
isIPv4Address = isParsed $ ipv4address <* eof


-- | Function validates ipv6 address
isIPv6Address :: String -> Bool
isIPv6Address = isParsed $ ipv6addressWithScope <* eof


isAsciiAlpha :: Char -> Bool
isAsciiAlpha c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')


isAsciiNum :: Char -> Bool
isAsciiNum c = (c >= '0' && c <= '9')


isAsciiAlphaNum :: Char -> Bool
isAsciiAlphaNum c = isAsciiAlpha c || isAsciiNum c


asciiAlphaNum :: Parser Char
asciiAlphaNum = satisfy isAsciiAlphaNum


connectionStr :: (String -> a) ->
                 (String -> a) ->
                 (String -> a) -> Parser (a, Maybe String)
connectionStr ipv6Fun ipv4Fun hostFun = do
    addr <- try (ipv6Fun <$> ipv6str)
                <|> try (ipv4Fun <$> ipv4address)
                <|> (hostFun <$> hostname)
    p <- maybePort
    return (addr, p)
  where
    ipv6str = do
        void $ char '['
        ipv6 <- ipv6addressWithScope
        void $ char ']'
        return ipv6
    maybePort = option Nothing $ char ':' >> Just <$> port


-- | This function will parse it's argument and return either
-- `String` (`Left`) in case of error or (`ConnectionDetail String`, Maybe Port)
-- tuple (`Right`).
--
-- Examples:
--
-- >>> detailedHostAndPort "localhost"
-- Right (HostName "localhost",Nothing)
-- >>> detailedHostAndPort "[::1]:3030"
-- Right (IPv6Address "::1",Just "3030")
-- >>> detailedHostAndPort "127.0.0.1:1080"
-- Right (IPv4Address "127.0.0.1",Just "1080")
--
-- /Since/ 0.2
detailedHostAndPort :: String -> Either String (RemoteAddr, Maybe String)
detailedHostAndPort s = case runParser parser () "" s of
    (Right v) -> Right v
    (Left e) -> Left $ show e
  where
    parser = connectionStr IPv6Address IPv4Address HostName <* eof


-- | This function will parse it's argument and return either
-- `String` (`Left`) with info about error or (Host, `Maybe` Port)
-- tuple (`Right`).
--
-- Examples:
--
-- >>> hostAndPort "localhost"
-- Right ("localhost",Nothing)
-- >>> hostAndPort "[::1]:3030"
-- Right ("::1",Just "3030")
hostAndPort :: String -> Either String (String, Maybe String)
hostAndPort s = case runParser (connectionStr id id id <* eof) () "" s of
    (Right v) -> Right v
    (Left e) -> Left $ show e


-- | Function will parse argument and return Maybe (Host, Maybe Port)
--
-- Examples:
--
-- >>> maybeHostAndPort "192.168.10.12"
-- Just ("192.168.10.12",Nothing)
-- >>> maybeHostAndPort "192.168.10.12:7272"
-- Just ("192.168.10.12",Just "7272")
maybeHostAndPort :: String -> Maybe (String, Maybe String)
maybeHostAndPort s = either (const Nothing) Just $ hostAndPort s


-- | Function will take default port and connection string
-- and returns Just (Host, Port) for valid input and
-- Nothing for invalid.
--
-- Examples:
--
-- >>> defaultHostAndPort "22" "my.server.com"
-- Just ("my.server.com","22")
-- >>> defaultHostAndPort "22" "my.otherserver.com:54022"
-- Just ("my.otherserver.com","54022")
-- >>> defaultHostAndPort "22" "porttobig.com:500022"
-- Nothing
defaultHostAndPort :: String                    -- ^ default Port number
                   -> String                    -- ^ connection string
                   -> Maybe (String, String)    -- ^ Maybe (Host, Port)
defaultHostAndPort p s = second (fromMaybe p) <$> maybeHostAndPort s