{-# LANGUAGE OverloadedStrings #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Bilge.Request
  ( RequestId (..),

    -- * Builders
    empty,
    accept,
    acceptJson,
    acceptProtobuf,
    body,
    bytes,
    lbytes,
    lbytesChunkedIO,
    lbytesRefChunked,
    lbytesRefPopper,
    json,
    jsonChunkedIO,
    content,
    contentJson,
    contentProtobuf,
    header,
    host,
    path,
    paths,
    port,
    query,
    queryItem,
    queryItem',
    secure,
    method,
    showRequest,
    noRedirect,
    timeout,
    expect2xx,
    expect3xx,
    expect4xx,
    expectStatus,
    checkStatus,
    cookie,
    cookieRaw,
    requestId,
    requestIdName,
    extHost,
    extPort,

    -- * Re-exports
    Request,
    Cookie (..),
    CookieJar,
    RequestBody (..),
    Rq.parseRequest,
    Rq.applyBasicAuth,
    Rq.urlEncodedBody,
    Rq.getUri,
  )
where

import Control.Exception
import Control.Lens
import Data.Aeson (ToJSON, encode)
import Data.ByteString (intercalate)
import Data.ByteString.Char8 qualified as C
import Data.ByteString.Lazy qualified as Lazy
import Data.ByteString.Lazy.Char8 qualified as LC
import Data.CaseInsensitive (original)
import Data.Id (RequestId (..))
import Imports hiding (intercalate)
import Network.HTTP.Client (Cookie, GivesPopper, Request, RequestBody (..))
import Network.HTTP.Client qualified as Rq
import Network.HTTP.Client.Internal (CookieJar (..), brReadSome, throwHttp)
import Network.HTTP.Types
import Network.HTTP.Types qualified as HTTP
import URI.ByteString qualified as URI

-- Builders

-- | The empty request.
empty :: Request
empty :: Request
empty = Request
Rq.defaultRequest

host :: ByteString -> Request -> Request
host :: ByteString -> Request -> Request
host ByteString
h Request
r = Request
r {Rq.host = h}

port :: Word16 -> Request -> Request
port :: Word16 -> Request -> Request
port Word16
p Request
r = Request
r {Rq.port = fromIntegral p}

method :: StdMethod -> Request -> Request
method :: StdMethod -> Request -> Request
method StdMethod
m Request
r = Request
r {Rq.method = C.pack (show m)}

path :: ByteString -> Request -> Request
path :: ByteString -> Request -> Request
path ByteString
p Request
r = Request
r {Rq.path = p}

paths :: [ByteString] -> Request -> Request
paths :: [ByteString] -> Request -> Request
paths = ByteString -> Request -> Request
path (ByteString -> Request -> Request)
-> ([ByteString] -> ByteString)
-> [ByteString]
-> Request
-> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
intercalate ByteString
"/"

-- | The request should be made over HTTPS.
secure :: Request -> Request
secure :: Request -> Request
secure Request
r = Request
r {Rq.secure = True}

-- | Add a header field.
header :: HeaderName -> ByteString -> Request -> Request
header :: HeaderName -> ByteString -> Request -> Request
header HeaderName
k ByteString
v Request
r = Request
r {Rq.requestHeaders = (k, v) : Rq.requestHeaders r}

-- | Set complete query string (replacing previous content).
query :: Query -> Request -> Request
query :: Query -> Request -> Request
query Query
q Request
r = Request
r {Rq.queryString = HTTP.renderQuery True q}

-- | Add query item to request.
queryItem' :: ByteString -> Maybe ByteString -> Request -> Request
queryItem' :: ByteString -> Maybe ByteString -> Request -> Request
queryItem' ByteString
k Maybe ByteString
v Request
r
  | ByteString -> Bool
C.null (Request -> ByteString
Rq.queryString Request
r) = Request
r {Rq.queryString = qstr True}
  | Bool
otherwise = Request
r {Rq.queryString = Rq.queryString r <> "&" <> qstr False}
  where
    qstr :: Bool -> ByteString
qstr Bool
b = Bool -> Query -> ByteString
HTTP.renderQuery Bool
b [(ByteString
k, Maybe ByteString
v)]

queryItem :: ByteString -> ByteString -> Request -> Request
queryItem :: ByteString -> ByteString -> Request -> Request
queryItem ByteString
k ByteString
v = ByteString -> Maybe ByteString -> Request -> Request
queryItem' ByteString
k (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v)

body :: RequestBody -> Request -> Request
body :: RequestBody -> Request -> Request
body RequestBody
b Request
r = Request
r {Rq.requestBody = b}

-- | How many milliseconds to wait for response.
timeout :: Int -> Request -> Request
timeout :: Int -> Request -> Request
timeout Int
t Request
r = Request
r {Rq.responseTimeout = Rq.responseTimeoutMicro (t * 1000)}

noRedirect :: Request -> Request
noRedirect :: Request -> Request
noRedirect Request
r = Request
r {Rq.redirectCount = 0}

expect2xx :: Request -> Request
expect2xx :: Request -> Request
expect2xx = (Int -> Bool) -> Request -> Request
expectStatus ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100))

expect3xx :: Request -> Request
expect3xx :: Request -> Request
expect3xx = (Int -> Bool) -> Request -> Request
expectStatus ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100))

expect4xx :: Request -> Request
expect4xx :: Request -> Request
expect4xx = (Int -> Bool) -> Request -> Request
expectStatus ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100))

expectStatus :: (Int -> Bool) -> Request -> Request
expectStatus :: (Int -> Bool) -> Request -> Request
expectStatus Int -> Bool
property Request
r = Request
r {Rq.checkResponse = check}
  where
    check :: Request -> Response BodyReader -> IO ()
check Request
_ Response BodyReader
res
      | Int -> Bool
property (Status -> Int
HTTP.statusCode (Response BodyReader -> Status
forall body. Response body -> Status
Rq.responseStatus Response BodyReader
res)) = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = do
          ByteString
some <- ByteString -> ByteString
Lazy.toStrict (ByteString -> ByteString) -> IO ByteString -> BodyReader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BodyReader -> Int -> IO ByteString
brReadSome (Response BodyReader -> BodyReader
forall body. Response body -> body
Rq.responseBody Response BodyReader
res) Int
1024
          HttpExceptionContent -> IO ()
forall a. HttpExceptionContent -> IO a
throwHttp (HttpExceptionContent -> IO ()) -> HttpExceptionContent -> IO ()
forall a b. (a -> b) -> a -> b
$ Response () -> ByteString -> HttpExceptionContent
Rq.StatusCodeException (Response BodyReader -> Response ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response BodyReader
res) ByteString
some

checkStatus :: (Status -> ResponseHeaders -> CookieJar -> Maybe SomeException) -> Request -> Request
checkStatus :: (Status -> [Header] -> CookieJar -> Maybe SomeException)
-> Request -> Request
checkStatus Status -> [Header] -> CookieJar -> Maybe SomeException
f Request
r = Request
r {Rq.checkResponse = check}
  where
    check :: Request -> Response BodyReader -> IO ()
check Request
_ Response BodyReader
res = Maybe SomeException -> (SomeException -> IO Any) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Response BodyReader -> Maybe SomeException
mayThrow Response BodyReader
res) SomeException -> IO Any
forall e a. Exception e => e -> IO a
throwIO
    mayThrow :: Response BodyReader -> Maybe SomeException
mayThrow Response BodyReader
res =
      Status -> [Header] -> CookieJar -> Maybe SomeException
f
        (Response BodyReader -> Status
forall body. Response body -> Status
Rq.responseStatus Response BodyReader
res)
        (Response BodyReader -> [Header]
forall body. Response body -> [Header]
Rq.responseHeaders Response BodyReader
res)
        (Response BodyReader -> CookieJar
forall body. Response body -> CookieJar
Rq.responseCookieJar Response BodyReader
res)

cookieRaw :: ByteString -> ByteString -> Request -> Request
cookieRaw :: ByteString -> ByteString -> Request -> Request
cookieRaw ByteString
k ByteString
v = HeaderName -> ByteString -> Request -> Request
header HeaderName
"Cookie" (ByteString
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
v)

cookie :: Cookie -> Request -> Request
cookie :: Cookie -> Request -> Request
cookie Cookie
c Request
r =
  case Request -> Maybe CookieJar
Rq.cookieJar Request
r of
    Maybe CookieJar
Nothing -> Request
r {Rq.cookieJar = Just (CJ [c])}
    Just (CJ [Cookie]
cc) -> Request
r {Rq.cookieJar = Just (CJ (c : cc))}

requestId :: RequestId -> Request -> Request
requestId :: RequestId -> Request -> Request
requestId (RequestId ByteString
rId) = HeaderName -> ByteString -> Request -> Request
header HeaderName
requestIdName ByteString
rId

-- Convenience:

requestIdName :: HeaderName
requestIdName :: HeaderName
requestIdName = HeaderName
"Request-Id"

bytes :: ByteString -> Request -> Request
bytes :: ByteString -> Request -> Request
bytes = RequestBody -> Request -> Request
body (RequestBody -> Request -> Request)
-> (ByteString -> RequestBody) -> ByteString -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RequestBody
RequestBodyBS

lbytes :: Lazy.ByteString -> Request -> Request
lbytes :: ByteString -> Request -> Request
lbytes = RequestBody -> Request -> Request
body (RequestBody -> Request -> Request)
-> (ByteString -> RequestBody) -> ByteString -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RequestBody
RequestBodyLBS

-- | Not suitable for @a@ which translates to very large JSON (more than a few megabytes) as the
-- bytestring produced by JSON will get computed and stored as it is in memory
-- in order to compute the @Content-Length@ header. For making a request with
-- big JSON objects, please use @lbytesRefChunked@
json :: (ToJSON a) => a -> Request -> Request
json :: forall a. ToJSON a => a -> Request -> Request
json a
a = Request -> Request
contentJson (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
lbytes (a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
a)

-- | Like @lbytesChunkedIO@ but for sending a JSON body
jsonChunkedIO :: (ToJSON a, MonadIO m) => a -> m (Request -> Request)
jsonChunkedIO :: forall a (m :: * -> *).
(ToJSON a, MonadIO m) =>
a -> m (Request -> Request)
jsonChunkedIO a
a = do
  (Request -> Request
contentJson .) ((Request -> Request) -> Request -> Request)
-> m (Request -> Request) -> m (Request -> Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m (Request -> Request)
forall (m :: * -> *).
MonadIO m =>
ByteString -> m (Request -> Request)
lbytesChunkedIO (a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
a)

-- | Makes requests with @Transfer-Encoding: chunked@ and no @Content-Length@
-- header. Tries to ensures that the lazy bytestring is garbage collected as a
-- "chunk" of this bytestring is consumed. Note that it is not possible to
-- guarantee garbage collection as something else holding a reference to this
-- bytestring could stop that from happening.
--
-- A more straightforward function like this will keep the reference to the
-- complete bytestring, which might be against the idea of using chunked
-- encoding:
--
-- @
-- lbytesChunked bs = body (RequestBodyStreamChunked $ lbytesPopper bs)
-- lbytesPopper bs needsPopper = do
--   ref <- newIORef $ LC.toChunks bs
--   lbytesRefPopper ref needsPopper
-- @
--
-- This is because the closure for @lbytesPopper@ keeps the reference to @bs@
-- alive. To avoid this, this function allocates an @IORef@ and passes that to
-- @lbytesRefChunked@.
lbytesChunkedIO :: (MonadIO m) => Lazy.ByteString -> m (Request -> Request)
lbytesChunkedIO :: forall (m :: * -> *).
MonadIO m =>
ByteString -> m (Request -> Request)
lbytesChunkedIO ByteString
bs = do
  IORef [ByteString]
chunksRef <- [ByteString] -> m (IORef [ByteString])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef ([ByteString] -> m (IORef [ByteString]))
-> [ByteString] -> m (IORef [ByteString])
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
Lazy.toChunks ByteString
bs
  (Request -> Request) -> m (Request -> Request)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Request -> Request) -> m (Request -> Request))
-> (Request -> Request) -> m (Request -> Request)
forall a b. (a -> b) -> a -> b
$ IORef [ByteString] -> Request -> Request
lbytesRefChunked IORef [ByteString]
chunksRef

-- | Takes @IORef@ to chunks of strict @ByteString@ (perhaps) from a lazy
-- @Lazy.ByteString@, this helps the lazy bytestring get garbage collected as it
-- gets consumed. The request made will have @Transfer-Encoding: chunked@ and no
-- @Content-Length@ header.
--
-- See @lbytesChunkedIO@ for reference usage.
lbytesRefChunked :: IORef [ByteString] -> Request -> Request
lbytesRefChunked :: IORef [ByteString] -> Request -> Request
lbytesRefChunked IORef [ByteString]
chunksRef =
  RequestBody -> Request -> Request
body (GivesPopper () -> RequestBody
RequestBodyStreamChunked (GivesPopper () -> RequestBody) -> GivesPopper () -> RequestBody
forall a b. (a -> b) -> a -> b
$ IORef [ByteString] -> GivesPopper ()
lbytesRefPopper IORef [ByteString]
chunksRef)

lbytesRefPopper :: IORef [ByteString] -> GivesPopper ()
lbytesRefPopper :: IORef [ByteString] -> GivesPopper ()
lbytesRefPopper IORef [ByteString]
chunksRef NeedsPopper ()
needsPopper = do
  let popper :: BodyReader
popper = do
        IORef [ByteString]
-> ([ByteString] -> ([ByteString], ByteString)) -> BodyReader
forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef IORef [ByteString]
chunksRef (([ByteString] -> ([ByteString], ByteString)) -> BodyReader)
-> ([ByteString] -> ([ByteString], ByteString)) -> BodyReader
forall a b. (a -> b) -> a -> b
$ \case
          [] -> ([], ByteString
forall a. Monoid a => a
mempty)
          (ByteString
c : [ByteString]
cs) -> ([ByteString]
cs, ByteString
c)
  NeedsPopper ()
needsPopper BodyReader
popper

accept :: ByteString -> Request -> Request
accept :: ByteString -> Request -> Request
accept = HeaderName -> ByteString -> Request -> Request
header HeaderName
hAccept

acceptJson :: Request -> Request
acceptJson :: Request -> Request
acceptJson = ByteString -> Request -> Request
accept ByteString
"application/json"

acceptProtobuf :: Request -> Request
acceptProtobuf :: Request -> Request
acceptProtobuf = ByteString -> Request -> Request
accept ByteString
"application/x-protobuf"

content :: ByteString -> Request -> Request
content :: ByteString -> Request -> Request
content = HeaderName -> ByteString -> Request -> Request
header HeaderName
hContentType

contentJson :: Request -> Request
contentJson :: Request -> Request
contentJson = ByteString -> Request -> Request
content ByteString
"application/json"

contentProtobuf :: Request -> Request
contentProtobuf :: Request -> Request
contentProtobuf = ByteString -> Request -> Request
content ByteString
"application/x-protobuf"

showRequest :: Request -> String
showRequest :: Request -> [Char]
showRequest Request
r =
  [Char] -> ShowS
showString (ByteString -> [Char]
C.unpack (ByteString -> [Char])
-> (Request -> ByteString) -> Request -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
Rq.method (Request -> [Char]) -> Request -> [Char]
forall a b. (a -> b) -> a -> b
$ Request
r)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString (ByteString -> [Char]
C.unpack (ByteString -> [Char])
-> (Request -> ByteString) -> Request -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
Rq.path (Request -> [Char]) -> Request -> [Char]
forall a b. (a -> b) -> a -> b
$ Request
r)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString (if Request -> Bool
Rq.secure Request
r then [Char]
" HTTPS/1.1\n" else [Char]
" HTTP/1.1\n")
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showHeaders
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n\n"
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showBody
    ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
""
  where
    showHeaders :: ShowS
showHeaders = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ([Char] -> ShowS
showString [Char]
"") ((Header -> ShowS) -> [Header] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map Header -> ShowS
showHdr (Request -> [Header]
Rq.requestHeaders Request
r))
    showHdr :: Header -> ShowS
showHdr (HeaderName
k, ByteString
v) = [Char] -> ShowS
showString ([Char] -> ShowS) -> (ByteString -> [Char]) -> ByteString -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C.unpack (ByteString -> ShowS) -> ByteString -> ShowS
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString
forall s. CI s -> s
original HeaderName
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
": " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
v ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
    showBody :: ShowS
showBody = case Request -> RequestBody
Rq.requestBody Request
r of
      RequestBodyLBS ByteString
lbs -> [Char] -> ShowS
showString (ByteString -> [Char]
LC.unpack ByteString
lbs)
      RequestBodyBS ByteString
bs -> [Char] -> ShowS
showString (ByteString -> [Char]
C.unpack ByteString
bs)
      RequestBodyBuilder Int64
l Builder
_ -> [Char] -> ShowS
showString ([Char]
"RequestBodyBuilder<" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">")
      RequestBodyStream Int64
l GivesPopper ()
_ -> [Char] -> ShowS
showString ([Char]
"RequestBodyStream<" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">")
      RequestBodyStreamChunked GivesPopper ()
_ -> [Char] -> ShowS
showString [Char]
"RequestBodyStreamChunked"
      RequestBodyIO IO RequestBody
_ -> [Char] -> ShowS
showString [Char]
"RequestBodyIO"

-- uri-bytestring

extHost :: URI.URI -> Maybe ByteString
extHost :: URI -> Maybe ByteString
extHost URI
u = URI
u URI
-> Getting (Maybe Authority) URI (Maybe Authority)
-> Maybe Authority
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Authority) URI (Maybe Authority)
forall a (f :: * -> *).
Functor f =>
(Maybe Authority -> f (Maybe Authority))
-> URIRef a -> f (URIRef a)
URI.authorityL Maybe Authority -> (Authority -> ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Getting ByteString Authority ByteString -> Authority -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Host -> Const ByteString Host)
-> Authority -> Const ByteString Authority
Lens' Authority Host
URI.authorityHostL ((Host -> Const ByteString Host)
 -> Authority -> Const ByteString Authority)
-> ((ByteString -> Const ByteString ByteString)
    -> Host -> Const ByteString Host)
-> Getting ByteString Authority ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const ByteString ByteString)
-> Host -> Const ByteString Host
Lens' Host ByteString
URI.hostBSL)

extPort :: URI.URI -> Maybe Word16
extPort :: URI -> Maybe Word16
extPort URI
u = do
  Authority
a <- URI
u URI
-> Getting (Maybe Authority) URI (Maybe Authority)
-> Maybe Authority
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Authority) URI (Maybe Authority)
forall a (f :: * -> *).
Functor f =>
(Maybe Authority -> f (Maybe Authority))
-> URIRef a -> f (URIRef a)
URI.authorityL
  Port
p <- Authority
a Authority
-> Getting (Maybe Port) Authority (Maybe Port) -> Maybe Port
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Port) Authority (Maybe Port)
Lens' Authority (Maybe Port)
URI.authorityPortL
  Word16 -> Maybe Word16
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Port
p Port -> Getting Int Port Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Port Int
Lens' Port Int
URI.portNumberL))