IP.hs

{-# LANGUAGE
    OverloadedLists
  , OverloadedStrings
  , RecordWildCards
  #-}

module Data.Attoparsec.IP (ipv4, ipv6) where

import Data.Attoparsec.Text (Parser) --, char, string, digit, hexadecimal, many1)
-- import Data.Word (Word8, Word16)
-- import Data.Vector (Vector)
-- import qualified Data.Vector as V
-- import Data.Monoid ((<>))
-- import Control.Applicative ((<|>))
-- import Control.Monad (void)
import Net.Types (IPv4, IPv6)
import qualified Net.IPv4 as IPv4
import qualified Net.IPv6 as IPv6

ipv4 :: Parser IPv4
ipv4 = IPv4.parser

ipv6 :: Parser IPv6
ipv6 = IPv6.parser

-- ipv4 :: Parser IPv4
-- ipv4 = do
--   a <- octet
--   void (char '.')
--   b <- octet
--   void (char '.')
--   c <- octet
--   void (char '.')
--   d <- octet
--   pure (IPv4.fromOctets a b c d)
--   where
--     octet :: Parser Word8
--     octet = do
--       (a,b,c) <-
--         let oneDigit = do
--               n <- digit
--               pure ('0','0',n)
--             twoDigit = do
--               n <- digit
--               m <- digit
--               pure ('0',n,m)
--             threeDigit = do
--               n <- digit
--               m <- digit
--               o <- digit
--               pure (n,m,o)
--         in  threeDigit <|> twoDigit <|> oneDigit
--       let n :: Word8
--           n = read (a:b:c:[])
--       pure n


-- data IPv6Divider
--   = DividerColon
--   | DoubleColon
--   deriving (Show)

-- parseDividerOrDoubleColon :: Parser IPv6Divider
-- parseDividerOrDoubleColon =
--   let divider = DividerColon <$ char ':'
--       doubleColon = DoubleColon <$ string "::"
--   in  doubleColon <|> divider

-- parseHextet :: Parser IPv6Chunk
-- parseHextet = Hextet <$> hexadecimal

-- parseHextets :: Parser [IPv6Chunk]
-- parseHextets = many1 (parseHextet <|> (Divider <$> parseDividerOrDoubleColon))

-- data IPv6Chunk
--   = Hextet Word16
--   | Divider IPv6Divider
--   deriving (Show)

-- data IPv6TokenPos
--   = Init
--   | A
--   | B
--   | C
--   | D
--   | E
--   | F
--   | G
--   | Finished
--   deriving (Show, Eq, Ord, Enum, Bounded)

-- data IPv6State = IPv6State
--   { hextets :: Vector Word16
--   , current :: IPv6TokenPos
--   , doublePos :: Maybe IPv6TokenPos
--   } deriving (Show)

-- initIPv6State :: IPv6State
-- initIPv6State = IPv6State [] Init Nothing

-- accumIPv6State :: [IPv6Chunk] -> IPv6State
-- accumIPv6State xs =
--   let go :: IPv6State -> IPv6Chunk -> IPv6State
--       go xss@IPv6State{..} x = case x of
--         Divider d -> case d of
--           DoubleColon -> xss { doublePos = Just current }
--           DividerColon -> xss
--         Hextet n -> xss { hextets = V.snoc hextets n, current = succ current }
--   in  foldl go initIPv6State xs

-- ipv6StateToIPv6 :: IPv6State -> Maybe IPv6
-- ipv6StateToIPv6 IPv6State{..} = case doublePos of
--   Nothing -> case V.toList hextets of
--     (a:b:c:d:e:f:g:h:_) -> Just (IPv6.fromWord16s a b c d e f g h)
--     _ -> Nothing
--   Just p ->
--     let zeros = V.replicate (8 - V.length hextets) 0
--         composite = case p of
--           Init -> Just (zeros <> hextets)
--           A -> case V.toList hextets of
--             (a:hs) -> Just ([a] <> zeros <> V.fromList hs)
--             _ -> Nothing
--           B -> case V.toList hextets of
--             (a:b:hs) -> Just ([a,b] <> zeros <> V.fromList hs)
--             _ -> Nothing
--           C -> case V.toList hextets of
--             (a:b:c:hs) -> Just ([a,b,c] <> zeros <> V.fromList hs)
--             _ -> Nothing
--           D -> case V.toList hextets of
--             (a:b:c:d:hs) -> Just ([a,b,c,d] <> zeros <> V.fromList hs)
--             _ -> Nothing
--           E -> case V.toList hextets of
--             (a:b:c:d:e:hs) -> Just ([a,b,c,d,e] <> zeros <> V.fromList hs)
--             _ -> Nothing
--           F -> case V.toList hextets of
--             (a:b:c:d:e:f:hs) -> Just ([a,b,c,d,e,f] <> zeros <> V.fromList hs)
--             _ -> Nothing
--           G -> case V.toList hextets of
--             (a:b:c:d:e:f:g:hs) -> Just ([a,b,c,d,e,f,g] <> zeros <> V.fromList hs)
--             _ -> Nothing
--           Finished -> case V.toList hextets of
--             (a:b:c:d:e:f:g:h:_) -> Just [a,b,c,d,e,f,g,h]
--             _ -> Nothing
--     in  case V.toList <$> composite of
--       Just (a:b:c:d:e:f:g:h:_) -> Just (IPv6.fromWord16s a b c d e f g h)
--       _ -> Nothing

-- ipv6 :: Parser IPv6
-- ipv6 = do
--   s <- parseHextets
--   case toIPv6 s of
--     Nothing -> fail "Not an IPv6"
--     Just x -> pure x
--   where
--     toIPv6 :: [IPv6Chunk] -> Maybe IPv6
--     toIPv6 = ipv6StateToIPv6 . accumIPv6State