Target.hs

{- This file is part of irc-fun-messages.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Network.IRC.Fun.Messages.Internal.Tokens.Target
    ( target
    , msgtarget
    , msgto
    , channel
    , servername
    , host
    , nickname
    )
where

import Data.Char (isAsciiUpper)
import Network.IRC.Fun.Messages.Internal.Types hiding (target)
import Network.IRC.Fun.Messages.Internal.Tokens.Other
import Network.IRC.Fun.Messages.Internal.Tokens.Wildcards
import Text.Regex.Applicative

target :: Regex Target
target = NickTarget <$> nickname <|> ServerTarget <$> servername

msgtarget :: Regex [MessageTarget]
msgtarget = (:) <$> msgto <*> many (sym ',' *> msgto)

msgto :: Regex MessageTarget
msgto = ChannelTarget <$> channel
    <|> uhs <$> user
            <*> optional (sym '%' *> host) <* sym '@'
            <*> servername
    <|> uh <$> user <* sym '%'
           <*> host
    <|> MaskTarget <$> targetmask
    <|> nn <$> nickname
    <|> nuh <$> nickname <* sym '!'
            <*> user <* sym '@'
            <*> host
    where
    uhs u h s = UserTarget Nothing  (Just (UserAddr u h))        (Just s)
    uh  u h   = UserTarget Nothing  (Just (UserAddr u (Just h))) Nothing
    nn  n     = UserTarget (Just n) Nothing                      Nothing
    nuh n u h = UserTarget (Just n) (Just (UserAddr u (Just h))) Nothing

channel :: Regex ChannelName
channel = fmap snd $ withMatched $
    (sym '#' <|> sym '+' <|> sym '!' <* channelid <|> sym '&') <*
    chanstring <*
    optional (sym ':' <* chanstring)

servername :: Regex ServerName
servername = hostname

host :: Regex Host
host = HostName  <$> hostname
   <|> HostAddr  <$> hostaddr
   <|> HostCloak <$> hostcloak

hostname :: Regex String
hostname = snd <$> withMatched (shortname <* many (sym '.' <* shortname))

shortname :: Regex String
shortname =
    snd <$> withMatched
        ( (letter <|> digit) <*
          optional (many (letter <|> digit <|> sym '-') <* (letter <|> digit))
        )

hostaddr :: Regex Address
hostaddr = IPv4 <$> ip4addr <|> IPv6 <$> ip6addr

ip4addr :: Regex String
ip4addr = snd <$> withMatched (s <* p <* s <* p <* s <* p <* s)
    where
    d = digit
    s = snd <$> withMatched (d  <|>  d <* d  <|>  d <* d <* d)
    p = sym '.'

ip6addr :: Regex String
ip6addr = snd <$> withMatched (a <|> b)
    where
    h = some hexdigit
    c = sym ':'
    a = h <* c <* h <* c <*
        h <* c <* h <* c <*
        h <* c <* h <* c <*
        h <* c <* h <* c
    b = string "0:0:0:0:0:" <*
        (string "0" <|> string "FFFF") <*
        sym ':' <*
        ip4addr

hostcloak :: Regex String
hostcloak = some $ letter <|> digit <|> special <|> psym (`elem` ".-/")

nickname :: Regex NickName
nickname = (:) <$> (letter <|> special)
               <*> many (letter <|> digit <|> special <|> sym '-')

targetmask :: Regex TargetMask
targetmask = ServerMask <$> (sym '$' *> mask)
         <|> HostMask   <$> (sym '#' *> mask)

chanstring :: Regex String
chanstring = many $ psym (`notElem` "\0\a\r\n ,:")

channelid :: Regex String
channelid = snd <$> withMatched (c *> c *> c *> c *> c)
    where
    c = psym isAsciiUpper <|> digit