{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

module Metro.SocketServer
  ( SocketServer
  , socketServer
  , SSSID (..)
  ) where

import           Data.List       (isPrefixOf)
import           Metro.Class     (Servable (..), Transport (..),
                                  TransportConfig)
import           Metro.TCPServer
import qualified Metro.TP.Socket as T (Socket, mapTCPSocket, mapUDPSocket)
import           Metro.UDPServer
import           Network.Socket  (SockAddr, Socket)

data SocketServer = TCP TCPServer
    | UDP UDPServer

data SSSID = TCPSID Socket
    | UDPSID SockAddr

instance Servable SocketServer where
  data ServerConfig SocketServer = SSConfig String
  type SID SocketServer = SSSID
  type STP SocketServer = T.Socket
  newServer :: ServerConfig SocketServer -> m SocketServer
newServer (SSConfig hostPort) =
    if [Char]
"udp" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
hostPort then UDPServer -> SocketServer
UDP (UDPServer -> SocketServer) -> m UDPServer -> m SocketServer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServerConfig UDPServer -> m UDPServer
forall serv (m :: * -> *).
(Servable serv, MonadIO m) =>
ServerConfig serv -> m serv
newServer ([Char] -> ServerConfig UDPServer
udpServer [Char]
hostPort)
    else TCPServer -> SocketServer
TCP (TCPServer -> SocketServer) -> m TCPServer -> m SocketServer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServerConfig TCPServer -> m TCPServer
forall serv (m :: * -> *).
(Servable serv, MonadIO m) =>
ServerConfig serv -> m serv
newServer ([Char] -> ServerConfig TCPServer
tcpServer [Char]
hostPort)
  servOnce :: SocketServer
-> (Maybe (SID SocketServer, TransportConfig (STP SocketServer))
    -> m ())
-> m ()
servOnce (TCP TCPServer
s) Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done = TCPServer
-> (Maybe (SID TCPServer, TransportConfig (STP TCPServer)) -> m ())
-> m ()
forall serv (m :: * -> *).
(Servable serv, MonadUnliftIO m) =>
serv
-> (Maybe (SID serv, TransportConfig (STP serv)) -> m ()) -> m ()
servOnce TCPServer
s ((Maybe (SID TCPServer, TransportConfig (STP TCPServer)) -> m ())
 -> m ())
-> (Maybe (SID TCPServer, TransportConfig (STP TCPServer)) -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ (Maybe (SID SocketServer, TransportConfig (STP SocketServer))
 -> m ())
-> Maybe (SID TCPServer, TransportConfig (STP TCPServer)) -> m ()
forall (m :: * -> *).
(Maybe (SID SocketServer, TransportConfig (STP SocketServer))
 -> m ())
-> Maybe (SID TCPServer, TransportConfig (STP TCPServer)) -> m ()
mapTCPServOnceDone Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done
  servOnce (UDP UDPServer
s) Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done = UDPServer
-> (Maybe (SID UDPServer, TransportConfig (STP UDPServer)) -> m ())
-> m ()
forall serv (m :: * -> *).
(Servable serv, MonadUnliftIO m) =>
serv
-> (Maybe (SID serv, TransportConfig (STP serv)) -> m ()) -> m ()
servOnce UDPServer
s ((Maybe (SID UDPServer, TransportConfig (STP UDPServer)) -> m ())
 -> m ())
-> (Maybe (SID UDPServer, TransportConfig (STP UDPServer)) -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ (Maybe (SID SocketServer, TransportConfig (STP SocketServer))
 -> m ())
-> Maybe (SID UDPServer, TransportConfig (STP UDPServer)) -> m ()
forall (m :: * -> *).
(Maybe (SID SocketServer, TransportConfig (STP SocketServer))
 -> m ())
-> Maybe (SID UDPServer, TransportConfig (STP UDPServer)) -> m ()
mapUDPServOnceDone Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done
  onConnEnter :: SocketServer -> SID SocketServer -> m ()
onConnEnter (TCP TCPServer
s) (TCPSID sid) = TCPServer -> SID TCPServer -> m ()
forall serv (m :: * -> *).
(Servable serv, MonadIO m) =>
serv -> SID serv -> m ()
onConnEnter TCPServer
s SID TCPServer
Socket
sid
  onConnEnter (UDP UDPServer
s) (UDPSID sid) = UDPServer -> SID UDPServer -> m ()
forall serv (m :: * -> *).
(Servable serv, MonadIO m) =>
serv -> SID serv -> m ()
onConnEnter UDPServer
s SID UDPServer
SockAddr
sid
  onConnEnter SocketServer
_ SID SocketServer
_                  = [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"onConnEnter invalid type"
  onConnLeave :: SocketServer -> SID SocketServer -> m ()
onConnLeave (TCP TCPServer
s) (TCPSID sid) = TCPServer -> SID TCPServer -> m ()
forall serv (m :: * -> *).
(Servable serv, MonadIO m) =>
serv -> SID serv -> m ()
onConnLeave TCPServer
s SID TCPServer
Socket
sid
  onConnLeave (UDP UDPServer
s) (UDPSID sid) = UDPServer -> SID UDPServer -> m ()
forall serv (m :: * -> *).
(Servable serv, MonadIO m) =>
serv -> SID serv -> m ()
onConnLeave UDPServer
s SID UDPServer
SockAddr
sid
  onConnLeave SocketServer
_ SID SocketServer
_                  = [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"onConnLeave invalid type"
  servClose :: SocketServer -> m ()
servClose (TCP TCPServer
s) = TCPServer -> m ()
forall serv (m :: * -> *).
(Servable serv, MonadIO m) =>
serv -> m ()
servClose TCPServer
s
  servClose (UDP UDPServer
s) = UDPServer -> m ()
forall serv (m :: * -> *).
(Servable serv, MonadIO m) =>
serv -> m ()
servClose UDPServer
s

mapTCPServOnceDone
  :: (Maybe (SID SocketServer, TransportConfig (STP SocketServer)) -> m ())
  -> Maybe (SID TCPServer, TransportConfig (STP TCPServer)) -> m ()
mapTCPServOnceDone :: (Maybe (SID SocketServer, TransportConfig (STP SocketServer))
 -> m ())
-> Maybe (SID TCPServer, TransportConfig (STP TCPServer)) -> m ()
mapTCPServOnceDone Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done Maybe (SID TCPServer, TransportConfig (STP TCPServer))
Nothing = Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done Maybe (SID SocketServer, TransportConfig (STP SocketServer))
forall a. Maybe a
Nothing
mapTCPServOnceDone Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done (Just (SID TCPServer
sid, TransportConfig (STP TCPServer)
stp)) = Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done ((SSSID, TransportConfig Socket)
-> Maybe (SSSID, TransportConfig Socket)
forall a. a -> Maybe a
Just (Socket -> SSSID
TCPSID SID TCPServer
Socket
sid, TransportConfig TCPSocket -> TransportConfig Socket
T.mapTCPSocket TransportConfig (STP TCPServer)
TransportConfig TCPSocket
stp))

mapUDPServOnceDone
  :: (Maybe (SID SocketServer, TransportConfig (STP SocketServer)) -> m ())
  -> Maybe (SID UDPServer, TransportConfig (STP UDPServer)) -> m ()
mapUDPServOnceDone :: (Maybe (SID SocketServer, TransportConfig (STP SocketServer))
 -> m ())
-> Maybe (SID UDPServer, TransportConfig (STP UDPServer)) -> m ()
mapUDPServOnceDone Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done Maybe (SID UDPServer, TransportConfig (STP UDPServer))
Nothing = Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done Maybe (SID SocketServer, TransportConfig (STP SocketServer))
forall a. Maybe a
Nothing
mapUDPServOnceDone Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done (Just (SID UDPServer
sid, TransportConfig (STP UDPServer)
stp)) = Maybe (SID SocketServer, TransportConfig (STP SocketServer))
-> m ()
done ((SSSID, TransportConfig Socket)
-> Maybe (SSSID, TransportConfig Socket)
forall a. a -> Maybe a
Just (SockAddr -> SSSID
UDPSID SID UDPServer
SockAddr
sid, TransportConfig UDPSocket -> TransportConfig Socket
T.mapUDPSocket TransportConfig (STP UDPServer)
TransportConfig UDPSocket
stp))

socketServer :: String -> ServerConfig SocketServer
socketServer :: [Char] -> ServerConfig SocketServer
socketServer = [Char] -> ServerConfig SocketServer
SSConfig