module Test.NginxZAuthModule where

import API.Brig
import API.Common
import Control.Monad.Codensity
import Control.Monad.Reader
import qualified Data.ByteString as BS
import Data.List.Extra
import Data.Streaming.Network
import Data.UnixTime
import qualified Network.HTTP.Client as HTTP
import Network.HTTP.Types
import Network.Socket (Socket)
import qualified Network.Socket as NS
import qualified Network.Socket.ByteString as NSB
import SetupHelpers
import System.FilePath ((</>))
import System.IO (writeFile)
import System.IO.Temp
import System.Posix
import System.Process (getPid)
import Testlib.Prelude
import Text.RawString.QQ
import UnliftIO (bracket)
import UnliftIO.Async (async, waitBoth)
import qualified UnliftIO.Async as Async
import UnliftIO.Directory
import UnliftIO.Process
import UnliftIO.Timeout (timeout)

-- Happy flow: login yields a valid zauth token.
--
-- This test uses `withTestNginz` which responds with the user id and time stamp from the
-- token instead of proxying anywhere.  See also: 'testBearerToken2'
testBearerToken :: (HasCallStack) => App ()
testBearerToken :: HasCallStack => App ()
testBearerToken = do
  Codensity App Int -> forall b. (Int -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity Codensity App Int
withTestNginz ((Int -> App ()) -> App ()) -> (Int -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Int
port -> do
    Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
    FilePath
email <- App Value -> App FilePath
forall a. (HasCallStack, MakesValue a) => a -> App FilePath
asString (App Value -> App FilePath) -> App Value -> App FilePath
forall a b. (a -> b) -> a -> b
$ Value
alice Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"email"
    Value
loginResp <- Value -> FilePath -> FilePath -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> FilePath -> FilePath -> App Response
login Value
alice FilePath
email FilePath
defPassword App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
    FilePath
token <- App Value -> App FilePath
forall a. (HasCallStack, MakesValue a) => a -> App FilePath
asString (App Value -> App FilePath) -> App Value -> App FilePath
forall a b. (a -> b) -> a -> b
$ Value
loginResp Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"access_token"

    Request
req0 <- FilePath -> App Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
HTTP.parseRequest FilePath
"http://localhost"
    let req :: Request
req =
          Request
req0
            { HTTP.port = port,
              HTTP.requestHeaders = [(hAuthorization, fromString $ "Bearer " <> token)]
            }
    FilePath -> Request -> App Response
submit FilePath
"GET" Request
req App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Response
resp.json App Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"user" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"qualified_id.id")
      Response
resp.json App Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"timestamp" App Value -> FilePath -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldNotMatch` FilePath
""
      FilePath
timestampI <- (Response
resp.json App Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"timestamp" App Value -> (Value -> App FilePath) -> App FilePath
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App FilePath
forall a. (HasCallStack, MakesValue a) => a -> App FilePath
asString)
      let timestampUnix :: UnixTime
timestampUnix = CTime -> Int32 -> UnixTime
UnixTime ((Integer -> CTime
forall a. Num a => Integer -> a
fromInteger (Integer -> CTime) -> (FilePath -> Integer) -> FilePath -> CTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Integer
forall a. Read a => FilePath -> a
read) FilePath
timestampI) Int32
0
      UnixTime
now <- IO UnixTime -> App UnixTime
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UnixTime -> App UnixTime) -> IO UnixTime -> App UnixTime
forall a b. (a -> b) -> a -> b
$ IO UnixTime
getUnixTime
      HasCallStack => FilePath -> Bool -> App ()
FilePath -> Bool -> App ()
assertBool FilePath
"not in future" (UnixTime
timestampUnix UnixTime -> UnixTime -> Bool
forall a. Ord a => a -> a -> Bool
> UnixTime
now)

-- Happy flow (zauth token encoded in AWS4_HMAC_SHA256)
--
-- This test uses `withTestNginz` which responds with the user id and time stamp from the
-- token instead of proxying anywhere.  See also: 'testAWS4_HMAC_SHA256_token2'
testAWS4_HMAC_SHA256_token :: (HasCallStack) => App ()
testAWS4_HMAC_SHA256_token :: HasCallStack => App ()
testAWS4_HMAC_SHA256_token = do
  Codensity App Int -> forall b. (Int -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity Codensity App Int
withTestNginz ((Int -> App ()) -> App ()) -> (Int -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Int
port -> do
    Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
    FilePath
email <- App Value -> App FilePath
forall a. (HasCallStack, MakesValue a) => a -> App FilePath
asString (App Value -> App FilePath) -> App Value -> App FilePath
forall a b. (a -> b) -> a -> b
$ Value
alice Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"email"
    Value
loginResp <- Value -> FilePath -> FilePath -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> FilePath -> FilePath -> App Response
login Value
alice FilePath
email FilePath
defPassword App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
    FilePath
token <- App Value -> App FilePath
forall a. (HasCallStack, MakesValue a) => a -> App FilePath
asString (App Value -> App FilePath) -> App Value -> App FilePath
forall a b. (a -> b) -> a -> b
$ Value
loginResp Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"access_token"

    Request
req0 <- FilePath -> App Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
HTTP.parseRequest FilePath
"http://localhost"

    let mkReq :: ByteString -> Request
mkReq ByteString
authHeader =
          Request
req0
            { HTTP.port = port,
              HTTP.requestHeaders = [(hAuthorization, authHeader)]
            }
        testCases :: [(Bool, ByteString)]
testCases =
          [ (Bool
True, FilePath -> ByteString
forall a. IsString a => FilePath -> a
fromString (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"AWS4-HMAC-SHA256 Credential=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
token FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
", foo=bar"),
            (Bool
True, FilePath -> ByteString
forall a. IsString a => FilePath -> a
fromString (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"AWS4-HMAC-SHA256 Credential=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
token),
            (Bool
True, FilePath -> ByteString
forall a. IsString a => FilePath -> a
fromString (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"AWS4-HMAC-SHA256 foo=bar, Credential=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
token),
            (Bool
True, FilePath -> ByteString
forall a. IsString a => FilePath -> a
fromString (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"AWS4-HMAC-SHA256 foo=bar, Credential=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
token FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
", baz=qux"),
            (Bool
True, FilePath -> ByteString
forall a. IsString a => FilePath -> a
fromString (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"AWS4-HMAC-SHA256 foo=bar,Credential=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
token FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
",baz=qux"),
            (Bool
False, FilePath -> ByteString
forall a. IsString a => FilePath -> a
fromString (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"AWS4-HMAC-SHA256 Credential=bad")
          ]
    [(Bool, ByteString)] -> ((Bool, ByteString) -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Bool, ByteString)]
testCases (((Bool, ByteString) -> App ()) -> App ())
-> ((Bool, ByteString) -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(Bool
good, ByteString
header) -> do
      FilePath -> Request -> App Response
submit FilePath
"GET" (ByteString -> Request
mkReq ByteString
header) App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
        if Bool
good
          then do
            Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
            Response
resp.json App Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"user" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
alice Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"qualified_id.id")
            Response
resp.json App Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"timestamp" App Value -> FilePath -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldNotMatch` FilePath
""
          else do
            Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
            Response
resp.json App Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"user" App Value -> FilePath -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` FilePath
""
            Response
resp.json App Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"timestamp" App Value -> FilePath -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` FilePath
""

withTestNginz :: Codensity App Int
withTestNginz :: Codensity App Int
withTestNginz = do
  FilePath
tmpDir <- (forall b. (FilePath -> App b) -> App b) -> Codensity App FilePath
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b. (FilePath -> App b) -> App b)
 -> Codensity App FilePath)
-> (forall b. (FilePath -> App b) -> App b)
-> Codensity App FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath -> App b) -> App b
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> m a) -> m a
withSystemTempDirectory FilePath
"integration-NginxZauthModule"
  Env
env <- Codensity App Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  -- Create config
  let (FilePath
keystorePath, FilePath
oauthPubKey) = case Env
env.servicesCwdBase of
        Maybe FilePath
Nothing ->
          ( FilePath
"/etc/wire/nginz/secrets/zauth.conf",
            FilePath
"/etc/wire/nginz/secrets/oauth_ed25519_pub.jwk"
          )
        Just FilePath
basedir ->
          ( FilePath
basedir FilePath -> FilePath -> FilePath
</> FilePath
"nginz/integration-test/resources/zauth/pubkeys.txt",
            FilePath
basedir FilePath -> FilePath -> FilePath
</> FilePath
"nginz/integration-test/resources/oauth/ed25519_public.jwk"
          )
      unixSocketPath :: FilePath
unixSocketPath = FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
"sock"
      config :: FilePath
config =
        FilePath
nginxTestConfigTemplate
          -- Listen on unix socket because its too complicated to make nginx run
          -- on a random available port.
          FilePath -> (FilePath -> FilePath) -> FilePath
forall a b. a -> (a -> b) -> b
& FilePath -> FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace FilePath
"{socket_path}" FilePath
unixSocketPath
          FilePath -> (FilePath -> FilePath) -> FilePath
forall a b. a -> (a -> b) -> b
& FilePath -> FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace FilePath
"{pid_file}" (FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
"pid")

      configPath :: FilePath
configPath = FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
"nginx.conf"

  FilePath -> FilePath -> Codensity App ()
forall (m :: * -> *). MonadIO m => FilePath -> FilePath -> m ()
copyFile FilePath
keystorePath (FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
"keystore")
  FilePath -> FilePath -> Codensity App ()
forall (m :: * -> *). MonadIO m => FilePath -> FilePath -> m ()
copyFile FilePath
oauthPubKey (FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
"oauth-pub-key")
  IO () -> Codensity App ()
forall a. IO a -> Codensity App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Codensity App ()) -> IO () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile (FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
"acl") FilePath
""
  IO () -> Codensity App ()
forall a. IO a -> Codensity App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Codensity App ()) -> IO () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile FilePath
configPath FilePath
config

  let startNginx :: App (Handle, Handle, ProcessHandle)
startNginx = do
        (Maybe Handle
_, Just Handle
stdoutHdl, Just Handle
stderrHdl, ProcessHandle
processHandle) <-
          CreateProcess
-> App (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *).
MonadIO m =>
CreateProcess
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess
            (FilePath -> [FilePath] -> CreateProcess
proc FilePath
"nginx" [FilePath
"-c", FilePath
configPath, FilePath
"-g", FilePath
"daemon off;", FilePath
"-e", FilePath
"/dev/stdout"])
              { cwd = Just tmpDir,
                std_out = CreatePipe,
                std_err = CreatePipe
              }
        -- Enable this when debugging
        -- liftIO $ void $ forkIO $ logToConsole id "nginx-zauth-module" stdoutHdl
        -- liftIO $ void $ forkIO $ logToConsole id "nginx-zauth-module" stderrHdl
        (Handle, Handle, ProcessHandle)
-> App (Handle, Handle, ProcessHandle)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handle
stdoutHdl, Handle
stderrHdl, ProcessHandle
processHandle)

      stopNginx :: (a, b, ProcessHandle) -> m ()
stopNginx (a
_, b
_, ProcessHandle
processHandle) = do
        Maybe Pid
mPid <- IO (Maybe Pid) -> m (Maybe Pid)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pid) -> m (Maybe Pid))
-> IO (Maybe Pid) -> m (Maybe Pid)
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO (Maybe Pid)
getPid ProcessHandle
processHandle
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Pid -> (Pid -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Pid
mPid (Signal -> Pid -> IO ()
signalProcess Signal
keyboardSignal)
        Int -> m ExitCode -> m (Maybe ExitCode)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
50000 (ProcessHandle -> m ExitCode
forall (m :: * -> *). MonadIO m => ProcessHandle -> m ExitCode
waitForProcess ProcessHandle
processHandle) m (Maybe ExitCode) -> (Maybe ExitCode -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just ExitCode
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Maybe ExitCode
Nothing -> do
            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Pid -> (Pid -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Pid
mPid (Signal -> Pid -> IO ()
signalProcess Signal
killProcess)
            m ExitCode -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ExitCode -> m ()) -> m ExitCode -> m ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> m ExitCode
forall (m :: * -> *). MonadIO m => ProcessHandle -> m ExitCode
waitForProcess ProcessHandle
processHandle
  (Handle, Handle, ProcessHandle)
_ <- (forall b. ((Handle, Handle, ProcessHandle) -> App b) -> App b)
-> Codensity App (Handle, Handle, ProcessHandle)
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b. ((Handle, Handle, ProcessHandle) -> App b) -> App b)
 -> Codensity App (Handle, Handle, ProcessHandle))
-> (forall b. ((Handle, Handle, ProcessHandle) -> App b) -> App b)
-> Codensity App (Handle, Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ App (Handle, Handle, ProcessHandle)
-> ((Handle, Handle, ProcessHandle) -> App ())
-> ((Handle, Handle, ProcessHandle) -> App b)
-> App b
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket App (Handle, Handle, ProcessHandle)
startNginx (Handle, Handle, ProcessHandle) -> App ()
forall {m :: * -> *} {a} {b}.
MonadUnliftIO m =>
(a, b, ProcessHandle) -> m ()
stopNginx

  -- The http-client package doesn't support connecting to servers running on a
  -- unix domain socket. So, we bind to a random TCP port and forward the
  -- requests and responses to and from the unix domain socket of nginx.
  (Int
port, Socket
sock) <- (forall b. ((Int, Socket) -> App b) -> App b)
-> Codensity App (Int, Socket)
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b. ((Int, Socket) -> App b) -> App b)
 -> Codensity App (Int, Socket))
-> (forall b. ((Int, Socket) -> App b) -> App b)
-> Codensity App (Int, Socket)
forall a b. (a -> b) -> a -> b
$ App (Int, Socket)
-> ((Int, Socket) -> App ()) -> ((Int, Socket) -> App b) -> App b
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (IO (Int, Socket) -> App (Int, Socket)
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, Socket) -> App (Int, Socket))
-> IO (Int, Socket) -> App (Int, Socket)
forall a b. (a -> b) -> a -> b
$ HostPreference -> IO (Int, Socket)
bindRandomPortTCP (FilePath -> HostPreference
forall a. IsString a => FilePath -> a
fromString FilePath
"*6")) (IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ())
-> ((Int, Socket) -> IO ()) -> (Int, Socket) -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO ()
NS.close (Socket -> IO ())
-> ((Int, Socket) -> Socket) -> (Int, Socket) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Socket) -> Socket
forall a b. (a, b) -> b
snd)
  Async ()
_ <- (forall b. (Async () -> App b) -> App b)
-> Codensity App (Async ())
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b. (Async () -> App b) -> App b)
 -> Codensity App (Async ()))
-> (forall b. (Async () -> App b) -> App b)
-> Codensity App (Async ())
forall a b. (a -> b) -> a -> b
$ App (Async ())
-> (Async () -> App ()) -> (Async () -> App b) -> App b
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (App () -> App (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (App () -> App (Async ())) -> App () -> App (Async ())
forall a b. (a -> b) -> a -> b
$ Socket -> FilePath -> App ()
forall (m :: * -> *). MonadIO m => Socket -> FilePath -> m ()
forwardToUnixDomain Socket
sock FilePath
unixSocketPath) Async () -> App ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
Async.cancel
  Int -> Codensity App Int
forall a. a -> Codensity App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
port

forwardToUnixDomain :: (MonadIO m) => Socket -> FilePath -> m ()
forwardToUnixDomain :: forall (m :: * -> *). MonadIO m => Socket -> FilePath -> m ()
forwardToUnixDomain Socket
tcpSock FilePath
unixSockAddr = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (IO () -> IO ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  (Socket
conn, SockAddr
_) <- Socket -> IO (Socket, SockAddr)
NS.accept Socket
tcpSock
  IO (Async ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async ()) -> IO ()) -> IO (Async ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ do
    Socket
unixSock <- Family -> SocketType -> Signal -> IO Socket
NS.socket Family
NS.AF_UNIX SocketType
NS.Stream Signal
NS.defaultProtocol
    Socket -> SockAddr -> IO ()
NS.connect Socket
unixSock (FilePath -> SockAddr
NS.SockAddrUnix FilePath
unixSockAddr)

    Async ()
tcpToUnix <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Socket -> Socket -> IO ()
forward Socket
conn Socket
unixSock
    Async ()
unixToTCP <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Socket -> Socket -> IO ()
forward Socket
unixSock Socket
conn

    IO ((), ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ((), ()) -> IO ()) -> IO ((), ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Async () -> Async () -> IO ((), ())
forall (m :: * -> *) a b.
MonadIO m =>
Async a -> Async b -> m (a, b)
waitBoth Async ()
tcpToUnix Async ()
unixToTCP

forward :: Socket -> Socket -> IO ()
forward :: Socket -> Socket -> IO ()
forward Socket
src Socket
dst = do
  let loop :: IO ()
loop = do
        ByteString
bs <- Socket -> Int -> IO ByteString
NSB.recv Socket
src Int
4096
        if ByteString -> Bool
BS.null ByteString
bs
          then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          else Socket -> ByteString -> IO ()
NSB.sendAll Socket
dst ByteString
bs IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
loop
  IO ()
loop

nginxTestConfigTemplate :: String
nginxTestConfigTemplate :: FilePath
nginxTestConfigTemplate =
  FilePath
[r|
    events {
       worker_connections 128;
    }

    error_log /dev/stderr info;
    pid {pid_file};

    http {
       server {
          listen unix:{socket_path};
          zauth_keystore "./keystore";
          zauth_acl "./acl";
          oauth_pub_key "./oauth-pub-key";

          access_log /dev/stdout combined;

          location / {
            default_type application/json;
            return 200 '{"user":"$zauth_user", "timestamp": "$zauth_timestamp"}';
          }
       }
    }
 |]