{-| Internet Gopher Protocol server framework.
-}
module Venusia.Server where

import Network.Socket
import qualified Network.Socket.ByteString as NBS
import qualified Data.ByteString.Char8 as BS
import Control.Concurrent (forkIO)
import Control.Monad (forever, void)
import Data.List (isPrefixOf)

-- | Standard invalid selector response
invalidSelector :: BS.ByteString
invalidSelector = error "Invalid selector"

-- | A Gopher request with selector and optional query
data Request = Request
  { reqSelector :: BS.ByteString       -- The selector part (before tab)
  , reqWildcard :: Maybe BS.ByteString -- Captured wildcard content (if any)
  , reqQuery    :: Maybe BS.ByteString -- The query part (after tab, if any)
  } deriving (Show)

-- | A handler processes a request and returns a response
type Handler = Request -> IO BS.ByteString

-- | A route matches requests and handles them
data Route = Route
  { matchRoute :: BS.ByteString -> Maybe Request
  , runHandler :: Handler
  }

-- | Parse a raw Gopher request into selector and query parts
parseRequest :: BS.ByteString -> (BS.ByteString, Maybe BS.ByteString)
parseRequest raw = 
  case BS.split '\t' raw of
    (sel:q:_) -> (sel, Just q)
    [sel]     -> (sel, Nothing)
    _         -> (raw, Nothing)

-- | Create a route for exact selector matching
on :: BS.ByteString -> Handler -> Route
on path handler = Route matcher handler
  where
    matcher raw = 
      let (sel, q) = parseRequest raw
      in if sel == path
         then Just $ Request sel Nothing q
         else Nothing

-- | Create a route with wildcard path matching
onWildcard :: BS.ByteString -> Handler -> Route
onWildcard pattern handler = Route matcher handler
  where
    matcher raw =
      let (sel, q) = parseRequest raw
          (prefix, rest) = BS.breakSubstring "*" pattern
          suffix = BS.drop 1 rest  -- Skip the "*" character
      in case BS.stripPrefix prefix sel of
           Just afterPrefix ->
             -- Now check if the remaining part ends with suffix
             if BS.isSuffixOf suffix afterPrefix
               then 
                 -- Calculate the part that matched the wildcard
                 let wildcardLen = BS.length afterPrefix - BS.length suffix
                     wildcardPart = BS.take wildcardLen afterPrefix
                 in Just $ Request 
                      { reqSelector = sel
                      , reqWildcard = Just wildcardPart
                      , reqQuery = q
                      }
               else Nothing
           Nothing -> Nothing

-- | Dispatch a request to the first matching route
dispatch :: [Route] -> BS.ByteString -> IO BS.ByteString
dispatch routes req = go routes
  where
    go [] = return invalidSelector
    go (Route match handle : rs) =
      case match req of
        Just request -> handle request
        Nothing -> go rs

-- | Start the Gopher server on the specified port
serve :: String -> [Route] -> IO ()
serve port routes = withSocketsDo $ do
  addr <- resolve port
  sock <- open addr
  putStrLn $ "Gopher server running on port " ++ port
  forever $ do
    (conn, _) <- accept sock
    void $ forkIO $ handleConn routes conn
  where
    resolve p = do
      let hints = defaultHints { addrFlags = [AI_PASSIVE]
                             , addrSocketType = Stream }
      addr:_ <- getAddrInfo (Just hints) Nothing (Just p)
      return addr
    open addr = do
      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
      setSocketOption sock ReuseAddr 1
      bind sock (addrAddress addr)
      listen sock 10
      return sock

-- | Handle an individual connection
handleConn :: [Route] -> Socket -> IO ()
handleConn routes sock = do
  req <- NBS.recv sock 1024
  let trimmedReq = BS.strip req
  putStrLn $ "Received request: " ++ show trimmedReq
  response <- dispatch routes trimmedReq
  NBS.sendAll sock response
  close sock