module Galley.External.LegalHoldService
(
checkLegalHoldServiceStatus,
requestNewDevice,
confirmLegalHold,
removeLegalHold,
validateServiceKey,
)
where
import Bilge qualified
import Bilge.Response
import Brig.Types.Team.LegalHold
import Control.Monad.Catch (MonadThrow (throwM))
import Data.Aeson
import Data.ByteString.Char8 qualified as BS8
import Data.ByteString.Conversion.To
import Data.ByteString.Lazy.Char8 qualified as LC8
import Data.Id
import Data.Misc
import Data.Qualified (Local, QualifiedWithTag (tUntagged), tUnqualified)
import Data.Set qualified as Set
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
data LhApiVersion = V0 | V1
deriving stock (LhApiVersion -> LhApiVersion -> Bool
(LhApiVersion -> LhApiVersion -> Bool)
-> (LhApiVersion -> LhApiVersion -> Bool) -> Eq LhApiVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LhApiVersion -> LhApiVersion -> Bool
== :: LhApiVersion -> LhApiVersion -> Bool
$c/= :: LhApiVersion -> LhApiVersion -> Bool
/= :: LhApiVersion -> LhApiVersion -> Bool
Eq, Eq LhApiVersion
Eq LhApiVersion =>
(LhApiVersion -> LhApiVersion -> Ordering)
-> (LhApiVersion -> LhApiVersion -> Bool)
-> (LhApiVersion -> LhApiVersion -> Bool)
-> (LhApiVersion -> LhApiVersion -> Bool)
-> (LhApiVersion -> LhApiVersion -> Bool)
-> (LhApiVersion -> LhApiVersion -> LhApiVersion)
-> (LhApiVersion -> LhApiVersion -> LhApiVersion)
-> Ord LhApiVersion
LhApiVersion -> LhApiVersion -> Bool
LhApiVersion -> LhApiVersion -> Ordering
LhApiVersion -> LhApiVersion -> LhApiVersion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LhApiVersion -> LhApiVersion -> Ordering
compare :: LhApiVersion -> LhApiVersion -> Ordering
$c< :: LhApiVersion -> LhApiVersion -> Bool
< :: LhApiVersion -> LhApiVersion -> Bool
$c<= :: LhApiVersion -> LhApiVersion -> Bool
<= :: LhApiVersion -> LhApiVersion -> Bool
$c> :: LhApiVersion -> LhApiVersion -> Bool
> :: LhApiVersion -> LhApiVersion -> Bool
$c>= :: LhApiVersion -> LhApiVersion -> Bool
>= :: LhApiVersion -> LhApiVersion -> Bool
$cmax :: LhApiVersion -> LhApiVersion -> LhApiVersion
max :: LhApiVersion -> LhApiVersion -> LhApiVersion
$cmin :: LhApiVersion -> LhApiVersion -> LhApiVersion
min :: LhApiVersion -> LhApiVersion -> LhApiVersion
Ord, Int -> LhApiVersion -> ShowS
[LhApiVersion] -> ShowS
LhApiVersion -> String
(Int -> LhApiVersion -> ShowS)
-> (LhApiVersion -> String)
-> ([LhApiVersion] -> ShowS)
-> Show LhApiVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LhApiVersion -> ShowS
showsPrec :: Int -> LhApiVersion -> ShowS
$cshow :: LhApiVersion -> String
show :: LhApiVersion -> String
$cshowList :: [LhApiVersion] -> ShowS
showList :: [LhApiVersion] -> ShowS
Show, Int -> LhApiVersion
LhApiVersion -> Int
LhApiVersion -> [LhApiVersion]
LhApiVersion -> LhApiVersion
LhApiVersion -> LhApiVersion -> [LhApiVersion]
LhApiVersion -> LhApiVersion -> LhApiVersion -> [LhApiVersion]
(LhApiVersion -> LhApiVersion)
-> (LhApiVersion -> LhApiVersion)
-> (Int -> LhApiVersion)
-> (LhApiVersion -> Int)
-> (LhApiVersion -> [LhApiVersion])
-> (LhApiVersion -> LhApiVersion -> [LhApiVersion])
-> (LhApiVersion -> LhApiVersion -> [LhApiVersion])
-> (LhApiVersion -> LhApiVersion -> LhApiVersion -> [LhApiVersion])
-> Enum LhApiVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LhApiVersion -> LhApiVersion
succ :: LhApiVersion -> LhApiVersion
$cpred :: LhApiVersion -> LhApiVersion
pred :: LhApiVersion -> LhApiVersion
$ctoEnum :: Int -> LhApiVersion
toEnum :: Int -> LhApiVersion
$cfromEnum :: LhApiVersion -> Int
fromEnum :: LhApiVersion -> Int
$cenumFrom :: LhApiVersion -> [LhApiVersion]
enumFrom :: LhApiVersion -> [LhApiVersion]
$cenumFromThen :: LhApiVersion -> LhApiVersion -> [LhApiVersion]
enumFromThen :: LhApiVersion -> LhApiVersion -> [LhApiVersion]
$cenumFromTo :: LhApiVersion -> LhApiVersion -> [LhApiVersion]
enumFromTo :: LhApiVersion -> LhApiVersion -> [LhApiVersion]
$cenumFromThenTo :: LhApiVersion -> LhApiVersion -> LhApiVersion -> [LhApiVersion]
enumFromThenTo :: LhApiVersion -> LhApiVersion -> LhApiVersion -> [LhApiVersion]
Enum, LhApiVersion
LhApiVersion -> LhApiVersion -> Bounded LhApiVersion
forall a. a -> a -> Bounded a
$cminBound :: LhApiVersion
minBound :: LhApiVersion
$cmaxBound :: LhApiVersion
maxBound :: LhApiVersion
Bounded, (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)
getLegalHoldApiVersions ::
( Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r
) =>
TeamId ->
Sem r (Maybe (Set LhApiVersion))
getLegalHoldApiVersions :: forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r) =>
TeamId -> Sem r (Maybe (Set LhApiVersion))
getLegalHoldApiVersions TeamId
tid =
(SupportedVersions -> Set LhApiVersion)
-> Maybe SupportedVersions -> Maybe (Set LhApiVersion)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SupportedVersions -> Set LhApiVersion
toLhApiVersion (Maybe SupportedVersions -> Maybe (Set LhApiVersion))
-> (Response ByteString -> Maybe SupportedVersions)
-> Response ByteString
-> Maybe (Set LhApiVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe SupportedVersions
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe SupportedVersions)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> Maybe SupportedVersions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.responseBody) (Response ByteString -> Maybe (Set LhApiVersion))
-> Sem r (Response ByteString) -> Sem r (Maybe (Set LhApiVersion))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
params
where
params :: Request -> Request
params =
[ByteString] -> Request -> Request
Bilge.paths [ByteString
"api-version"]
(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.acceptJson
toLhApiVersion :: SupportedVersions -> Set LhApiVersion
toLhApiVersion :: SupportedVersions -> Set LhApiVersion
toLhApiVersion (SupportedVersions [Int]
supported) = [LhApiVersion] -> Set LhApiVersion
forall a. Ord a => [a] -> Set a
Set.fromList ([LhApiVersion] -> Set LhApiVersion)
-> [LhApiVersion] -> Set LhApiVersion
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe LhApiVersion) -> [Int] -> [LhApiVersion]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Int -> Maybe LhApiVersion
forall {a}. (Eq a, Num a) => a -> Maybe LhApiVersion
toVersion [Int]
supported
where
toVersion :: a -> Maybe LhApiVersion
toVersion a
0 = LhApiVersion -> Maybe LhApiVersion
forall a. a -> Maybe a
Just LhApiVersion
V0
toVersion a
1 = LhApiVersion -> Maybe LhApiVersion
forall a. a -> Maybe a
Just LhApiVersion
V1
toVersion a
_ = Maybe LhApiVersion
forall a. Maybe a
Nothing
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,
Member (Embed IO) r
) =>
TeamId ->
Local UserId ->
Sem r NewLegalHoldClient
requestNewDevice :: forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceBadResponse) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r, Member TinyLog r, Member (Embed IO) r) =>
TeamId -> Local UserId -> Sem r NewLegalHoldClient
requestNewDevice TeamId
tid Local UserId
luid = do
LhApiVersion
apiVersion <- TeamId -> Sem r LhApiVersion
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r, Member TinyLog r, Member (Embed IO) r) =>
TeamId -> Sem r LhApiVersion
negotiateVersion TeamId
tid
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 (LhApiVersion -> Request -> Request
reqParams LhApiVersion
apiVersion)
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 -> ShowS
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 :: LhApiVersion -> Request -> Request
reqParams LhApiVersion
v =
LhApiVersion -> [ByteString] -> Request -> Request
versionedPaths LhApiVersion
v [ByteString
"initiate"]
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LhApiVersion -> Request -> Request
mkBody LhApiVersion
v
(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
mkBody :: LhApiVersion -> Bilge.Request -> Bilge.Request
mkBody :: LhApiVersion -> Request -> Request
mkBody LhApiVersion
V0 =
RequestNewLegalHoldClientV0 -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
Bilge.json
RequestNewLegalHoldClientV0
{ $sel:userId:RequestNewLegalHoldClientV0 :: UserId
userId = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid,
$sel:teamId:RequestNewLegalHoldClientV0 :: TeamId
teamId = TeamId
tid
}
mkBody LhApiVersion
V1 =
RequestNewLegalHoldClient -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
Bilge.json
RequestNewLegalHoldClient
{ $sel:userId:RequestNewLegalHoldClient :: Qualified UserId
userId = Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
luid,
$sel:teamId:RequestNewLegalHoldClient :: TeamId
teamId = TeamId
tid
}
confirmLegalHold ::
( Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member P.TinyLog r,
Member LegalHoldStore r,
Member (Embed IO) r
) =>
ClientId ->
TeamId ->
Local UserId ->
OpaqueAuthToken ->
Sem r ()
confirmLegalHold :: forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member TinyLog r, Member LegalHoldStore r, Member (Embed IO) r) =>
ClientId -> TeamId -> Local UserId -> OpaqueAuthToken -> Sem r ()
confirmLegalHold ClientId
clientId TeamId
tid Local UserId
luid OpaqueAuthToken
legalHoldAuthToken = do
LhApiVersion
apiVersion <- TeamId -> Sem r LhApiVersion
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r, Member TinyLog r, Member (Embed IO) r) =>
TeamId -> Sem r LhApiVersion
negotiateVersion TeamId
tid
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 (LhApiVersion -> Request -> Request
reqParams LhApiVersion
apiVersion)
where
reqParams :: LhApiVersion -> Request -> Request
reqParams LhApiVersion
v =
LhApiVersion -> [ByteString] -> Request -> Request
versionedPaths LhApiVersion
v [ByteString
"confirm"]
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LhApiVersion -> Request -> Request
mkBody LhApiVersion
v
(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
mkBody :: LhApiVersion -> Bilge.Request -> Bilge.Request
mkBody :: LhApiVersion -> Request -> Request
mkBody LhApiVersion
V0 =
LegalHoldServiceConfirmV0 -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
Bilge.json
LegalHoldServiceConfirmV0
{ $sel:lhcClientId:LegalHoldServiceConfirmV0 :: ClientId
lhcClientId = ClientId
clientId,
$sel:lhcUserId:LegalHoldServiceConfirmV0 :: UserId
lhcUserId = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid,
$sel:lhcTeamId:LegalHoldServiceConfirmV0 :: TeamId
lhcTeamId = TeamId
tid,
$sel:lhcRefreshToken:LegalHoldServiceConfirmV0 :: Text
lhcRefreshToken = OpaqueAuthToken -> Text
opaqueAuthTokenToText OpaqueAuthToken
legalHoldAuthToken
}
mkBody LhApiVersion
V1 =
LegalHoldServiceConfirm -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
Bilge.json
LegalHoldServiceConfirm
{ $sel:clientId:LegalHoldServiceConfirm :: ClientId
clientId = ClientId
clientId,
$sel:userId:LegalHoldServiceConfirm :: Qualified UserId
userId = Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
luid,
$sel:teamId:LegalHoldServiceConfirm :: TeamId
teamId = TeamId
tid,
$sel:refreshToken:LegalHoldServiceConfirm :: Text
refreshToken = OpaqueAuthToken -> Text
opaqueAuthTokenToText OpaqueAuthToken
legalHoldAuthToken
}
removeLegalHold ::
( Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member P.TinyLog r,
Member LegalHoldStore r,
Member (Embed IO) r
) =>
TeamId ->
Local UserId ->
Sem r ()
removeLegalHold :: forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member TinyLog r, Member LegalHoldStore r, Member (Embed IO) r) =>
TeamId -> Local UserId -> Sem r ()
removeLegalHold TeamId
tid Local UserId
uid = do
LhApiVersion
apiVersion <- TeamId -> Sem r LhApiVersion
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r, Member TinyLog r, Member (Embed IO) r) =>
TeamId -> Sem r LhApiVersion
negotiateVersion TeamId
tid
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 (LhApiVersion -> Request -> Request
reqParams LhApiVersion
apiVersion)
where
reqParams :: LhApiVersion -> Request -> Request
reqParams LhApiVersion
v =
LhApiVersion -> [ByteString] -> Request -> Request
versionedPaths LhApiVersion
v [ByteString
"remove"]
(Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LhApiVersion -> Request -> Request
mkBody LhApiVersion
v
(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
mkBody :: LhApiVersion -> Bilge.Request -> Bilge.Request
mkBody :: LhApiVersion -> Request -> Request
mkBody LhApiVersion
V0 =
LegalHoldServiceRemoveV0 -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
Bilge.json
LegalHoldServiceRemoveV0
{ $sel:lhrUserId:LegalHoldServiceRemoveV0 :: UserId
lhrUserId = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
uid,
$sel:lhrTeamId:LegalHoldServiceRemoveV0 :: TeamId
lhrTeamId = TeamId
tid
}
mkBody LhApiVersion
V1 =
LegalHoldServiceRemove -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
Bilge.json
LegalHoldServiceRemove
{ $sel:userId:LegalHoldServiceRemove :: Qualified UserId
userId = Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
uid,
$sel:teamId:LegalHoldServiceRemove :: TeamId
teamId = TeamId
tid
}
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)
versionToInt :: LhApiVersion -> Int
versionToInt :: LhApiVersion -> Int
versionToInt LhApiVersion
V0 = Int
0
versionToInt LhApiVersion
V1 = Int
1
versionToBS :: LhApiVersion -> ByteString
versionToBS :: LhApiVersion -> ByteString
versionToBS = (ByteString
"v" <>) (ByteString -> ByteString)
-> (LhApiVersion -> ByteString) -> LhApiVersion -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (LhApiVersion -> String) -> LhApiVersion -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (LhApiVersion -> Int) -> LhApiVersion -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LhApiVersion -> Int
versionToInt
versionedPaths :: LhApiVersion -> [ByteString] -> Http.Request -> Http.Request
versionedPaths :: LhApiVersion -> [ByteString] -> Request -> Request
versionedPaths LhApiVersion
V0 [ByteString]
paths = [ByteString] -> Request -> Request
Bilge.paths [ByteString]
paths
versionedPaths LhApiVersion
v [ByteString]
paths = [ByteString] -> Request -> Request
Bilge.paths (LhApiVersion -> ByteString
versionToBS LhApiVersion
v ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
paths)
supportedByWireServer :: Set LhApiVersion
supportedByWireServer :: Set LhApiVersion
supportedByWireServer = [LhApiVersion] -> Set LhApiVersion
forall a. Ord a => [a] -> Set a
Set.fromList [LhApiVersion
forall a. Bounded a => a
minBound .. LhApiVersion
forall a. Bounded a => a
maxBound]
negotiateVersion ::
( Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r,
Member P.TinyLog r,
Member (Embed IO) r
) =>
TeamId ->
Sem r LhApiVersion
negotiateVersion :: forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r, Member TinyLog r, Member (Embed IO) r) =>
TeamId -> Sem r LhApiVersion
negotiateVersion TeamId
tid = do
Maybe (Set LhApiVersion)
mSupportedByExternalLhService <- TeamId -> Sem r (Maybe (Set LhApiVersion))
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r) =>
TeamId -> Sem r (Maybe (Set LhApiVersion))
getLegalHoldApiVersions TeamId
tid
case Maybe (Set LhApiVersion)
mSupportedByExternalLhService of
Maybe (Set LhApiVersion)
Nothing -> LhApiVersion -> Sem r LhApiVersion
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LhApiVersion
V0
Just Set LhApiVersion
supportedByLhService -> do
let commonVersions :: Set LhApiVersion
commonVersions = Set LhApiVersion -> Set LhApiVersion -> Set LhApiVersion
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set LhApiVersion
supportedByWireServer Set LhApiVersion
supportedByLhService
case Set LhApiVersion -> Maybe LhApiVersion
forall a. Set a -> Maybe a
Set.lookupMax Set LhApiVersion
commonVersions of
Maybe LhApiVersion
Nothing -> do
(Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.warn ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
Builder -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Log.msg (ByteString -> Builder
Log.val ByteString
"Version negotiation with legal hold service failed. No common versions found.")
(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
Log.field ByteString
"team_id" (TeamId -> String
forall a. Show a => a -> String
show TeamId
tid)
IO LhApiVersion -> Sem r LhApiVersion
forall a. IO a -> Sem r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LhApiVersion -> Sem r LhApiVersion)
-> IO LhApiVersion -> Sem r LhApiVersion
forall a b. (a -> b) -> a -> b
$ LegalHoldVersionNegotiationException -> IO LhApiVersion
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM LegalHoldVersionNegotiationException
LegalHoldNoCommonVersions
Just LhApiVersion
v -> LhApiVersion -> Sem r LhApiVersion
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LhApiVersion
v
data LegalHoldVersionNegotiationException = LegalHoldNoCommonVersions
deriving (Int -> LegalHoldVersionNegotiationException -> ShowS
[LegalHoldVersionNegotiationException] -> ShowS
LegalHoldVersionNegotiationException -> String
(Int -> LegalHoldVersionNegotiationException -> ShowS)
-> (LegalHoldVersionNegotiationException -> String)
-> ([LegalHoldVersionNegotiationException] -> ShowS)
-> Show LegalHoldVersionNegotiationException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LegalHoldVersionNegotiationException -> ShowS
showsPrec :: Int -> LegalHoldVersionNegotiationException -> ShowS
$cshow :: LegalHoldVersionNegotiationException -> String
show :: LegalHoldVersionNegotiationException -> String
$cshowList :: [LegalHoldVersionNegotiationException] -> ShowS
showList :: [LegalHoldVersionNegotiationException] -> ShowS
Show)
instance Exception LegalHoldVersionNegotiationException