module IHP.IDE.PortConfig
( PortConfig (..)
, defaultAppPort
, findAvailablePortConfig
)
where

import ClassyPrelude
import qualified Network.Socket as Socket
import qualified UnliftIO.Exception as Exception
import Foreign.C.Error (Errno (..), eCONNREFUSED)
import GHC.IO.Exception (IOException(..))
import IHP.FrameworkConfig (defaultPort)

-- | Port configuration used for starting the different app services
data PortConfig = PortConfig
    { PortConfig -> PortNumber
appPort :: !Socket.PortNumber
    , PortConfig -> PortNumber
toolServerPort :: !Socket.PortNumber
    } deriving (Int -> PortConfig -> ShowS
[PortConfig] -> ShowS
PortConfig -> String
(Int -> PortConfig -> ShowS)
-> (PortConfig -> String)
-> ([PortConfig] -> ShowS)
-> Show PortConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortConfig] -> ShowS
$cshowList :: [PortConfig] -> ShowS
show :: PortConfig -> String
$cshow :: PortConfig -> String
showsPrec :: Int -> PortConfig -> ShowS
$cshowsPrec :: Int -> PortConfig -> ShowS
Show, PortConfig -> PortConfig -> Bool
(PortConfig -> PortConfig -> Bool)
-> (PortConfig -> PortConfig -> Bool) -> Eq PortConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PortConfig -> PortConfig -> Bool
$c/= :: PortConfig -> PortConfig -> Bool
== :: PortConfig -> PortConfig -> Bool
$c== :: PortConfig -> PortConfig -> Bool
Eq)

defaultAppPort :: Socket.PortNumber
defaultAppPort :: PortNumber
defaultAppPort = Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
defaultPort

allPorts :: PortConfig -> [Socket.PortNumber]
allPorts :: PortConfig -> [PortNumber]
allPorts PortConfig { PortNumber
toolServerPort :: PortNumber
appPort :: PortNumber
$sel:toolServerPort:PortConfig :: PortConfig -> PortNumber
$sel:appPort:PortConfig :: PortConfig -> PortNumber
.. } = [PortNumber
appPort, PortNumber
toolServerPort]

instance Enum PortConfig where
    fromEnum :: PortConfig -> Int
fromEnum PortConfig { PortNumber
toolServerPort :: PortNumber
appPort :: PortNumber
$sel:toolServerPort:PortConfig :: PortConfig -> PortNumber
$sel:appPort:PortConfig :: PortConfig -> PortNumber
.. } = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ PortNumber -> Integer
forall a. Integral a => a -> Integer
toInteger (PortNumber
appPort PortNumber -> PortNumber -> PortNumber
forall a. Num a => a -> a -> a
- PortNumber
defaultAppPort)
    toEnum :: Int -> PortConfig
toEnum Int
i = PortConfig :: PortNumber -> PortNumber -> PortConfig
PortConfig { PortNumber
toolServerPort :: PortNumber
appPort :: PortNumber
$sel:toolServerPort:PortConfig :: PortNumber
$sel:appPort:PortConfig :: PortNumber
.. }
        where
            port :: PortNumber
port = Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
            appPort :: PortNumber
appPort = PortNumber
port PortNumber -> PortNumber -> PortNumber
forall a. Num a => a -> a -> a
+ PortNumber
defaultAppPort
            toolServerPort :: PortNumber
toolServerPort = PortNumber
port PortNumber -> PortNumber -> PortNumber
forall a. Num a => a -> a -> a
+ PortNumber
defaultAppPort PortNumber -> PortNumber -> PortNumber
forall a. Num a => a -> a -> a
+ PortNumber
1

-- | Returns True when the given port looks to be free.
-- Used to e.g. detect which port the dev server should use.
isPortAvailable :: Socket.PortNumber -> IO Bool
isPortAvailable :: PortNumber -> IO Bool
isPortAvailable PortNumber
port = do
    let address :: SockAddr
address = PortNumber -> HostAddress -> SockAddr
Socket.SockAddrInet PortNumber
port ((Word8, Word8, Word8, Word8) -> HostAddress
Socket.tupleToHostAddress (Word8
127, Word8
0, Word8
0, Word8
1))
    IO Socket -> (Socket -> IO ()) -> (Socket -> IO Bool) -> IO Bool
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
Exception.bracket (Family -> SocketType -> ProtocolNumber -> IO Socket
Socket.socket Family
Socket.AF_INET SocketType
Socket.Stream ProtocolNumber
6) Socket -> IO ()
Socket.close' ((Socket -> IO Bool) -> IO Bool) -> (Socket -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Socket
socket -> do
        Either IOException ()
res <- IO () -> IO (Either IOException ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
Exception.try (Socket -> SockAddr -> IO ()
Socket.connect Socket
socket SockAddr
address)
        case Either IOException ()
res of
            Left IOException
e -> if (ProtocolNumber -> Errno
Errno (ProtocolNumber -> Errno) -> Maybe ProtocolNumber -> Maybe Errno
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOException -> Maybe ProtocolNumber
ioe_errno IOException
e) Maybe Errno -> Maybe Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno -> Maybe Errno
forall a. a -> Maybe a
Just Errno
eCONNREFUSED
                    then Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                    else IOException -> IO Bool
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
e
            Right ()
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- | Returns True when all ports in port config are available.
-- 
-- Example:
--
-- >>> let portConfig = PortConfig { appPort = 8000, toolServerPort = 8001 }
-- >>> isPortConfigAvailable portConfig
-- True
isPortConfigAvailable :: PortConfig -> IO Bool
isPortConfigAvailable :: PortConfig -> IO Bool
isPortConfigAvailable PortConfig
portConfig = do
    [Bool]
available <- (PortNumber -> IO Bool) -> [PortNumber] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PortNumber -> IO Bool
isPortAvailable (PortConfig -> [PortNumber]
allPorts PortConfig
portConfig)
    Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Bool] -> Bool
forall mono.
(MonoFoldable mono, Element mono ~ Bool) =>
mono -> Bool
and [Bool]
available)

-- | Returns a port config where all ports are available
--
-- When e.g. port 8000 and 8001 are not used:
--
-- >>> portConfig <- findAvailablePortConfig
-- PortConfig { appPort = 8000, toolServerPort = 8001 }
findAvailablePortConfig :: IO PortConfig
findAvailablePortConfig :: IO PortConfig
findAvailablePortConfig = do
        let [PortConfig]
portConfigs :: [PortConfig] = Index [PortConfig] -> [PortConfig] -> [PortConfig]
forall seq. IsSequence seq => Index seq -> seq -> seq
take Index [PortConfig]
100 ((Int -> PortConfig) -> [Int] -> [PortConfig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Int -> PortConfig
forall a. Enum a => Int -> a
toEnum [Int
0..])
        [PortConfig] -> IO PortConfig
go [PortConfig]
portConfigs
    where
        go :: [PortConfig] -> IO PortConfig
go (PortConfig
portConfig : [PortConfig]
rest) = do
            Bool
available <- PortConfig -> IO Bool
isPortConfigAvailable PortConfig
portConfig
            if Bool
available
                then PortConfig -> IO PortConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure PortConfig
portConfig
                else [PortConfig] -> IO PortConfig
go [PortConfig]
rest
        go [] = String -> IO PortConfig
forall a. HasCallStack => String -> a
error String
"findAvailablePortConfig: No port configuration found"