module Galley.External.LegalHoldService
(
checkLegalHoldServiceStatus,
requestNewDevice,
confirmLegalHold,
removeLegalHold,
validateServiceKey,
)
where
import Bilge qualified
import Bilge.Response
import Brig.Types.Team.LegalHold
import Data.Aeson
import Data.ByteString.Conversion.To
import Data.ByteString.Lazy.Char8 qualified as LC8
import Data.Id
import Data.Misc
import Galley.Effects.LegalHoldStore as LegalHoldData
import Galley.External.LegalHoldService.Types
import Imports
import Network.HTTP.Client qualified as Http
import Network.HTTP.Types
import Polysemy
import Polysemy.TinyLog qualified as P
import System.Logger.Class qualified as Log
import Wire.API.Error (ErrorS, throwS)
import Wire.API.Error.Galley
import Wire.API.Team.LegalHold.External
checkLegalHoldServiceStatus ::
( Member (ErrorS 'LegalHoldServiceBadResponse) r,
Member LegalHoldStore r,
Member P.TinyLog r
) =>
Fingerprint Rsa ->
HttpsUrl ->
Sem r ()
checkLegalHoldServiceStatus :: forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceBadResponse) r,
Member LegalHoldStore r, Member TinyLog r) =>
Fingerprint Rsa -> HttpsUrl -> Sem r ()
checkLegalHoldServiceStatus Fingerprint Rsa
fpr HttpsUrl
url = do
Response ByteString
resp <- Fingerprint Rsa
-> HttpsUrl -> (Request -> Request) -> Sem r (Response ByteString)
forall (r :: EffectRow).
Member LegalHoldStore r =>
Fingerprint Rsa
-> HttpsUrl -> (Request -> Request) -> Sem r (Response ByteString)
makeVerifiedRequestFreshManager Fingerprint Rsa
fpr HttpsUrl
url Request -> Request
reqBuilder
if Response ByteString -> Int
forall a. Response a -> Int
Bilge.statusCode Response ByteString
resp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
400
then () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else do
(Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.info ((Msg -> Msg) -> Sem r ())
-> (String -> Msg -> Msg) -> String -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Log.msg (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Response ByteString -> String
forall a. Show a => Response a -> String
showResponse Response ByteString
resp
forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'LegalHoldServiceBadResponse
where
reqBuilder :: Http.Request -> Http.Request
reqBuilder :: Request -> Request
reqBuilder =
[ByteString] -> Request -> Request
Bilge.paths [ByteString
"status"]
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
Bilge.method StdMethod
GET
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
Bilge.expect2xx
requestNewDevice ::
( Member (ErrorS 'LegalHoldServiceBadResponse) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r,
Member P.TinyLog r
) =>
TeamId ->
UserId ->
Sem r NewLegalHoldClient
requestNewDevice :: forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceBadResponse) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r, Member TinyLog r) =>
TeamId -> UserId -> Sem r NewLegalHoldClient
requestNewDevice TeamId
tid UserId
uid = do
Response ByteString
resp <- TeamId -> (Request -> Request) -> Sem r (Response ByteString)
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r) =>
TeamId -> (Request -> Request) -> Sem r (Response ByteString)
makeLegalHoldServiceRequest TeamId
tid Request -> Request
reqParams
case ByteString -> Either String NewLegalHoldClient
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp) of
Left String
e -> do
(Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.info ((Msg -> Msg) -> Sem r ())
-> (String -> Msg -> Msg) -> String -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Log.msg (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ String
"Error decoding NewLegalHoldClient: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e
forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'LegalHoldServiceBadResponse
Right NewLegalHoldClient
client -> NewLegalHoldClient -> Sem r NewLegalHoldClient
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NewLegalHoldClient
client
where
reqParams :: Request -> Request
reqParams =
[ByteString] -> Request -> Request
Bilge.paths [ByteString
"initiate"]
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestNewLegalHoldClient -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
Bilge.json (UserId -> TeamId -> RequestNewLegalHoldClient
RequestNewLegalHoldClient UserId
uid TeamId
tid)
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
Bilge.method StdMethod
POST
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
Bilge.acceptJson
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
Bilge.expect2xx
confirmLegalHold ::
( Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r
) =>
ClientId ->
TeamId ->
UserId ->
OpaqueAuthToken ->
Sem r ()
confirmLegalHold :: forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r) =>
ClientId -> TeamId -> UserId -> OpaqueAuthToken -> Sem r ()
confirmLegalHold ClientId
clientId TeamId
tid UserId
uid OpaqueAuthToken
legalHoldAuthToken = do
Sem r (Response ByteString) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Response ByteString) -> Sem r ())
-> Sem r (Response ByteString) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TeamId -> (Request -> Request) -> Sem r (Response ByteString)
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r) =>
TeamId -> (Request -> Request) -> Sem r (Response ByteString)
makeLegalHoldServiceRequest TeamId
tid Request -> Request
reqParams
where
reqParams :: Request -> Request
reqParams =
[ByteString] -> Request -> Request
Bilge.paths [ByteString
"confirm"]
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegalHoldServiceConfirm -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
Bilge.json (ClientId -> UserId -> TeamId -> Text -> LegalHoldServiceConfirm
LegalHoldServiceConfirm ClientId
clientId UserId
uid TeamId
tid (OpaqueAuthToken -> Text
opaqueAuthTokenToText OpaqueAuthToken
legalHoldAuthToken))
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
Bilge.method StdMethod
POST
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
Bilge.acceptJson
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
Bilge.expect2xx
removeLegalHold ::
( Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r
) =>
TeamId ->
UserId ->
Sem r ()
removeLegalHold :: forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r) =>
TeamId -> UserId -> Sem r ()
removeLegalHold TeamId
tid UserId
uid = do
Sem r (Response ByteString) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Response ByteString) -> Sem r ())
-> Sem r (Response ByteString) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TeamId -> (Request -> Request) -> Sem r (Response ByteString)
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r) =>
TeamId -> (Request -> Request) -> Sem r (Response ByteString)
makeLegalHoldServiceRequest TeamId
tid Request -> Request
reqParams
where
reqParams :: Request -> Request
reqParams =
[ByteString] -> Request -> Request
Bilge.paths [ByteString
"remove"]
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegalHoldServiceRemove -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
Bilge.json (UserId -> TeamId -> LegalHoldServiceRemove
LegalHoldServiceRemove UserId
uid TeamId
tid)
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
Bilge.method StdMethod
POST
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
Bilge.acceptJson
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
Bilge.expect2xx
makeLegalHoldServiceRequest ::
( Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r
) =>
TeamId ->
(Http.Request -> Http.Request) ->
Sem r (Http.Response LC8.ByteString)
makeLegalHoldServiceRequest :: forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r) =>
TeamId -> (Request -> Request) -> Sem r (Response ByteString)
makeLegalHoldServiceRequest TeamId
tid Request -> Request
reqBuilder = do
Maybe LegalHoldService
maybeLHSettings <- TeamId -> Sem r (Maybe LegalHoldService)
forall (r :: EffectRow).
Member LegalHoldStore r =>
TeamId -> Sem r (Maybe LegalHoldService)
LegalHoldData.getSettings TeamId
tid
LegalHoldService
lhSettings <- case Maybe LegalHoldService
maybeLHSettings of
Maybe LegalHoldService
Nothing -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'LegalHoldServiceNotRegistered
Just LegalHoldService
lhSettings -> LegalHoldService -> Sem r LegalHoldService
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LegalHoldService
lhSettings
let LegalHoldService
{ $sel:legalHoldServiceUrl:LegalHoldService :: LegalHoldService -> HttpsUrl
legalHoldServiceUrl = HttpsUrl
baseUrl,
$sel:legalHoldServiceFingerprint:LegalHoldService :: LegalHoldService -> Fingerprint Rsa
legalHoldServiceFingerprint = Fingerprint Rsa
fpr,
$sel:legalHoldServiceToken:LegalHoldService :: LegalHoldService -> ServiceToken
legalHoldServiceToken = ServiceToken
serviceToken
} = LegalHoldService
lhSettings
Fingerprint Rsa
-> HttpsUrl -> (Request -> Request) -> Sem r (Response ByteString)
forall (r :: EffectRow).
Member LegalHoldStore r =>
Fingerprint Rsa
-> HttpsUrl -> (Request -> Request) -> Sem r (Response ByteString)
makeVerifiedRequest Fingerprint Rsa
fpr HttpsUrl
baseUrl ((Request -> Request) -> Sem r (Response ByteString))
-> (Request -> Request) -> Sem r (Response ByteString)
forall a b. (a -> b) -> a -> b
$ ServiceToken -> Request -> Request
mkReqBuilder ServiceToken
serviceToken
where
mkReqBuilder :: ServiceToken -> Request -> Request
mkReqBuilder ServiceToken
token =
Request -> Request
reqBuilder
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> ByteString -> Request -> Request
Bilge.header HeaderName
"Authorization" (ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ServiceToken -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' ServiceToken
token)