--------------------------------------------------------------------------------
-- | This part of the library provides you with utilities to create WebSockets
-- clients (in addition to servers).
module Network.WebSockets.Client
    ( ClientApp
    , runClient
    , runClientWith
    , runClientWithSocket
    , runClientWithStream
    , newClientConnection
    -- * Low level functionality
    , createRequest
    , Protocol(..)
    , defaultProtocol
    , checkServerResponse
    , streamToClientConnection
    ) where


--------------------------------------------------------------------------------
import qualified Data.ByteString.Builder       as Builder
import           Control.Exception             (bracket, finally, throwIO)
import           Control.Concurrent.MVar       (newEmptyMVar)
import           Control.Monad                 (void)
import           Data.IORef                    (newIORef)
import qualified Data.Text                     as T
import qualified Data.Text.Encoding            as T
import qualified Network.Socket                as S
import           System.Timeout                (timeout)


--------------------------------------------------------------------------------
import           Network.WebSockets.Connection
import           Network.WebSockets.Http
import           Network.WebSockets.Protocol
import           Network.WebSockets.Stream     (Stream)
import qualified Network.WebSockets.Stream     as Stream
import           Network.WebSockets.Types


--------------------------------------------------------------------------------
-- | A client application interacting with a single server. Once this 'IO'
-- action finished, the underlying socket is closed automatically.
type ClientApp a = Connection -> IO a


--------------------------------------------------------------------------------
-- TODO: Maybe this should all be strings
runClient :: String       -- ^ Host
          -> Int          -- ^ Port
          -> String       -- ^ Path
          -> ClientApp a  -- ^ Client application
          -> IO a
runClient :: forall a. String -> Int -> String -> ClientApp a -> IO a
runClient String
host Int
port String
path ClientApp a
ws =
    forall a.
String
-> Int
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWith String
host Int
port String
path ConnectionOptions
defaultConnectionOptions [] ClientApp a
ws


--------------------------------------------------------------------------------
runClientWith :: String             -- ^ Host
              -> Int                -- ^ Port
              -> String             -- ^ Path
              -> ConnectionOptions  -- ^ Options
              -> Headers            -- ^ Custom headers to send
              -> ClientApp a        -- ^ Client application
              -> IO a
runClientWith :: forall a.
String
-> Int
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWith String
host Int
port String
path0 ConnectionOptions
opts Headers
customHeaders ClientApp a
app = do
    -- Create and connect socket
    let hints :: AddrInfo
hints = AddrInfo
S.defaultHints
                    {addrSocketType :: SocketType
S.addrSocketType = SocketType
S.Stream}

        -- Correct host and path.
        fullHost :: String
fullHost = if Int
port forall a. Eq a => a -> a -> Bool
== Int
80 then String
host else (String
host forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
port)
        path :: String
path     = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path0 then String
"/" else String
path0
    AddrInfo
addr:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
S.getAddrInfo (forall a. a -> Maybe a
Just AddrInfo
hints) (forall a. a -> Maybe a
Just String
host) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
port)
    Socket
sock      <- Family -> SocketType -> ProtocolNumber -> IO Socket
S.socket (AddrInfo -> Family
S.addrFamily AddrInfo
addr) SocketType
S.Stream ProtocolNumber
S.defaultProtocol
    Socket -> SocketOption -> Int -> IO ()
S.setSocketOption Socket
sock SocketOption
S.NoDelay Int
1

    -- Connect WebSocket and run client
    a
res <- forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (forall a. Int -> IO a -> IO (Maybe a)
timeout (ConnectionOptions -> Int
connectionTimeout ConnectionOptions
opts forall a. Num a => a -> a -> a
* Int
1000 forall a. Num a => a -> a -> a
* Int
1000) forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> IO ()
S.connect Socket
sock (AddrInfo -> SockAddr
S.addrAddress AddrInfo
addr))
        (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Socket -> IO ()
S.close Socket
sock) forall a b. (a -> b) -> a -> b
$ \Maybe ()
maybeConnected -> case Maybe ()
maybeConnected of
            Maybe ()
Nothing -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ HandshakeException
ConnectionTimeout
            Just () -> forall a.
Socket
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithSocket Socket
sock String
fullHost String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app


    -- Clean up
    forall (m :: * -> *) a. Monad m => a -> m a
return a
res


--------------------------------------------------------------------------------

runClientWithStream
    :: Stream
    -- ^ Stream
    -> String
    -- ^ Host
    -> String
    -- ^ Path
    -> ConnectionOptions
    -- ^ Connection options
    -> Headers
    -- ^ Custom headers to send
    -> ClientApp a
    -- ^ Client application
    -> IO a
runClientWithStream :: forall a.
Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithStream Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app = do
    Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> IO Connection
newClientConnection Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ClientApp a
app

-- | Build a new 'Connection' from the client's point of view.
--
-- /WARNING/: Be sure to call 'Stream.close' on the given 'Stream' after you are
-- done using the 'Connection' in order to properly close the communication
-- channel. 'runClientWithStream' handles this for you, prefer to use it when
-- possible.
newClientConnection
    :: Stream
    -- ^ Stream that will be used by the new 'Connection'.
    -> String
    -- ^ Host
    -> String
    -- ^ Path
    -> ConnectionOptions
    -- ^ Connection options
    -> Headers
    -- ^ Custom headers to send
    -> IO Connection
newClientConnection :: Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> IO Connection
newClientConnection Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders = do
    -- Create the request and send it
    RequestHead
request    <- Protocol
-> ByteString -> ByteString -> Bool -> Headers -> IO RequestHead
createRequest Protocol
protocol ByteString
bHost ByteString
bPath Bool
False Headers
customHeaders
    Stream -> ByteString -> IO ()
Stream.write Stream
stream (Builder -> ByteString
Builder.toLazyByteString forall a b. (a -> b) -> a -> b
$ RequestHead -> Builder
encodeRequestHead RequestHead
request)
    Stream -> RequestHead -> IO ()
checkServerResponse Stream
stream RequestHead
request
    Stream -> ConnectionOptions -> IO Connection
streamToClientConnection Stream
stream ConnectionOptions
opts
  where
    protocol :: Protocol
protocol = Protocol
defaultProtocol  -- TODO
    bHost :: ByteString
bHost    = Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
host
    bPath :: ByteString
bPath    = Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
path

-- | Check the response from the server.
-- Throws 'OtherHandshakeException' on failure
checkServerResponse :: Stream -> RequestHead -> IO ()
checkServerResponse :: Stream -> RequestHead -> IO ()
checkServerResponse Stream
stream RequestHead
request = do
    Maybe ResponseHead
mbResponse <- forall a. Stream -> Parser a -> IO (Maybe a)
Stream.parse Stream
stream Parser ResponseHead
decodeResponseHead
    ResponseHead
response   <- case Maybe ResponseHead
mbResponse of
        Just ResponseHead
response -> forall (m :: * -> *) a. Monad m => a -> m a
return ResponseHead
response
        Maybe ResponseHead
Nothing       -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> HandshakeException
OtherHandshakeException forall a b. (a -> b) -> a -> b
$
            String
"Network.WebSockets.Client.newClientConnection: no handshake " forall a. [a] -> [a] -> [a]
++
            String
"response from server"
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Protocol
-> RequestHead
-> ResponseHead
-> Either HandshakeException Response
finishResponse Protocol
protocol RequestHead
request ResponseHead
response
  where
    protocol :: Protocol
protocol = Protocol
defaultProtocol -- TODO


-- | Build a 'Connection' from a pre-established stream with already finished
-- handshake.
--
-- /NB/: this will not perform any handshaking.
streamToClientConnection :: Stream -> ConnectionOptions -> IO Connection
streamToClientConnection :: Stream -> ConnectionOptions -> IO Connection
streamToClientConnection Stream
stream ConnectionOptions
opts = do
    IO (Maybe Message)
parse   <- Protocol
-> SizeLimit -> SizeLimit -> Stream -> IO (IO (Maybe Message))
decodeMessages Protocol
protocol
                (ConnectionOptions -> SizeLimit
connectionFramePayloadSizeLimit ConnectionOptions
opts)
                (ConnectionOptions -> SizeLimit
connectionMessageDataSizeLimit ConnectionOptions
opts) Stream
stream
    [Message] -> IO ()
write   <- Protocol -> ConnectionType -> Stream -> IO ([Message] -> IO ())
encodeMessages Protocol
protocol ConnectionType
ClientConnection Stream
stream
    IORef Bool
sentRef <- forall a. a -> IO (IORef a)
newIORef Bool
False
    MVar ()
heartbeat <- forall a. IO (MVar a)
newEmptyMVar
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Connection
        { connectionOptions :: ConnectionOptions
connectionOptions   = ConnectionOptions
opts
        , connectionType :: ConnectionType
connectionType      = ConnectionType
ClientConnection
        , connectionProtocol :: Protocol
connectionProtocol  = Protocol
protocol
        , connectionParse :: IO (Maybe Message)
connectionParse     = IO (Maybe Message)
parse
        , connectionWrite :: [Message] -> IO ()
connectionWrite     = [Message] -> IO ()
write
        , connectionHeartbeat :: MVar ()
connectionHeartbeat = MVar ()
heartbeat
        , connectionSentClose :: IORef Bool
connectionSentClose = IORef Bool
sentRef
        }
  where
    protocol :: Protocol
protocol = Protocol
defaultProtocol


--------------------------------------------------------------------------------
runClientWithSocket :: S.Socket           -- ^ Socket
                    -> String             -- ^ Host
                    -> String             -- ^ Path
                    -> ConnectionOptions  -- ^ Options
                    -> Headers            -- ^ Custom headers to send
                    -> ClientApp a        -- ^ Client application
                    -> IO a
runClientWithSocket :: forall a.
Socket
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithSocket Socket
sock String
host String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (Socket -> IO Stream
Stream.makeSocketStream Socket
sock)
    Stream -> IO ()
Stream.close
    (\Stream
stream ->
        forall a.
Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> ClientApp a
-> IO a
runClientWithStream Stream
stream String
host String
path ConnectionOptions
opts Headers
customHeaders ClientApp a
app)