module Testlib.MockIntegrationService
  ( withMockServer,
    lhMockAppWithPrekeys,
    lhMockApp,
    lhMockAppV,
    lhMockNoCommonVersion,
    mkLegalHoldSettings,
    CreateMock (..),
    LiftedApplication,
    MockServerSettings (..),
    LhApiVersion (..),
  )
where

import Control.Monad.Catch
import Control.Monad.Reader
import qualified Data.Aeson
import qualified Data.ByteString.Lazy as LBS
import Data.Streaming.Network
import Data.String.Conversions (cs)
import Network.HTTP.Types
import Network.Socket
import qualified Network.Socket as Socket
import Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.Warp.Internal as Warp
import qualified Network.Wai.Handler.WarpTLS as Warp
import Testlib.Prelude hiding (IntegrationConfig (integrationTestHostName))
import UnliftIO (MonadUnliftIO (withRunInIO))
import UnliftIO.Async
import UnliftIO.Chan
import UnliftIO.MVar
import UnliftIO.Timeout (timeout)

withFreePortAnyAddr :: (MonadMask m, MonadIO m) => ((Warp.Port, Socket) -> m a) -> m a
withFreePortAnyAddr :: forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
((Port, Socket) -> m a) -> m a
withFreePortAnyAddr = m (Port, Socket)
-> ((Port, Socket) -> m ()) -> ((Port, Socket) -> m a) -> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m (Port, Socket)
forall (m :: * -> *). MonadIO m => m (Port, Socket)
openFreePortAnyAddr (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Port, Socket) -> IO ()) -> (Port, Socket) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO ()
Socket.close (Socket -> IO ())
-> ((Port, Socket) -> Socket) -> (Port, Socket) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Port, Socket) -> Socket
forall a b. (a, b) -> b
snd)

openFreePortAnyAddr :: (MonadIO m) => m (Warp.Port, Socket)
openFreePortAnyAddr :: forall (m :: * -> *). MonadIO m => m (Port, Socket)
openFreePortAnyAddr = IO (Port, Socket) -> m (Port, Socket)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Port, Socket) -> m (Port, Socket))
-> IO (Port, Socket) -> m (Port, Socket)
forall a b. (a -> b) -> a -> b
$ HostPreference -> IO (Port, Socket)
bindRandomPortTCP (String -> HostPreference
forall a. IsString a => String -> a
fromString String
"*6")

type LiftedApplication = Request -> (Wai.Response -> App ResponseReceived) -> App ResponseReceived

type Host = String

-- | The channel exists to facilitate out of http comms between the test and the
-- service. Could be used for recording (request, response) pairs.
withMockServer ::
  (HasCallStack) =>
  -- | the mock server settings
  MockServerSettings ->
  -- | The certificate and key pair
  (Chan e -> LiftedApplication) ->
  -- | the test
  ((Host, Warp.Port) -> Chan e -> App a) ->
  App a
withMockServer :: forall e a.
HasCallStack =>
MockServerSettings
-> (Chan e -> LiftedApplication)
-> ((String, Port) -> Chan e -> App a)
-> App a
withMockServer MockServerSettings
settings Chan e -> LiftedApplication
mkApp (String, Port) -> Chan e -> App a
go = ((Port, Socket) -> App a) -> App a
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
((Port, Socket) -> m a) -> m a
withFreePortAnyAddr \(Port
sPort, Socket
sock) -> do
  MVar ()
serverStarted <- App (MVar ())
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
  String
host <- (Env -> String) -> App String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> String
integrationTestHostName
  let tlss :: TLSSettings
tlss = ByteString -> ByteString -> TLSSettings
Warp.tlsSettingsMemory (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs MockServerSettings
settings.certificate) (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs MockServerSettings
settings.privateKey)
  let defs :: Settings
defs = Settings
Warp.defaultSettings {Warp.settingsPort = sPort, Warp.settingsBeforeMainLoop = putMVar serverStarted ()}
  Chan e
buf <- App (Chan e)
forall (m :: * -> *) a. MonadIO m => m (Chan a)
newChan
  Async ()
srv <- 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
$ ((forall a. App a -> IO a) -> IO ()) -> App ()
forall b. ((forall a. App a -> IO a) -> IO b) -> App b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. App a -> IO a
inIO -> do
    TLSSettings -> Settings -> Socket -> Application -> IO ()
Warp.runTLSSocket TLSSettings
tlss Settings
defs Socket
sock \Request
req Response -> IO ResponseReceived
respond -> do
      App ResponseReceived -> IO ResponseReceived
forall a. App a -> IO a
inIO (App ResponseReceived -> IO ResponseReceived)
-> App ResponseReceived -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Chan e -> LiftedApplication
mkApp Chan e
buf Request
req (IO ResponseReceived -> App ResponseReceived
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived -> App ResponseReceived)
-> (Response -> IO ResponseReceived)
-> Response
-> App ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> IO ResponseReceived
respond)
  Maybe ()
srvMVar <- Port -> App () -> App (Maybe ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
Port -> m a -> m (Maybe a)
UnliftIO.Timeout.timeout Port
5_000_000 (MVar () -> App ()
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar ()
serverStarted)
  case Maybe ()
srvMVar of
    Just () -> (String, Port) -> Chan e -> App a
go (String
host, Port
sPort) Chan e
buf App a -> App () -> App a
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` Async () -> App ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel Async ()
srv
    Maybe ()
Nothing -> String -> App a
forall a. HasCallStack => String -> a
error (String -> App a)
-> (Maybe (Either SomeException ()) -> String)
-> Maybe (Either SomeException ())
-> App a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Either SomeException ()) -> String
forall a. Show a => a -> String
show (Maybe (Either SomeException ()) -> App a)
-> App (Maybe (Either SomeException ())) -> App a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Async () -> App (Maybe (Either SomeException ()))
forall (m :: * -> *) a.
MonadIO m =>
Async a -> m (Maybe (Either SomeException a))
poll Async ()
srv

lhMockApp :: Chan (Wai.Request, LBS.ByteString) -> LiftedApplication
lhMockApp :: Chan (Request, ByteString) -> LiftedApplication
lhMockApp = LhApiVersion
-> CreateMock App
-> Chan (Request, ByteString)
-> LiftedApplication
lhMockAppWithPrekeys LhApiVersion
V0 CreateMock App
forall a. Default a => a
def

lhMockAppV :: LhApiVersion -> Chan (Wai.Request, LBS.ByteString) -> LiftedApplication
lhMockAppV :: LhApiVersion -> Chan (Request, ByteString) -> LiftedApplication
lhMockAppV LhApiVersion
v = LhApiVersion
-> CreateMock App
-> Chan (Request, ByteString)
-> LiftedApplication
lhMockAppWithPrekeys LhApiVersion
v CreateMock App
forall a. Default a => a
def

data MockServerSettings = MkMockServerSettings
  { -- | the certificate the mock service uses
    MockServerSettings -> String
certificate :: String,
    -- | the private key the mock service uses
    MockServerSettings -> String
privateKey :: String,
    -- | the public key the mock service uses
    MockServerSettings -> String
publicKey :: String
  }

instance Default MockServerSettings where
  def :: MockServerSettings
def =
    MkMockServerSettings
      { $sel:certificate:MkMockServerSettings :: String
certificate = String
mockServerCert,
        $sel:privateKey:MkMockServerSettings :: String
privateKey = String
mockServerPrivKey,
        $sel:publicKey:MkMockServerSettings :: String
publicKey = String
mockServerPubKey
      }

data CreateMock f = MkCreateMock
  { -- | how to obtain the next last prekey of a mock app
    forall (f :: * -> *). CreateMock f -> f Value
nextLastPrey :: f Value,
    -- | how to obtain some prekeys of a mock app
    forall (f :: * -> *). CreateMock f -> f [Value]
somePrekeys :: f [Value]
  }

instance (App ~ f) => Default (CreateMock f) where
  def :: CreateMock f
def =
    MkCreateMock
      { $sel:nextLastPrey:MkCreateMock :: App Value
nextLastPrey = App Value
getLastPrekey,
        $sel:somePrekeys:MkCreateMock :: App [Value]
somePrekeys = Port -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Port -> m a -> m [a]
replicateM Port
3 App Value
getPrekey
      }

data LhApiVersion = V0 | V1
  deriving (Port -> LhApiVersion -> ShowS
[LhApiVersion] -> ShowS
LhApiVersion -> String
(Port -> LhApiVersion -> ShowS)
-> (LhApiVersion -> String)
-> ([LhApiVersion] -> ShowS)
-> Show LhApiVersion
forall a.
(Port -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Port -> LhApiVersion -> ShowS
showsPrec :: Port -> LhApiVersion -> ShowS
$cshow :: LhApiVersion -> String
show :: LhApiVersion -> String
$cshowList :: [LhApiVersion] -> ShowS
showList :: [LhApiVersion] -> ShowS
Show, (forall x. LhApiVersion -> Rep LhApiVersion x)
-> (forall x. Rep LhApiVersion x -> LhApiVersion)
-> Generic LhApiVersion
forall x. Rep LhApiVersion x -> LhApiVersion
forall x. LhApiVersion -> Rep LhApiVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LhApiVersion -> Rep LhApiVersion x
from :: forall x. LhApiVersion -> Rep LhApiVersion x
$cto :: forall x. Rep LhApiVersion x -> LhApiVersion
to :: forall x. Rep LhApiVersion x -> LhApiVersion
Generic)

-- | LegalHold service.  Just fake the API, do not maintain any internal state.
lhMockAppWithPrekeys ::
  LhApiVersion -> CreateMock App -> Chan (Wai.Request, LBS.ByteString) -> LiftedApplication
lhMockAppWithPrekeys :: LhApiVersion
-> CreateMock App
-> Chan (Request, ByteString)
-> LiftedApplication
lhMockAppWithPrekeys LhApiVersion
version CreateMock App
mks Chan (Request, ByteString)
ch Request
req Response -> App ResponseReceived
cont = ((forall a. App a -> IO a) -> IO ResponseReceived)
-> App ResponseReceived
forall b. ((forall a. App a -> IO a) -> IO b) -> App b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. App a -> IO a
inIO -> do
  ByteString
reqBody <- Request -> IO ByteString
Wai.strictRequestBody Request
req
  Chan (Request, ByteString) -> (Request, ByteString) -> IO ()
forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan Chan (Request, ByteString)
ch (Request
req, ByteString
reqBody)
  App ResponseReceived -> IO ResponseReceived
forall a. App a -> IO a
inIO do
    case LhApiVersion
version of
      LhApiVersion
V0 ->
        case (Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> [Text]
pathInfo Request
req, ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
requestMethod Request
req, forall a b. ConvertibleStrings a b => a -> b
cs @_ @String (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Request -> Maybe ByteString
getRequestHeader String
"Authorization" Request
req) of
          ([String
"legalhold", String
"status"], String
"GET", Maybe String
_) -> Response -> App ResponseReceived
cont Response
respondOk
          ([String]
_, String
_, Maybe String
Nothing) -> Response -> App ResponseReceived
cont Response
missingAuth
          ([String
"legalhold", String
"initiate"], String
"POST", Just String
_) -> do
            (Value
nextLastPrekey, [Value]
threePrekeys) <- App (Value, [Value])
getPreyKeys
            Response -> App ResponseReceived
cont (Value -> [Value] -> Response
initiateResp Value
nextLastPrekey [Value]
threePrekeys)
          ([String
"legalhold", String
"confirm"], String
"POST", Just String
_) -> Response -> App ResponseReceived
cont Response
respondOk
          ([String
"legalhold", String
"remove"], String
"POST", Just String
_) -> Response -> App ResponseReceived
cont Response
respondOk
          ([String], String, Maybe String)
_ -> Response -> App ResponseReceived
cont Response
respondBad
      LhApiVersion
V1 ->
        case (Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> [Text]
pathInfo Request
req, ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
requestMethod Request
req, forall a b. ConvertibleStrings a b => a -> b
cs @_ @String (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Request -> Maybe ByteString
getRequestHeader String
"Authorization" Request
req) of
          ([String
"legalhold", String
"status"], String
"GET", Maybe String
_) -> Response -> App ResponseReceived
cont Response
respondOk
          ([String
"legalhold", String
"api-version"], String
"GET", Maybe String
_) -> Response -> App ResponseReceived
cont (Response -> App ResponseReceived)
-> Response -> App ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Port] -> Response
apiVersionResp [Port
0, Port
1]
          ([String]
_, String
_, Maybe String
Nothing) -> Response -> App ResponseReceived
cont Response
missingAuth
          ([String
"legalhold", String
"initiate"], String
"POST", Just String
_) -> do
            (Value
nextLastPrekey, [Value]
threePrekeys) <- App (Value, [Value])
getPreyKeys
            Response -> App ResponseReceived
cont (Value -> [Value] -> Response
initiateResp Value
nextLastPrekey [Value]
threePrekeys)
          ([String
"legalhold", String
"confirm"], String
"POST", Just String
_) -> Response -> App ResponseReceived
cont Response
respondOk
          ([String
"legalhold", String
"remove"], String
"POST", Just String
_) -> Response -> App ResponseReceived
cont Response
respondOk
          ([String
"legalhold", String
"v1", String
"initiate"], String
"POST", Just String
_) -> do
            (Value
nextLastPrekey, [Value]
threePrekeys) <- App (Value, [Value])
getPreyKeys
            Response -> App ResponseReceived
cont (Value -> [Value] -> Response
initiateResp Value
nextLastPrekey [Value]
threePrekeys)
          ([String
"legalhold", String
"v1", String
"confirm"], String
"POST", Just String
_) -> Response -> App ResponseReceived
cont Response
respondOk
          ([String
"legalhold", String
"v1", String
"remove"], String
"POST", Just String
_) -> Response -> App ResponseReceived
cont Response
respondOk
          ([String], String, Maybe String)
_ -> Response -> App ResponseReceived
cont Response
respondBad
  where
    getPreyKeys :: App (Value, [Value])
    getPreyKeys :: App (Value, [Value])
getPreyKeys = (,) (Value -> [Value] -> (Value, [Value]))
-> App Value -> App ([Value] -> (Value, [Value]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CreateMock App
mks.nextLastPrey App ([Value] -> (Value, [Value]))
-> App [Value] -> App (Value, [Value])
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CreateMock App
mks.somePrekeys

    initiateResp :: Value -> [Value] -> Wai.Response
    initiateResp :: Value -> [Value] -> Response
initiateResp Value
npk [Value]
pks =
      Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 [(HeaderName
hContentType, String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"application/json")]
        (ByteString -> Response)
-> ([Pair] -> ByteString) -> [Pair] -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode
        (Value -> ByteString) -> ([Pair] -> Value) -> [Pair] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
Data.Aeson.object
        ([Pair] -> Response) -> [Pair] -> Response
forall a b. (a -> b) -> a -> b
$ [ String
"prekeys" String -> [Value] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Value]
pks,
            String
"last_prekey" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
npk
          ]

apiVersionResp :: [Int] -> Wai.Response
apiVersionResp :: [Port] -> Response
apiVersionResp [Port]
versions =
  Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 [(HeaderName
hContentType, String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"application/json")]
    (ByteString -> Response)
-> ([Pair] -> ByteString) -> [Pair] -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode
    (Value -> ByteString) -> ([Pair] -> Value) -> [Pair] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
Data.Aeson.object
    ([Pair] -> Response) -> [Pair] -> Response
forall a b. (a -> b) -> a -> b
$ [ String
"supported" String -> [Port] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Port]
versions
      ]

respondOk :: Wai.Response
respondOk :: Response
respondOk = Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 ResponseHeaders
forall a. Monoid a => a
mempty ByteString
forall a. Monoid a => a
mempty

respondBad :: Wai.Response
respondBad :: Response
respondBad = Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status404 ResponseHeaders
forall a. Monoid a => a
mempty ByteString
forall a. Monoid a => a
mempty

missingAuth :: Wai.Response
missingAuth :: Response
missingAuth = Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status400 ResponseHeaders
forall a. Monoid a => a
mempty (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"no authorization header")

getRequestHeader :: String -> Wai.Request -> Maybe ByteString
getRequestHeader :: String -> Request -> Maybe ByteString
getRequestHeader String
name = HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> HeaderName
forall a. IsString a => String -> a
fromString String
name) (ResponseHeaders -> Maybe ByteString)
-> (Request -> ResponseHeaders) -> Request -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ResponseHeaders
requestHeaders

lhMockNoCommonVersion ::
  Chan () -> LiftedApplication
lhMockNoCommonVersion :: Chan () -> LiftedApplication
lhMockNoCommonVersion Chan ()
_ Request
req Response -> App ResponseReceived
cont = ((forall a. App a -> IO a) -> IO ResponseReceived)
-> App ResponseReceived
forall b. ((forall a. App a -> IO a) -> IO b) -> App b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. App a -> IO a
inIO -> do
  App ResponseReceived -> IO ResponseReceived
forall a. App a -> IO a
inIO do
    case (Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> [Text]
pathInfo Request
req, ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
requestMethod Request
req) of
      ([String
"legalhold", String
"status"], String
"GET") -> Response -> App ResponseReceived
cont Response
respondOk
      ([String
"legalhold", String
"api-version"], String
"GET") -> Response -> App ResponseReceived
cont (Response -> App ResponseReceived)
-> Response -> App ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Port] -> Response
apiVersionResp [Port
9999999]
      ([String], String)
_ -> Response -> App ResponseReceived
cont Response
respondBad

mkLegalHoldSettings :: (String, Warp.Port) -> Value
mkLegalHoldSettings :: (String, Port) -> Value
mkLegalHoldSettings (String
botHost, Port
lhPort) =
  [Pair] -> Value
object
    [ String
"base_url" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
"https://" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
botHost String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Port -> String
forall a. Show a => a -> String
show Port
lhPort String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/legalhold"),
      String
"public_key" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
mockServerPubKey,
      String
"auth_token" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"tok"
    ]

mockServerPubKey :: String
mockServerPubKey :: String
mockServerPubKey =
  String
"-----BEGIN PUBLIC KEY-----\n\
  \MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAu+Kg/PHHU3atXrUbKnw0\n\
  \G06FliXcNt3lMwl2os5twEDcPPFw/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPH\n\
  \WvUBdiLfGrZqJO223DB6D8K2Su/odmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKV\n\
  \VPOaOzgtAB21XKRiQ4ermqgi3/njr03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiS\n\
  \bUKr/BeArYRcjzr/h5m1In6fG/if9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg8\n\
  \7X883H+LA/d6X5CTiPv1VMxXdBUiGPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7la\n\
  \nQIDAQAB\n\
  \-----END PUBLIC KEY-----"

mockServerPrivKey :: String
mockServerPrivKey :: String
mockServerPrivKey =
  String
"-----BEGIN RSA PRIVATE KEY-----\n\
  \MIIEpAIBAAKCAQEAu+Kg/PHHU3atXrUbKnw0G06FliXcNt3lMwl2os5twEDcPPFw\n\
  \/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPHWvUBdiLfGrZqJO223DB6D8K2Su/o\n\
  \dmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKVVPOaOzgtAB21XKRiQ4ermqgi3/nj\n\
  \r03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiSbUKr/BeArYRcjzr/h5m1In6fG/if\n\
  \9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg87X883H+LA/d6X5CTiPv1VMxXdBUi\n\
  \GPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7lanQIDAQABAoIBAQC0doVy7zgpLsBv\n\
  \Sz0AnbPe1pjxEwRlntRbJSfSULySALqJvs5s4adSVGUBHX3z/LousAP1SRpCppuU\n\
  \8wrLBFgjQVlaAzyQB84EEl+lNtrG8Jrvd2es9R/4sJDkqy50+yuPN5wnzWPFIjhg\n\
  \3jP5CHDu29y0LMzsY5yjkzDe9B0bueXEZVU+guRjhpwHHKOFeAr9J9bugFUwgeAr\n\
  \jF0TztzFAb0fsUNPiQAho1J5PyjSVgItaPfAPv/p30ROG+rz+Rd5NSSvBC5F+yOo\n\
  \azb84zzwCg/knAfIz7SOMRrmBh2qhGZFZ8gXdq65UaYv+cpT/qo28mpAT2vOkyeD\n\
  \aPZp0ysBAoGBAOQROoDipe/5BTHBcXYuUE1qa4RIj3wgql5I8igXr4K6ppYBmaOg\n\
  \DL2rrnqD86chv0P4l/XOomKFwYhVGXtqRkeYnk6mQXwNVkgqcGbY5PSNyMg5+ekq\n\
  \jSOOPHGzzTWKzYuUDUpB/Lf6jbTv8fq2GYW3ZYiqQ/xiugOvglZrTE7NAoGBANLl\n\
  \irjByfxAWGhzCrDx0x5MBpsetadI9wUA8u1BDdymsRg73FDn3z7NipVUAMDXMGVj\n\
  \lqbCRlHESO2yP4GaPEA4FM+MbTZSuhAYV+SY07mEPLHF64/nJas83Zp91r5rhaqJ\n\
  \L9rWCl3KJ5OUnr3YizCnHIW72FxjwtpjxHJLupsRAoGAGIbhy8qUHeKh9F/hW9xP\n\
  \NoQjW+6Rv7+jktA1eqpRbbW1BJzXcQldVWiJMxPNuEOg1iZ98SlvvTi1P3wnaWZc\n\
  \eIapP7wRfs3QYaJuxCC/Pq2g0ieqALFazGAXkALOJtvujvw1Ea9XBlIjuzmyxEuh\n\
  \Iwg+Gxx0g0f6yTquwax4YGECgYEAnpAK3qKFNO1ECzQDo8oNy0ep59MNDPtlDhQK\n\
  \katJus5xdCD9oq7TQKrVOTTxZAvmzTQ1PqfuqueDVYOhD9Zg2n/P1cRlEGTek99Z\n\
  \pfvppB/yak6+r3FA9yBKFS/r1zuMQg3nNweav62QV/tz5pT7AdeDMGFtaPlwtTYx\n\
  \qyWY5aECgYBPySbPccNj+xxQzxcti2y/UXjC04RgOA/Hm1D0exa0vBqS9uxlOdG8\n\
  \F47rKenpBrslvdfTVsCDB1xyP2ebWVzp6EqMycw6OLPxgo3fBfZ4pi6P+rByh0Cc\n\
  \Lhfh+ET0CPnKCxtop3lUrn4ZvqchS0j3J+M0pDuqoWF5hfKxFhkEIw==\n\
  \-----END RSA PRIVATE KEY-----"

mockServerCert :: String
mockServerCert :: String
mockServerCert =
  String
"-----BEGIN CERTIFICATE-----\n\
  \MIIDdjCCAl4CCQCm0AiwERR/qjANBgkqhkiG9w0BAQsFADB9MQswCQYDVQQGEwJE\n\
  \RTEPMA0GA1UECAwGQmVybGluMQ8wDQYDVQQHDAZCZXJsaW4xGDAWBgNVBAoMD1dp\n\
  \cmUgU3dpc3MgR21iSDERMA8GA1UEAwwId2lyZS5jb20xHzAdBgkqhkiG9w0BCQEW\n\
  \EGJhY2tlbmRAd2lyZS5jb20wHhcNMTYwODA0MTMxNDQyWhcNMzYwNzMwMTMxNDQy\n\
  \WjB9MQswCQYDVQQGEwJERTEPMA0GA1UECAwGQmVybGluMQ8wDQYDVQQHDAZCZXJs\n\
  \aW4xGDAWBgNVBAoMD1dpcmUgU3dpc3MgR21iSDERMA8GA1UEAwwId2lyZS5jb20x\n\
  \HzAdBgkqhkiG9w0BCQEWEGJhY2tlbmRAd2lyZS5jb20wggEiMA0GCSqGSIb3DQEB\n\
  \AQUAA4IBDwAwggEKAoIBAQC74qD88cdTdq1etRsqfDQbToWWJdw23eUzCXaizm3A\n\
  \QNw88XD994aIArKbGn7smpkOux5LkP1Mcatb45BEg8da9QF2It8atmok7bbcMHoP\n\
  \wrZK7+h2aeNknbPbeuFegQCtOmW74OD0r5zYtV5dMpVU85o7OC0AHbVcpGJDh6ua\n\
  \qCLf+eOvTetfKr+o2S413q01yD4cB8bF8a+8JJgF+JJtQqv8F4CthFyPOv+HmbUi\n\
  \fp8b+J/0YQjqbx3EdP0ltjnfCKSyjDLpqMK6qyQgWDztfzzcf4sD93pfkJOI+/VU\n\
  \zFd0FSIY+4L0hP/oI1DX8sW3Q/ftrHnz4sZiVoWjuVqdAgMBAAEwDQYJKoZIhvcN\n\
  \AQELBQADggEBAEuwlHElIGR56KVC1dJiw238mDGjMfQzSP76Wi4zWS6/zZwJUuog\n\
  \BkC+vacfju8UAMvL+vdqkjOVUHor84/2wuq0qn91AjOITD7tRAZB+XLXxsikKv/v\n\
  \OXE3A/lCiNi882NegPyXAfFPp/71CIiTQZps1eQkAvhD5t5WiFYPESxDlvEJrHFY\n\
  \XP4+pp8fL8YPS7iZNIq+z+P8yVIw+B/Hs0ht7wFIYN0xACbU8m9+Rs08JMoT16c+\n\
  \hZMuK3BWD3fzkQVfW0yMwz6fWRXB483ZmekGkgndOTDoJQMdJXZxHpI3t2FcxQYj\n\
  \T45GXxRd18neXtuYa/OoAw9UQFDN5XfXN0g=\n\
  \-----END CERTIFICATE-----"