{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE RankNTypes           #-}

module CDP.Endpoints where

import Data.Maybe
import Data.List
import Data.Proxy
import qualified Network.URI          as Uri
import qualified Network.HTTP.Simple  as Http
import qualified Data.Aeson           as A
import qualified Data.ByteString.Lazy as BS
import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=), (.!=), (.:!))
import qualified Data.Text as T
import Control.Exception

import CDP.Internal.Utils
import qualified CDP.Definition

type URL      = T.Text
type TargetId = T.Text

data EPBrowserVersion   = EPBrowserVersion
data EPAllTargets       = EPAllTargets
data EPCurrentProtocol  = EPCurrentProtocol
data EPOpenNewTab       = EPOpenNewTab       { EPOpenNewTab -> URL
unOpenNewTab :: URL }
data EPActivateTarget   = EPActivateTarget   { EPActivateTarget -> URL
unActivateTarget :: TargetId }
data EPCloseTarget      = EPCloseTarget      { EPCloseTarget -> URL
unCloseTarget :: TargetId }
data EPFrontend         = EPFrontend

data SomeEndpoint where
    SomeEndpoint :: Endpoint ep => ep -> SomeEndpoint

fromSomeEndpoint :: (forall ep. Endpoint ep => ep -> r) -> SomeEndpoint -> r
fromSomeEndpoint :: (forall ep. Endpoint ep => ep -> r) -> SomeEndpoint -> r
fromSomeEndpoint forall ep. Endpoint ep => ep -> r
f (SomeEndpoint ep
ep) = ep -> r
forall ep. Endpoint ep => ep -> r
f ep
ep

-- | Sends a request with the given parameters to the corresponding endpoint
endpoint :: Endpoint ep => Config -> ep -> IO (EndpointResponse ep)
endpoint :: Config -> ep -> IO (EndpointResponse ep)
endpoint = (String, Int) -> ep -> IO (EndpointResponse ep)
forall ep.
Endpoint ep =>
(String, Int) -> ep -> IO (EndpointResponse ep)
getEndpoint ((String, Int) -> ep -> IO (EndpointResponse ep))
-> (Config -> (String, Int))
-> Config
-> ep
-> IO (EndpointResponse ep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> (String, Int)
hostPort

-- | Creates a session with a new tab
connectToTab :: Config -> URL -> IO TargetInfo
connectToTab :: Config -> URL -> IO TargetInfo
connectToTab Config
cfg URL
url = do
        TargetInfo
targetInfo <- Config -> EPOpenNewTab -> IO (EndpointResponse EPOpenNewTab)
forall ep. Endpoint ep => Config -> ep -> IO (EndpointResponse ep)
endpoint Config
cfg (EPOpenNewTab -> IO (EndpointResponse EPOpenNewTab))
-> EPOpenNewTab -> IO (EndpointResponse EPOpenNewTab)
forall a b. (a -> b) -> a -> b
$ URL -> EPOpenNewTab
EPOpenNewTab URL
url
        Config
-> EPActivateTarget -> IO (EndpointResponse EPActivateTarget)
forall ep. Endpoint ep => Config -> ep -> IO (EndpointResponse ep)
endpoint Config
cfg (EPActivateTarget -> IO (EndpointResponse EPActivateTarget))
-> EPActivateTarget -> IO (EndpointResponse EPActivateTarget)
forall a b. (a -> b) -> a -> b
$ URL -> EPActivateTarget
EPActivateTarget (URL -> EPActivateTarget) -> URL -> EPActivateTarget
forall a b. (a -> b) -> a -> b
$ TargetInfo -> URL
tiId TargetInfo
targetInfo
        TargetInfo -> IO TargetInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure TargetInfo
targetInfo

class Endpoint ep where
    type EndpointResponse ep :: *
    getEndpoint :: (String, Int) -> ep -> IO (EndpointResponse ep)
    epDecode :: Proxy ep -> BS.ByteString -> Either String (EndpointResponse ep)

instance Endpoint EPBrowserVersion where
    type EndpointResponse EPBrowserVersion = BrowserVersion
    getEndpoint :: (String, Int)
-> EPBrowserVersion -> IO (EndpointResponse EPBrowserVersion)
getEndpoint (String, Int)
hostPort EPBrowserVersion
_ = Proxy EPBrowserVersion
-> Request -> IO (EndpointResponse EPBrowserVersion)
forall ep.
Endpoint ep =>
Proxy ep -> Request -> IO (EndpointResponse ep)
performRequest (Proxy EPBrowserVersion
forall k (t :: k). Proxy t
Proxy :: Proxy EPBrowserVersion) (Request -> IO (EndpointResponse EPBrowserVersion))
-> Request -> IO (EndpointResponse EPBrowserVersion)
forall a b. (a -> b) -> a -> b
$
        (String, Int) -> [URL] -> Maybe URL -> Request
getRequest (String, Int)
hostPort [URL
"json", URL
"version"] Maybe URL
forall a. Maybe a
Nothing
    epDecode :: Proxy EPBrowserVersion
-> ByteString -> Either String (EndpointResponse EPBrowserVersion)
epDecode = (ByteString -> Either String BrowserVersion)
-> Proxy EPBrowserVersion
-> ByteString
-> Either String BrowserVersion
forall a b. a -> b -> a
const ByteString -> Either String BrowserVersion
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode

instance Endpoint EPAllTargets where
    type EndpointResponse EPAllTargets = [TargetInfo]
    getEndpoint :: (String, Int) -> EPAllTargets -> IO (EndpointResponse EPAllTargets)
getEndpoint (String, Int)
hostPort EPAllTargets
_ = Proxy EPAllTargets -> Request -> IO (EndpointResponse EPAllTargets)
forall ep.
Endpoint ep =>
Proxy ep -> Request -> IO (EndpointResponse ep)
performRequest (Proxy EPAllTargets
forall k (t :: k). Proxy t
Proxy :: Proxy EPAllTargets) (Request -> IO (EndpointResponse EPAllTargets))
-> Request -> IO (EndpointResponse EPAllTargets)
forall a b. (a -> b) -> a -> b
$ 
        (String, Int) -> [URL] -> Maybe URL -> Request
getRequest (String, Int)
hostPort [URL
"json", URL
"list"] Maybe URL
forall a. Maybe a
Nothing
    epDecode :: Proxy EPAllTargets
-> ByteString -> Either String (EndpointResponse EPAllTargets)
epDecode = (ByteString -> Either String [TargetInfo])
-> Proxy EPAllTargets -> ByteString -> Either String [TargetInfo]
forall a b. a -> b -> a
const ByteString -> Either String [TargetInfo]
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode

instance Endpoint EPCurrentProtocol where
    type EndpointResponse EPCurrentProtocol = CDP.Definition.TopLevel
    getEndpoint :: (String, Int)
-> EPCurrentProtocol -> IO (EndpointResponse EPCurrentProtocol)
getEndpoint (String, Int)
hostPort EPCurrentProtocol
_ = Proxy EPCurrentProtocol
-> Request -> IO (EndpointResponse EPCurrentProtocol)
forall ep.
Endpoint ep =>
Proxy ep -> Request -> IO (EndpointResponse ep)
performRequest (Proxy EPCurrentProtocol
forall k (t :: k). Proxy t
Proxy :: Proxy EPCurrentProtocol) (Request -> IO (EndpointResponse EPCurrentProtocol))
-> Request -> IO (EndpointResponse EPCurrentProtocol)
forall a b. (a -> b) -> a -> b
$
        (String, Int) -> [URL] -> Maybe URL -> Request
getRequest (String, Int)
hostPort [URL
"json", URL
"protocol"] Maybe URL
forall a. Maybe a
Nothing
    epDecode :: Proxy EPCurrentProtocol
-> ByteString -> Either String (EndpointResponse EPCurrentProtocol)
epDecode = (ByteString -> Either String TopLevel)
-> Proxy EPCurrentProtocol -> ByteString -> Either String TopLevel
forall a b. a -> b -> a
const ByteString -> Either String TopLevel
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode

instance Endpoint EPOpenNewTab where
    type EndpointResponse EPOpenNewTab = TargetInfo
    getEndpoint :: (String, Int) -> EPOpenNewTab -> IO (EndpointResponse EPOpenNewTab)
getEndpoint (String, Int)
hostPort (EPOpenNewTab URL
url) = Proxy EPOpenNewTab -> Request -> IO (EndpointResponse EPOpenNewTab)
forall ep.
Endpoint ep =>
Proxy ep -> Request -> IO (EndpointResponse ep)
performRequest (Proxy EPOpenNewTab
forall k (t :: k). Proxy t
Proxy :: Proxy EPOpenNewTab) (Request -> IO (EndpointResponse EPOpenNewTab))
-> Request -> IO (EndpointResponse EPOpenNewTab)
forall a b. (a -> b) -> a -> b
$
        (String, Int) -> [URL] -> Maybe URL -> Request
getRequest (String, Int)
hostPort [URL
"json", URL
"new"] (URL -> Maybe URL
forall a. a -> Maybe a
Just URL
url)
    epDecode :: Proxy EPOpenNewTab
-> ByteString -> Either String (EndpointResponse EPOpenNewTab)
epDecode = (ByteString -> Either String TargetInfo)
-> Proxy EPOpenNewTab -> ByteString -> Either String TargetInfo
forall a b. a -> b -> a
const ByteString -> Either String TargetInfo
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode 

instance Endpoint EPActivateTarget where
    type EndpointResponse EPActivateTarget = ()
    getEndpoint :: (String, Int)
-> EPActivateTarget -> IO (EndpointResponse EPActivateTarget)
getEndpoint (String, Int)
hostPort (EPActivateTarget URL
id) = Proxy EPActivateTarget
-> Request -> IO (EndpointResponse EPActivateTarget)
forall ep.
Endpoint ep =>
Proxy ep -> Request -> IO (EndpointResponse ep)
performRequest (Proxy EPActivateTarget
forall k (t :: k). Proxy t
Proxy :: Proxy EPActivateTarget) (Request -> IO (EndpointResponse EPActivateTarget))
-> Request -> IO (EndpointResponse EPActivateTarget)
forall a b. (a -> b) -> a -> b
$
        (String, Int) -> [URL] -> Maybe URL -> Request
getRequest (String, Int)
hostPort [URL
"json", URL
"activate", URL
id] Maybe URL
forall a. Maybe a
Nothing
    epDecode :: Proxy EPActivateTarget
-> ByteString -> Either String (EndpointResponse EPActivateTarget)
epDecode = (ByteString -> Either String ())
-> Proxy EPActivateTarget -> ByteString -> Either String ()
forall a b. a -> b -> a
const ((ByteString -> Either String ())
 -> Proxy EPActivateTarget -> ByteString -> Either String ())
-> (Either String () -> ByteString -> Either String ())
-> Either String ()
-> Proxy EPActivateTarget
-> ByteString
-> Either String ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String () -> ByteString -> Either String ()
forall a b. a -> b -> a
const (Either String ()
 -> Proxy EPActivateTarget -> ByteString -> Either String ())
-> Either String ()
-> Proxy EPActivateTarget
-> ByteString
-> Either String ()
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()

instance Endpoint EPCloseTarget where
    type EndpointResponse EPCloseTarget = ()
    getEndpoint :: (String, Int)
-> EPCloseTarget -> IO (EndpointResponse EPCloseTarget)
getEndpoint (String, Int)
hostPort (EPCloseTarget URL
id) = Proxy EPCloseTarget
-> Request -> IO (EndpointResponse EPCloseTarget)
forall ep.
Endpoint ep =>
Proxy ep -> Request -> IO (EndpointResponse ep)
performRequest (Proxy EPCloseTarget
forall k (t :: k). Proxy t
Proxy :: Proxy EPCloseTarget) (Request -> IO (EndpointResponse EPCloseTarget))
-> Request -> IO (EndpointResponse EPCloseTarget)
forall a b. (a -> b) -> a -> b
$
        (String, Int) -> [URL] -> Maybe URL -> Request
getRequest (String, Int)
hostPort [URL
"json", URL
"close", URL
id] Maybe URL
forall a. Maybe a
Nothing
    epDecode :: Proxy EPCloseTarget
-> ByteString -> Either String (EndpointResponse EPCloseTarget)
epDecode = (ByteString -> Either String ())
-> Proxy EPCloseTarget -> ByteString -> Either String ()
forall a b. a -> b -> a
const ((ByteString -> Either String ())
 -> Proxy EPCloseTarget -> ByteString -> Either String ())
-> (Either String () -> ByteString -> Either String ())
-> Either String ()
-> Proxy EPCloseTarget
-> ByteString
-> Either String ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String () -> ByteString -> Either String ()
forall a b. a -> b -> a
const (Either String ()
 -> Proxy EPCloseTarget -> ByteString -> Either String ())
-> Either String ()
-> Proxy EPCloseTarget
-> ByteString
-> Either String ()
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()

instance Endpoint EPFrontend where
    type EndpointResponse EPFrontend = BS.ByteString
    getEndpoint :: (String, Int) -> EPFrontend -> IO (EndpointResponse EPFrontend)
getEndpoint (String, Int)
hostPort EPFrontend
EPFrontend = Proxy EPFrontend -> Request -> IO (EndpointResponse EPFrontend)
forall ep.
Endpoint ep =>
Proxy ep -> Request -> IO (EndpointResponse ep)
performRequest (Proxy EPFrontend
forall k (t :: k). Proxy t
Proxy :: Proxy EPFrontend) (Request -> IO (EndpointResponse EPFrontend))
-> Request -> IO (EndpointResponse EPFrontend)
forall a b. (a -> b) -> a -> b
$
        (String, Int) -> [URL] -> Maybe URL -> Request
getRequest (String, Int)
hostPort [URL
"devtools", URL
"inspector.html"] Maybe URL
forall a. Maybe a
Nothing
    epDecode :: Proxy EPFrontend
-> ByteString -> Either String (EndpointResponse EPFrontend)
epDecode = (ByteString -> Either String ByteString)
-> Proxy EPFrontend -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
forall a b. b -> Either a b
Right

data BrowserVersion = BrowserVersion
    { BrowserVersion -> URL
bvBrowser              :: T.Text
    , BrowserVersion -> URL
bvProtocolVersion      :: T.Text
    , BrowserVersion -> URL
bvUserAgent            :: T.Text
    , BrowserVersion -> URL
bvV8Version            :: T.Text
    , BrowserVersion -> URL
bvVebKitVersion        :: T.Text
    , BrowserVersion -> URL
bvWebSocketDebuggerUrl :: T.Text
    } deriving (Int -> BrowserVersion -> ShowS
[BrowserVersion] -> ShowS
BrowserVersion -> String
(Int -> BrowserVersion -> ShowS)
-> (BrowserVersion -> String)
-> ([BrowserVersion] -> ShowS)
-> Show BrowserVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrowserVersion] -> ShowS
$cshowList :: [BrowserVersion] -> ShowS
show :: BrowserVersion -> String
$cshow :: BrowserVersion -> String
showsPrec :: Int -> BrowserVersion -> ShowS
$cshowsPrec :: Int -> BrowserVersion -> ShowS
Show, BrowserVersion -> BrowserVersion -> Bool
(BrowserVersion -> BrowserVersion -> Bool)
-> (BrowserVersion -> BrowserVersion -> Bool) -> Eq BrowserVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrowserVersion -> BrowserVersion -> Bool
$c/= :: BrowserVersion -> BrowserVersion -> Bool
== :: BrowserVersion -> BrowserVersion -> Bool
$c== :: BrowserVersion -> BrowserVersion -> Bool
Eq)
instance FromJSON BrowserVersion where
    parseJSON :: Value -> Parser BrowserVersion
parseJSON = String
-> (Object -> Parser BrowserVersion)
-> Value
-> Parser BrowserVersion
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BrowserVersion" ((Object -> Parser BrowserVersion)
 -> Value -> Parser BrowserVersion)
-> (Object -> Parser BrowserVersion)
-> Value
-> Parser BrowserVersion
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        URL -> URL -> URL -> URL -> URL -> URL -> BrowserVersion
BrowserVersion (URL -> URL -> URL -> URL -> URL -> URL -> BrowserVersion)
-> Parser URL
-> Parser (URL -> URL -> URL -> URL -> URL -> BrowserVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"Browser"
            Parser (URL -> URL -> URL -> URL -> URL -> BrowserVersion)
-> Parser URL
-> Parser (URL -> URL -> URL -> URL -> BrowserVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"Protocol-Version"
            Parser (URL -> URL -> URL -> URL -> BrowserVersion)
-> Parser URL -> Parser (URL -> URL -> URL -> BrowserVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"User-Agent"
            Parser (URL -> URL -> URL -> BrowserVersion)
-> Parser URL -> Parser (URL -> URL -> BrowserVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"V8-Version"
            Parser (URL -> URL -> BrowserVersion)
-> Parser URL -> Parser (URL -> BrowserVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"WebKit-Version"
            Parser (URL -> BrowserVersion)
-> Parser URL -> Parser BrowserVersion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"webSocketDebuggerUrl"

data TargetInfo = TargetInfo
    { TargetInfo -> URL
tiDescription          :: T.Text
    , TargetInfo -> URL
tiDevtoolsFrontendUrl  :: T.Text
    , TargetInfo -> URL
tiId                   :: T.Text
    , TargetInfo -> URL
tiTitle                :: T.Text
    , TargetInfo -> URL
tiType                 :: T.Text
    , TargetInfo -> URL
tiUrl                  :: T.Text
    , TargetInfo -> URL
tiWebSocketDebuggerUrl :: T.Text
    } deriving Int -> TargetInfo -> ShowS
[TargetInfo] -> ShowS
TargetInfo -> String
(Int -> TargetInfo -> ShowS)
-> (TargetInfo -> String)
-> ([TargetInfo] -> ShowS)
-> Show TargetInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetInfo] -> ShowS
$cshowList :: [TargetInfo] -> ShowS
show :: TargetInfo -> String
$cshow :: TargetInfo -> String
showsPrec :: Int -> TargetInfo -> ShowS
$cshowsPrec :: Int -> TargetInfo -> ShowS
Show
instance FromJSON TargetInfo where
    parseJSON :: Value -> Parser TargetInfo
parseJSON = String
-> (Object -> Parser TargetInfo) -> Value -> Parser TargetInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"TargetInfo" ((Object -> Parser TargetInfo) -> Value -> Parser TargetInfo)
-> (Object -> Parser TargetInfo) -> Value -> Parser TargetInfo
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        URL -> URL -> URL -> URL -> URL -> URL -> URL -> TargetInfo
TargetInfo (URL -> URL -> URL -> URL -> URL -> URL -> URL -> TargetInfo)
-> Parser URL
-> Parser (URL -> URL -> URL -> URL -> URL -> URL -> TargetInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"description"
            Parser (URL -> URL -> URL -> URL -> URL -> URL -> TargetInfo)
-> Parser URL
-> Parser (URL -> URL -> URL -> URL -> URL -> TargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"devtoolsFrontendUrl"
            Parser (URL -> URL -> URL -> URL -> URL -> TargetInfo)
-> Parser URL -> Parser (URL -> URL -> URL -> URL -> TargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"id"
            Parser (URL -> URL -> URL -> URL -> TargetInfo)
-> Parser URL -> Parser (URL -> URL -> URL -> TargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"title"
            Parser (URL -> URL -> URL -> TargetInfo)
-> Parser URL -> Parser (URL -> URL -> TargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"type"
            Parser (URL -> URL -> TargetInfo)
-> Parser URL -> Parser (URL -> TargetInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"url"
            Parser (URL -> TargetInfo) -> Parser URL -> Parser TargetInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> URL -> Parser URL
forall a. FromJSON a => Object -> URL -> Parser a
.: URL
"webSocketDebuggerUrl"

browserAddress :: (String, Int) -> IO (String, Int, String)
browserAddress :: (String, Int) -> IO (String, Int, String)
browserAddress (String, Int)
hostPort = (String, Int, String)
-> Maybe (String, Int, String) -> (String, Int, String)
forall a. a -> Maybe a -> a
fromMaybe (Error -> (String, Int, String)
forall a e. Exception e => e -> a
throw (Error -> (String, Int, String))
-> (String -> Error) -> String -> (String, Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Error
ERRParse (String -> (String, Int, String))
-> String -> (String, Int, String)
forall a b. (a -> b) -> a -> b
$ String
"invalid URI when connecting to browser") (Maybe (String, Int, String) -> (String, Int, String))
-> (BrowserVersion -> Maybe (String, Int, String))
-> BrowserVersion
-> (String, Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
    String -> Maybe (String, Int, String)
parseUri (String -> Maybe (String, Int, String))
-> (BrowserVersion -> String)
-> BrowserVersion
-> Maybe (String, Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URL -> String
T.unpack (URL -> String)
-> (BrowserVersion -> URL) -> BrowserVersion -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BrowserVersion -> URL
bvWebSocketDebuggerUrl (BrowserVersion -> (String, Int, String))
-> IO BrowserVersion -> IO (String, Int, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String, Int)
-> EPBrowserVersion -> IO (EndpointResponse EPBrowserVersion)
forall ep.
Endpoint ep =>
(String, Int) -> ep -> IO (EndpointResponse ep)
getEndpoint (String, Int)
hostPort EPBrowserVersion
EPBrowserVersion

pageAddress :: (String, Int) -> IO (String, Int, String)
pageAddress :: (String, Int) -> IO (String, Int, String)
pageAddress (String, Int)
hostPort = (String, Int, String)
-> Maybe (String, Int, String) -> (String, Int, String)
forall a. a -> Maybe a -> a
fromMaybe (Error -> (String, Int, String)
forall a e. Exception e => e -> a
throw (Error -> (String, Int, String))
-> (String -> Error) -> String -> (String, Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Error
ERRParse (String -> (String, Int, String))
-> String -> (String, Int, String)
forall a b. (a -> b) -> a -> b
$ String
"invalid URI when connecting to page") (Maybe (String, Int, String) -> (String, Int, String))
-> ([TargetInfo] -> Maybe (String, Int, String))
-> [TargetInfo]
-> (String, Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
    String -> Maybe (String, Int, String)
parseUri (String -> Maybe (String, Int, String))
-> ([TargetInfo] -> String)
-> [TargetInfo]
-> Maybe (String, Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URL -> String
T.unpack (URL -> String) -> ([TargetInfo] -> URL) -> [TargetInfo] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetInfo -> URL
tiWebSocketDebuggerUrl (TargetInfo -> URL)
-> ([TargetInfo] -> TargetInfo) -> [TargetInfo] -> URL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TargetInfo] -> TargetInfo
forall a. [a] -> a
head ([TargetInfo] -> (String, Int, String))
-> IO [TargetInfo] -> IO (String, Int, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String, Int) -> EPAllTargets -> IO (EndpointResponse EPAllTargets)
forall ep.
Endpoint ep =>
(String, Int) -> ep -> IO (EndpointResponse ep)
getEndpoint (String, Int)
hostPort EPAllTargets
EPAllTargets

getRequest :: (String, Int) -> [T.Text] -> Maybe T.Text -> Http.Request
getRequest :: (String, Int) -> [URL] -> Maybe URL -> Request
getRequest (String
host, Int
port) [URL]
path Maybe URL
mbParam = String -> Request
Http.parseRequest_ (String -> Request) -> (URL -> String) -> URL -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URL -> String
T.unpack (URL -> Request) -> URL -> Request
forall a b. (a -> b) -> a -> b
$ URL
r
  where
    r :: URL
r = [URL] -> URL
forall a. Monoid a => [a] -> a
mconcat [URL
"GET ", String -> URL
T.pack String
host, URL
":", String -> URL
T.pack (Int -> String
forall a. Show a => a -> String
show Int
port), URL
"/", URL -> [URL] -> URL
T.intercalate URL
"/" [URL]
path
                , URL -> (URL -> URL) -> Maybe URL -> URL
forall b a. b -> (a -> b) -> Maybe a -> b
maybe URL
"" (URL
"?" URL -> URL -> URL
forall a. Semigroup a => a -> a -> a
<>) Maybe URL
mbParam 
                ]

performRequest :: Endpoint ep => Proxy ep -> Http.Request -> IO (EndpointResponse ep)
performRequest :: Proxy ep -> Request -> IO (EndpointResponse ep)
performRequest Proxy ep
p Request
req = do
    ByteString
body <- Response ByteString -> ByteString
forall a. Response a -> a
Http.getResponseBody (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
Http.httpLBS Request
req
    (String -> IO (EndpointResponse ep))
-> (EndpointResponse ep -> IO (EndpointResponse ep))
-> Either String (EndpointResponse ep)
-> IO (EndpointResponse ep)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Error -> IO (EndpointResponse ep)
forall e a. Exception e => e -> IO a
throwIO (Error -> IO (EndpointResponse ep))
-> (String -> Error) -> String -> IO (EndpointResponse ep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Error
ERRParse) EndpointResponse ep -> IO (EndpointResponse ep)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (EndpointResponse ep) -> IO (EndpointResponse ep))
-> Either String (EndpointResponse ep) -> IO (EndpointResponse ep)
forall a b. (a -> b) -> a -> b
$ Proxy ep -> ByteString -> Either String (EndpointResponse ep)
forall ep.
Endpoint ep =>
Proxy ep -> ByteString -> Either String (EndpointResponse ep)
epDecode Proxy ep
p ByteString
body

parseUri :: String -> Maybe (String, Int, String)
parseUri :: String -> Maybe (String, Int, String)
parseUri String
uri = do
    URI
u    <- String -> Maybe URI
Uri.parseURI (String -> Maybe URI) -> String -> Maybe URI
forall a b. (a -> b) -> a -> b
$ String
uri
    URIAuth
auth <- URI -> Maybe URIAuth
Uri.uriAuthority URI
u
    let port :: Int
port = case URIAuth -> String
Uri.uriPort URIAuth
auth of
            (Char
':':String
str)   -> String -> Int
forall a. Read a => String -> a
read String
str
            String
_           -> Int
80
    (String, Int, String) -> Maybe (String, Int, String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URIAuth -> String
Uri.uriRegName URIAuth
auth, Int
port, URI -> String
Uri.uriPath URI
u)