-- 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.LegalHoldService
  ( -- * api
    checkLegalHoldServiceStatus,
    requestNewDevice,
    confirmLegalHold,
    removeLegalHold,

    -- * helpers
    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

----------------------------------------------------------------------
-- api
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)

-- | Get /api-version from legal hold service; this does not throw an error because the api-version endpoint may not exist.
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

-- | Get /status from legal hold service; throw 'Wai.Error' if things go wrong.
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

-- | @POST /initiate@.
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
          }

-- | @POST /confirm@
-- Confirm that a device has been linked to a user and provide an authorization token
confirmLegalHold ::
  ( Member (ErrorS 'LegalHoldServiceNotRegistered) r,
    Member P.TinyLog r,
    Member LegalHoldStore r,
    Member (Embed IO) r
  ) =>
  ClientId ->
  TeamId ->
  Local UserId ->
  -- | TODO: Replace with 'LegalHold' token type
  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
          }

-- | @POST /remove@
-- Inform the LegalHold Service that a user's legalhold has been disabled.
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
          }

----------------------------------------------------------------------
-- helpers

-- | Lookup legal hold service settings for a team and make a request to the service.  Pins
-- the TSL fingerprint via 'makeVerifiedRequest' and passes the token so the service can
-- authenticate the request.
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]

-- | Find the highest common version between wire-server and the legalhold service.
-- If the legalhold service does not support the `/api-version` endpoint, we assume it's `v0`.
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