-- 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 Galley.External (interpretExternalAccess) where

import Bilge.Request
import Bilge.Retry (httpHandlers)
import Control.Lens
import Control.Retry
import Data.ByteString.Conversion.To
import Data.Id
import Data.Misc
import Galley.Cassandra.Services
import Galley.Cassandra.Util
import Galley.Data.Services (BotMember, botMemId, botMemService)
import Galley.Effects
import Galley.Effects.ExternalAccess (ExternalAccess (..))
import Galley.Env
import Galley.Intra.User
import Galley.Monad
import Imports
import Network.HTTP.Client qualified as Http
import Network.HTTP.Types.Method
import Network.HTTP.Types.Status (status410)
import Polysemy
import Polysemy.Input
import Polysemy.TinyLog
import Ssl.Util (withVerifiedSslConnection)
import System.Logger.Class qualified as Log
import System.Logger.Message (field, msg, val, (~~))
import URI.ByteString
import UnliftIO (Async, async, waitCatch)
import Wire.API.Bot.Service
import Wire.API.Event.Conversation (Event)
import Wire.API.Provider.Service (serviceRefId, serviceRefProvider)

interpretExternalAccess ::
  ( Member (Embed IO) r,
    Member (Input Env) r,
    Member TinyLog r
  ) =>
  Sem (ExternalAccess ': r) a ->
  Sem r a
interpretExternalAccess :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input Env) r, Member TinyLog r) =>
Sem (ExternalAccess : r) a -> Sem r a
interpretExternalAccess = (forall (rInitial :: EffectRow) x.
 ExternalAccess (Sem rInitial) x -> Sem r x)
-> Sem (ExternalAccess : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  ExternalAccess (Sem rInitial) x -> Sem r x)
 -> Sem (ExternalAccess : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    ExternalAccess (Sem rInitial) x -> Sem r x)
-> Sem (ExternalAccess : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Deliver f (BotMember, Event)
pp -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ExternalAccess.Deliver"
    App [BotMember] -> Sem r [BotMember]
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input Env) r) =>
App a -> Sem r a
embedApp (App [BotMember] -> Sem r [BotMember])
-> App [BotMember] -> Sem r [BotMember]
forall a b. (a -> b) -> a -> b
$ [(BotMember, Event)] -> App [BotMember]
deliver (f (BotMember, Event) -> [(BotMember, Event)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (BotMember, Event)
pp)
  DeliverAsync f (BotMember, Event)
pp -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ExternalAccess.DeliverAsync"
    App () -> Sem r ()
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input Env) r) =>
App a -> Sem r a
embedApp (App () -> Sem r ()) -> App () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ [(BotMember, Event)] -> App ()
deliverAsync (f (BotMember, Event) -> [(BotMember, Event)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (BotMember, Event)
pp)
  DeliverAndDeleteAsync ConvId
cid f (BotMember, Event)
pp -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ExternalAccess.DeliverAndDeleteAsync"
    App () -> Sem r ()
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input Env) r) =>
App a -> Sem r a
embedApp (App () -> Sem r ()) -> App () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ ConvId -> [(BotMember, Event)] -> App ()
deliverAndDeleteAsync ConvId
cid (f (BotMember, Event) -> [(BotMember, Event)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (BotMember, Event)
pp)

-- | Like deliver, but ignore orphaned bots and return immediately.
--
-- FUTUREWORK: Check if this can be removed.
deliverAsync :: [(BotMember, Event)] -> App ()
deliverAsync :: [(BotMember, Event)] -> App ()
deliverAsync = App ThreadId -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ThreadId -> App ())
-> ([(BotMember, Event)] -> App ThreadId)
-> [(BotMember, Event)]
-> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> App ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO (App () -> App ThreadId)
-> ([(BotMember, Event)] -> App ())
-> [(BotMember, Event)]
-> App ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App [BotMember] -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App [BotMember] -> App ())
-> ([(BotMember, Event)] -> App [BotMember])
-> [(BotMember, Event)]
-> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(BotMember, Event)] -> App [BotMember]
deliver

-- | Like deliver, but remove orphaned bots and return immediately.
deliverAndDeleteAsync :: ConvId -> [(BotMember, Event)] -> App ()
deliverAndDeleteAsync :: ConvId -> [(BotMember, Event)] -> App ()
deliverAndDeleteAsync ConvId
cnv [(BotMember, Event)]
pushes = App ThreadId -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App ThreadId -> App ())
-> (App () -> App ThreadId) -> App () -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App () -> App ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
  [BotMember]
gone <- [(BotMember, Event)] -> App [BotMember]
deliver [(BotMember, Event)]
pushes
  (BotMember -> App ()) -> [BotMember] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ConvId -> BotId -> App ()
deleteBot ConvId
cnv (BotId -> App ()) -> (BotMember -> BotId) -> BotMember -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotMember -> BotId
botMemId) [BotMember]
gone

deliver :: [(BotMember, Event)] -> App [BotMember]
deliver :: [(BotMember, Event)] -> App [BotMember]
deliver [(BotMember, Event)]
pp = ((BotMember, Event) -> App (Async Bool))
-> [(BotMember, Event)] -> App [Async Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (App Bool -> App (Async Bool)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (App Bool -> App (Async Bool))
-> ((BotMember, Event) -> App Bool)
-> (BotMember, Event)
-> App (Async Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BotMember, Event) -> App Bool
exec) [(BotMember, Event)]
pp App [Async Bool]
-> ([Async Bool] -> App [BotMember]) -> App [BotMember]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([BotMember] -> (BotMember, Async Bool) -> App [BotMember])
-> [BotMember] -> [(BotMember, Async Bool)] -> App [BotMember]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [BotMember] -> (BotMember, Async Bool) -> App [BotMember]
eval [] ([(BotMember, Async Bool)] -> App [BotMember])
-> ([Async Bool] -> [(BotMember, Async Bool)])
-> [Async Bool]
-> App [BotMember]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BotMember] -> [Async Bool] -> [(BotMember, Async Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((BotMember, Event) -> BotMember)
-> [(BotMember, Event)] -> [BotMember]
forall a b. (a -> b) -> [a] -> [b]
map (BotMember, Event) -> BotMember
forall a b. (a, b) -> a
fst [(BotMember, Event)]
pp)
  where
    exec :: (BotMember, Event) -> App Bool
    exec :: (BotMember, Event) -> App Bool
exec (BotMember
b, Event
e) =
      ServiceRef -> App (Maybe Service)
forall (m :: * -> *).
MonadClient m =>
ServiceRef -> m (Maybe Service)
lookupService (BotMember -> ServiceRef
botMemService BotMember
b) App (Maybe Service) -> (Maybe Service -> App Bool) -> App Bool
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Service
Nothing -> Bool -> App Bool
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        Just Service
s -> do
          Service -> BotMember -> Event -> App ()
deliver1 Service
s BotMember
b Event
e
          Bool -> App Bool
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    eval :: [BotMember] -> (BotMember, Async Bool) -> App [BotMember]
    eval :: [BotMember] -> (BotMember, Async Bool) -> App [BotMember]
eval [BotMember]
gone (BotMember
b, Async Bool
a) = do
      let s :: ServiceRef
s = BotMember -> ServiceRef
botMemService BotMember
b
      Either SomeException Bool
r <- Async Bool -> App (Either SomeException Bool)
forall (m :: * -> *) a.
MonadIO m =>
Async a -> m (Either SomeException a)
waitCatch Async Bool
a
      case Either SomeException Bool
r of
        Right Bool
True -> do
          (Msg -> Msg) -> App ()
forall (m :: * -> *). MonadLogger m => (Msg -> Msg) -> m ()
Log.debug ((Msg -> Msg) -> App ()) -> (Msg -> Msg) -> App ()
forall a b. (a -> b) -> a -> b
$
            ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"provider" (ProviderId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (ServiceRef
s ServiceRef
-> Getting ProviderId ServiceRef ProviderId -> ProviderId
forall s a. s -> Getting a s a -> a
^. Getting ProviderId ServiceRef ProviderId
Lens' ServiceRef ProviderId
serviceRefProvider))
              (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"service" (ServiceId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (ServiceRef
s ServiceRef -> Getting ServiceId ServiceRef ServiceId -> ServiceId
forall s a. s -> Getting a s a -> a
^. Getting ServiceId ServiceRef ServiceId
Lens' ServiceRef ServiceId
serviceRefId))
              (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"bot" (BotId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (BotMember -> BotId
botMemId BotMember
b))
              (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ Builder -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
msg (ByteString -> Builder
val ByteString
"External delivery success")
          [BotMember] -> App [BotMember]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [BotMember]
gone
        Right Bool
False -> do
          (Msg -> Msg) -> App ()
forall (m :: * -> *). MonadLogger m => (Msg -> Msg) -> m ()
Log.debug ((Msg -> Msg) -> App ()) -> (Msg -> Msg) -> App ()
forall a b. (a -> b) -> a -> b
$
            ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"provider" (ProviderId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (ServiceRef
s ServiceRef
-> Getting ProviderId ServiceRef ProviderId -> ProviderId
forall s a. s -> Getting a s a -> a
^. Getting ProviderId ServiceRef ProviderId
Lens' ServiceRef ProviderId
serviceRefProvider))
              (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"service" (ServiceId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (ServiceRef
s ServiceRef -> Getting ServiceId ServiceRef ServiceId -> ServiceId
forall s a. s -> Getting a s a -> a
^. Getting ServiceId ServiceRef ServiceId
Lens' ServiceRef ServiceId
serviceRefId))
              (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"bot" (BotId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (BotMember -> BotId
botMemId BotMember
b))
              (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ Builder -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
msg (ByteString -> Builder
val ByteString
"External service gone")
          [BotMember] -> App [BotMember]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotMember
b BotMember -> [BotMember] -> [BotMember]
forall a. a -> [a] -> [a]
: [BotMember]
gone)
        Left SomeException
ex
          | Just (Http.HttpExceptionRequest Request
_ (Http.StatusCodeException Response ()
rs ByteString
_)) <- SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex,
            Response () -> Status
forall body. Response body -> Status
Http.responseStatus Response ()
rs Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status410 -> do
              (Msg -> Msg) -> App ()
forall (m :: * -> *). MonadLogger m => (Msg -> Msg) -> m ()
Log.debug ((Msg -> Msg) -> App ()) -> (Msg -> Msg) -> App ()
forall a b. (a -> b) -> a -> b
$
                ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"provider" (ProviderId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (ServiceRef
s ServiceRef
-> Getting ProviderId ServiceRef ProviderId -> ProviderId
forall s a. s -> Getting a s a -> a
^. Getting ProviderId ServiceRef ProviderId
Lens' ServiceRef ProviderId
serviceRefProvider))
                  (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"service" (ServiceId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (ServiceRef
s ServiceRef -> Getting ServiceId ServiceRef ServiceId -> ServiceId
forall s a. s -> Getting a s a -> a
^. Getting ServiceId ServiceRef ServiceId
Lens' ServiceRef ServiceId
serviceRefId))
                  (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"bot" (BotId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (BotMember -> BotId
botMemId BotMember
b))
                  (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ Builder -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
msg (ByteString -> Builder
val ByteString
"External bot gone")
              [BotMember] -> App [BotMember]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BotMember
b BotMember -> [BotMember] -> [BotMember]
forall a. a -> [a] -> [a]
: [BotMember]
gone)
        Left SomeException
ex -> do
          (Msg -> Msg) -> App ()
forall (m :: * -> *). MonadLogger m => (Msg -> Msg) -> m ()
Log.info ((Msg -> Msg) -> App ()) -> (Msg -> Msg) -> App ()
forall a b. (a -> b) -> a -> b
$
            ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"provider" (ProviderId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (ServiceRef
s ServiceRef
-> Getting ProviderId ServiceRef ProviderId -> ProviderId
forall s a. s -> Getting a s a -> a
^. Getting ProviderId ServiceRef ProviderId
Lens' ServiceRef ProviderId
serviceRefProvider))
              (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"service" (ServiceId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (ServiceRef
s ServiceRef -> Getting ServiceId ServiceRef ServiceId -> ServiceId
forall s a. s -> Getting a s a -> a
^. Getting ServiceId ServiceRef ServiceId
Lens' ServiceRef ServiceId
serviceRefId))
              (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"bot" (BotId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (BotMember -> BotId
botMemId BotMember
b))
              (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ ByteString -> String -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
field ByteString
"error" (SomeException -> String
forall a. Show a => a -> String
show SomeException
ex)
              (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
~~ Builder -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
msg (ByteString -> Builder
val ByteString
"External delivery failure")
          [BotMember] -> App [BotMember]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [BotMember]
gone

-- Internal -------------------------------------------------------------------

deliver1 :: Service -> BotMember -> Event -> App ()
deliver1 :: Service -> BotMember -> Event -> App ()
deliver1 Service
s BotMember
bm Event
e
  | Service
s Service -> Getting Bool Service Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Service Bool
Lens' Service Bool
serviceEnabled = do
      let t :: ByteString
t = ServiceToken -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' (Service
s Service
-> Getting ServiceToken Service ServiceToken -> ServiceToken
forall s a. s -> Getting a s a -> a
^. Getting ServiceToken Service ServiceToken
Lens' Service ServiceToken
serviceToken)
      let u :: HttpsUrl
u = Service
s Service -> Getting HttpsUrl Service HttpsUrl -> HttpsUrl
forall s a. s -> Getting a s a -> a
^. Getting HttpsUrl Service HttpsUrl
Lens' Service HttpsUrl
serviceUrl
      let b :: BotId
b = BotMember -> BotId
botMemId BotMember
bm
      let HttpsUrl URIRef Absolute
url = HttpsUrl
u
      RetryPolicyM App
-> [RetryStatus -> Handler App Bool]
-> (RetryStatus -> App ())
-> App ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering RetryPolicyM App
RetryPolicy
x3 [RetryStatus -> Handler App Bool]
forall (m :: * -> *) a. Monad m => [a -> Handler m Bool]
httpHandlers ((RetryStatus -> App ()) -> App ())
-> (RetryStatus -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$
        App () -> RetryStatus -> App ()
forall a b. a -> b -> a
const (App () -> RetryStatus -> App ())
-> App () -> RetryStatus -> App ()
forall a b. (a -> b) -> a -> b
$
          [Fingerprint Rsa] -> (Request -> Request) -> App ()
sendMessage (Service
s Service
-> Getting [Fingerprint Rsa] Service [Fingerprint Rsa]
-> [Fingerprint Rsa]
forall s a. s -> Getting a s a -> a
^. Getting [Fingerprint Rsa] Service [Fingerprint Rsa]
Lens' Service [Fingerprint Rsa]
serviceFingerprints) ((Request -> Request) -> App ()) -> (Request -> Request) -> App ()
forall a b. (a -> b) -> a -> b
$
            StdMethod -> Request -> Request
method StdMethod
POST
              (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> Request)
-> (ByteString -> Request -> Request)
-> Maybe ByteString
-> Request
-> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> Request
forall a. a -> a
id ByteString -> Request -> Request
host (HttpsUrl -> Maybe ByteString
urlHost HttpsUrl
u)
              (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> Request)
-> (Word16 -> Request -> Request)
-> Maybe Word16
-> Request
-> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Word16 -> Request -> Request
port Word16
443) Word16 -> Request -> Request
port (HttpsUrl -> Maybe Word16
urlPort HttpsUrl
u)
              (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Request -> Request
paths [URIRef Absolute
url URIRef Absolute
-> Getting ByteString (URIRef Absolute) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (URIRef Absolute) ByteString
forall a (f :: * -> *).
Functor f =>
(ByteString -> f ByteString) -> URIRef a -> f (URIRef a)
pathL, ByteString
"bots", BotId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' BotId
b, ByteString
"messages"]
              (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> ByteString -> Request -> Request
header HeaderName
"Authorization" (ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t)
              (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
json Event
e
              (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Request -> Request
timeout Int
5000
              (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
secure
              (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
  | Bool
otherwise = () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

urlHost :: HttpsUrl -> Maybe ByteString
urlHost :: HttpsUrl -> Maybe ByteString
urlHost (HttpsUrl URIRef Absolute
u) = URIRef Absolute
u URIRef Absolute
-> Getting (Maybe Authority) (URIRef Absolute) (Maybe Authority)
-> Maybe Authority
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Authority) (URIRef Absolute) (Maybe Authority)
forall a (f :: * -> *).
Functor f =>
(Maybe Authority -> f (Maybe Authority))
-> URIRef a -> f (URIRef a)
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
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
hostBSL)

urlPort :: HttpsUrl -> Maybe Word16
urlPort :: HttpsUrl -> Maybe Word16
urlPort (HttpsUrl URIRef Absolute
u) = do
  Authority
a <- URIRef Absolute
u URIRef Absolute
-> Getting (Maybe Authority) (URIRef Absolute) (Maybe Authority)
-> Maybe Authority
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Authority) (URIRef Absolute) (Maybe Authority)
forall a (f :: * -> *).
Functor f =>
(Maybe Authority -> f (Maybe Authority))
-> URIRef a -> f (URIRef a)
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)
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
portNumberL))

sendMessage :: [Fingerprint Rsa] -> (Request -> Request) -> App ()
sendMessage :: [Fingerprint Rsa] -> (Request -> Request) -> App ()
sendMessage [Fingerprint Rsa]
fprs Request -> Request
reqBuilder = do
  (Manager
man, [Fingerprint Rsa] -> SSL -> IO ()
verifyFingerprints) <- Getting
  (Manager, [Fingerprint Rsa] -> SSL -> IO ())
  Env
  (Manager, [Fingerprint Rsa] -> SSL -> IO ())
-> App (Manager, [Fingerprint Rsa] -> SSL -> IO ())
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ExtEnv
 -> Const (Manager, [Fingerprint Rsa] -> SSL -> IO ()) ExtEnv)
-> Env -> Const (Manager, [Fingerprint Rsa] -> SSL -> IO ()) Env
Lens' Env ExtEnv
extEnv ((ExtEnv
  -> Const (Manager, [Fingerprint Rsa] -> SSL -> IO ()) ExtEnv)
 -> Env -> Const (Manager, [Fingerprint Rsa] -> SSL -> IO ()) Env)
-> (((Manager, [Fingerprint Rsa] -> SSL -> IO ())
     -> Const
          (Manager, [Fingerprint Rsa] -> SSL -> IO ())
          (Manager, [Fingerprint Rsa] -> SSL -> IO ()))
    -> ExtEnv
    -> Const (Manager, [Fingerprint Rsa] -> SSL -> IO ()) ExtEnv)
-> Getting
     (Manager, [Fingerprint Rsa] -> SSL -> IO ())
     Env
     (Manager, [Fingerprint Rsa] -> SSL -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Manager, [Fingerprint Rsa] -> SSL -> IO ())
 -> Const
      (Manager, [Fingerprint Rsa] -> SSL -> IO ())
      (Manager, [Fingerprint Rsa] -> SSL -> IO ()))
-> ExtEnv
-> Const (Manager, [Fingerprint Rsa] -> SSL -> IO ()) ExtEnv
Iso' ExtEnv (Manager, [Fingerprint Rsa] -> SSL -> IO ())
extGetManager)
  IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ())
-> ((Request -> IO ()) -> IO ()) -> (Request -> IO ()) -> App ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SSL -> IO ())
-> Manager -> (Request -> Request) -> (Request -> IO ()) -> IO ()
forall a.
(SSL -> IO ())
-> Manager -> (Request -> Request) -> (Request -> IO a) -> IO a
withVerifiedSslConnection ([Fingerprint Rsa] -> SSL -> IO ()
verifyFingerprints [Fingerprint Rsa]
fprs) Manager
man Request -> Request
reqBuilder ((Request -> IO ()) -> App ()) -> (Request -> IO ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Request
req ->
    Request -> Manager -> (Response BodyReader -> IO ()) -> IO ()
forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
Http.withResponse Request
req Manager
man (IO () -> Response BodyReader -> IO ()
forall a b. a -> b -> a
const (IO () -> Response BodyReader -> IO ())
-> IO () -> Response BodyReader -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

x3 :: RetryPolicy
x3 :: RetryPolicy
x3 = Int -> RetryPolicy
limitRetries Int
3 RetryPolicyM m -> RetryPolicyM m -> RetryPolicyM m
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicyM m
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
constantDelay Int
1000000