module Wire.API.Routes.Public.Cargohold where
import Data.Id
import Data.Kind
import Data.Metrics.Servant
import Data.Qualified
import Data.SOP
import Imports
import Servant
import Servant.OpenApi.Internal.Orphans ()
import URI.ByteString
import Wire.API.Asset
import Wire.API.Error
import Wire.API.Error.Cargohold
import Wire.API.Routes.API
import Wire.API.Routes.AssetBody
import Wire.API.Routes.MultiVerb
import Wire.API.Routes.Public
import Wire.API.Routes.QualifiedCapture
import Wire.API.Routes.Version
data PrincipalTag = UserPrincipalTag | BotPrincipalTag | ProviderPrincipalTag
deriving (PrincipalTag -> PrincipalTag -> Bool
(PrincipalTag -> PrincipalTag -> Bool)
-> (PrincipalTag -> PrincipalTag -> Bool) -> Eq PrincipalTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrincipalTag -> PrincipalTag -> Bool
== :: PrincipalTag -> PrincipalTag -> Bool
$c/= :: PrincipalTag -> PrincipalTag -> Bool
/= :: PrincipalTag -> PrincipalTag -> Bool
Eq, Int -> PrincipalTag -> ShowS
[PrincipalTag] -> ShowS
PrincipalTag -> String
(Int -> PrincipalTag -> ShowS)
-> (PrincipalTag -> String)
-> ([PrincipalTag] -> ShowS)
-> Show PrincipalTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrincipalTag -> ShowS
showsPrec :: Int -> PrincipalTag -> ShowS
$cshow :: PrincipalTag -> String
show :: PrincipalTag -> String
$cshowList :: [PrincipalTag] -> ShowS
showList :: [PrincipalTag] -> ShowS
Show)
type family PrincipalId (tag :: PrincipalTag) = (id :: Type) | id -> tag where
PrincipalId 'UserPrincipalTag = Local UserId
PrincipalId 'BotPrincipalTag = BotId
PrincipalId 'ProviderPrincipalTag = ProviderId
type family ApplyPrincipalPath (tag :: PrincipalTag) api
type instance
ApplyPrincipalPath 'UserPrincipalTag api =
ZLocalUser :> Until 'V2 :> "assets" :> "v3" :> api
type instance ApplyPrincipalPath 'BotPrincipalTag api = ZBot :> "bot" :> "assets" :> api
type instance ApplyPrincipalPath 'ProviderPrincipalTag api = ZProvider :> "provider" :> "assets" :> api
type instance
SpecialiseToVersion v ((tag :: PrincipalTag) :> api) =
SpecialiseToVersion v (ApplyPrincipalPath tag api)
instance (HasServer (ApplyPrincipalPath tag api) ctx) => HasServer (tag :> api) ctx where
type ServerT (tag :> api) m = ServerT (ApplyPrincipalPath tag api) m
route :: forall env.
Proxy (tag :> api)
-> Context ctx -> Delayed env (Server (tag :> api)) -> Router env
route Proxy (tag :> api)
_ = Proxy (ApplyPrincipalPath tag api)
-> Context ctx
-> Delayed env (Server (ApplyPrincipalPath tag api))
-> Router' env RoutingApplication
forall env.
Proxy (ApplyPrincipalPath tag api)
-> Context ctx
-> Delayed env (Server (ApplyPrincipalPath tag api))
-> Router env
forall {k} (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ApplyPrincipalPath tag api))
hoistServerWithContext :: forall (m :: * -> *) (n :: * -> *).
Proxy (tag :> api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (tag :> api) m
-> ServerT (tag :> api) n
hoistServerWithContext Proxy (tag :> api)
_ = Proxy (ApplyPrincipalPath tag api)
-> Proxy ctx
-> (forall {x}. m x -> n x)
-> ServerT (ApplyPrincipalPath tag api) m
-> ServerT (ApplyPrincipalPath tag api) n
forall {k} (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
forall (m :: * -> *) (n :: * -> *).
Proxy (ApplyPrincipalPath tag api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (ApplyPrincipalPath tag api) m
-> ServerT (ApplyPrincipalPath tag api) n
hoistServerWithContext (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ApplyPrincipalPath tag api))
instance (RoutesToPaths (ApplyPrincipalPath tag api)) => RoutesToPaths (tag :> api) where
getRoutes :: Forest PathSegment
getRoutes = forall routes. RoutesToPaths routes => Forest PathSegment
forall {k} (routes :: k).
RoutesToPaths routes =>
Forest PathSegment
getRoutes @(ApplyPrincipalPath tag api)
type r =
'[DescHeader "Location" "Asset location" (AssetLocation r)]
type AssetRedirect =
WithHeaders
(AssetLocationHeader Absolute)
(AssetLocation Absolute)
(RespondEmpty 302 "Asset found")
type AssetStreaming =
RespondStreaming
200
"Asset returned directly with content type `application/octet-stream`"
OctetStream
type GetAsset =
MultiVerb
'GET
'[JSON]
'[ErrorResponse 'AssetNotFound, AssetRedirect]
(Maybe (AssetLocation Absolute))
type CargoholdAPI =
( Summary "Renew an asset token"
:> Until 'V2
:> CanThrow 'AssetNotFound
:> CanThrow 'Unauthorised
:> ZLocalUser
:> "assets"
:> "v3"
:> Capture "key" AssetKey
:> "token"
:> Post '[JSON] NewAssetToken
)
:<|> ( Summary "Delete an asset token"
:> Until 'V2
:> Description "**Note**: deleting the token makes the asset public."
:> ZLocalUser
:> "assets"
:> "v3"
:> Capture "key" AssetKey
:> "token"
:> MultiVerb
'DELETE
'[JSON]
'[RespondEmpty 200 "Asset token deleted"]
()
)
:<|> BaseAPIv3 'UserPrincipalTag
:<|> BaseAPIv3 'BotPrincipalTag
:<|> BaseAPIv3 'ProviderPrincipalTag
:<|> QualifiedAPI
:<|> LegacyAPI
:<|> MainAPI
type BaseAPIv3 (tag :: PrincipalTag) =
( Summary "Upload an asset"
:> CanThrow 'AssetTooLarge
:> CanThrow 'InvalidLength
:> tag
:> AssetBody
:> MultiVerb
'POST
'[JSON]
'[ WithHeaders
(AssetLocationHeader Relative)
(Asset, AssetLocation Relative)
(Respond 201 "Asset posted" Asset)
]
(Asset, AssetLocation Relative)
)
:<|> ( Summary "Download an asset"
:> tag
:> Capture "key" AssetKey
:> Header "Asset-Token" AssetToken
:> QueryParam "asset_token" AssetToken
:> ZHostOpt
:> GetAsset
)
:<|> ( Summary "Delete an asset"
:> CanThrow 'AssetNotFound
:> CanThrow 'Unauthorised
:> tag
:> Capture "key" AssetKey
:> MultiVerb
'DELETE
'[JSON]
'[RespondEmpty 200 "Asset deleted"]
()
)
type QualifiedAPI =
( Summary "Download an asset"
:> Until 'V2
:> Description
"**Note**: local assets result in a redirect, \
\while remote assets are streamed directly."
:> ZLocalUser
:> "assets"
:> "v4"
:> QualifiedCapture "key" AssetKey
:> Header "Asset-Token" AssetToken
:> QueryParam "asset_token" AssetToken
:> ZHostOpt
:> MultiVerb
'GET
'()
'[ ErrorResponse 'AssetNotFound,
AssetRedirect,
AssetStreaming
]
(Maybe LocalOrRemoteAsset)
)
:<|> ( Summary "Delete an asset"
:> Until 'V2
:> Description "**Note**: only local assets can be deleted."
:> CanThrow 'AssetNotFound
:> CanThrow 'Unauthorised
:> ZLocalUser
:> "assets"
:> "v4"
:> QualifiedCapture "key" AssetKey
:> MultiVerb
'DELETE
'[JSON]
'[RespondEmpty 200 "Asset deleted"]
()
)
type LegacyAPI =
( ZLocalUser
:> Until 'V2
:> "assets"
:> QueryParam' [Required, Strict] "conv_id" ConvId
:> Capture "id" AssetId
:> GetAsset
)
:<|> ( ZLocalUser
:> Until 'V2
:> "conversations"
:> Capture "cnv" ConvId
:> "assets"
:> Capture "id" AssetId
:> GetAsset
)
:<|> ( ZLocalUser
:> Until 'V2
:> "conversations"
:> Capture "cnv" ConvId
:> "otr"
:> "assets"
:> Capture "id" AssetId
:> GetAsset
)
type MainAPI =
( Summary "Renew an asset token"
:> From 'V2
:> CanThrow 'AssetNotFound
:> CanThrow 'Unauthorised
:> ZLocalUser
:> "assets"
:> Capture "key" AssetKey
:> "token"
:> Post '[JSON] NewAssetToken
)
:<|> ( Summary "Delete an asset token"
:> From 'V2
:> Description "**Note**: deleting the token makes the asset public."
:> ZLocalUser
:> "assets"
:> Capture "key" AssetKey
:> "token"
:> MultiVerb
'DELETE
'[JSON]
'[RespondEmpty 200 "Asset token deleted"]
()
)
:<|> ( Summary "Upload an asset"
:> From 'V2
:> CanThrow 'AssetTooLarge
:> CanThrow 'InvalidLength
:> ZLocalUser
:> "assets"
:> AssetBody
:> MultiVerb
'POST
'[JSON]
'[ WithHeaders
(AssetLocationHeader Relative)
(Asset, AssetLocation Relative)
(Respond 201 "Asset posted" Asset)
]
(Asset, AssetLocation Relative)
)
:<|> ( Summary "Download an asset"
:> From 'V2
:> Description
"**Note**: local assets result in a redirect, \
\while remote assets are streamed directly."
:> CanThrow 'NoMatchingAssetEndpoint
:> ZLocalUser
:> "assets"
:> QualifiedCapture "key" AssetKey
:> Header "Asset-Token" AssetToken
:> QueryParam "asset_token" AssetToken
:> ZHostOpt
:> MultiVerb
'GET
'()
'[ ErrorResponse 'AssetNotFound,
AssetRedirect,
AssetStreaming
]
(Maybe LocalOrRemoteAsset)
)
:<|> ( Summary "Delete an asset"
:> From 'V2
:> Description "**Note**: only local assets can be deleted."
:> CanThrow 'AssetNotFound
:> CanThrow 'Unauthorised
:> ZLocalUser
:> "assets"
:> QualifiedCapture "key" AssetKey
:> MultiVerb
'DELETE
'[JSON]
'[RespondEmpty 200 "Asset deleted"]
()
)
data CargoholdAPITag
instance ServiceAPI CargoholdAPITag v where
type ServiceAPIRoutes CargoholdAPITag = CargoholdAPI