module Wire.API.Routes.Bearer where
import Control.Lens ((<>~))
import Data.ByteString qualified as BS
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Metrics.Servant
import Data.OpenApi hiding (HasServer, Header)
import Data.Text.Encoding qualified as T
import Imports
import Servant
import Servant.OpenApi
import Wire.API.Routes.Version
newtype Bearer a = Bearer {forall a. Bearer a -> a
unBearer :: a}
instance (FromHttpApiData a) => FromHttpApiData (Bearer a) where
parseHeader :: ByteString -> Either Text (Bearer a)
parseHeader ByteString
h = case Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
7 ByteString
h of
(ByteString
"Bearer ", ByteString
suffix) -> a -> Bearer a
forall a. a -> Bearer a
Bearer (a -> Bearer a) -> Either Text a -> Either Text (Bearer a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either Text a
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader ByteString
suffix
(ByteString, ByteString)
_ -> Text -> Either Text (Bearer a)
forall a b. a -> Either a b
Left Text
"Invalid authorization scheme"
parseUrlPiece :: Text -> Either Text (Bearer a)
parseUrlPiece = ByteString -> Either Text (Bearer a)
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text (Bearer a))
-> (Text -> ByteString) -> Text -> Either Text (Bearer a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
type a = Header' '[Lenient] "Authorization" (Bearer a)
type BearerQueryParam =
QueryParam'
[Lenient, Description "Access token"]
"access_token"
type instance
SpecialiseToVersion v (Bearer a :> api) =
Bearer a :> SpecialiseToVersion v api
instance (HasOpenApi api) => HasOpenApi (Bearer a :> api) where
toOpenApi :: Proxy (Bearer a :> api) -> OpenApi
toOpenApi Proxy (Bearer a :> api)
_ =
Proxy api -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)
OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& ([SecurityRequirement] -> Identity [SecurityRequirement])
-> OpenApi -> Identity OpenApi
forall s a. HasSecurity s a => Lens' s a
Lens' OpenApi [SecurityRequirement]
security (([SecurityRequirement] -> Identity [SecurityRequirement])
-> OpenApi -> Identity OpenApi)
-> [SecurityRequirement] -> OpenApi -> OpenApi
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [InsOrdHashMap Text [Text] -> SecurityRequirement
SecurityRequirement (InsOrdHashMap Text [Text] -> SecurityRequirement)
-> InsOrdHashMap Text [Text] -> SecurityRequirement
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> InsOrdHashMap Text [Text]
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrdHashMap.singleton Text
"ZAuth" []]
instance (RoutesToPaths api) => RoutesToPaths (Bearer a :> api) where
getRoutes :: Forest PathSegment
getRoutes = forall routes. RoutesToPaths routes => Forest PathSegment
forall {k} (routes :: k).
RoutesToPaths routes =>
Forest PathSegment
getRoutes @api
instance
( HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters,
FromHttpApiData a,
HasServer api ctx
) =>
HasServer (Bearer a :> api) ctx
where
type ServerT (Bearer a :> api) m = Maybe (Either Text a) -> ServerT api m
route :: forall env.
Proxy (Bearer a :> api)
-> Context ctx
-> Delayed env (Server (Bearer a :> api))
-> Router env
route Proxy (Bearer a :> api)
_ Context ctx
ctx Delayed env (Server (Bearer a :> api))
action =
Proxy (BearerHeader a :> (BearerQueryParam a :> api))
-> Context ctx
-> Delayed
env (Server (BearerHeader a :> (BearerQueryParam a :> api)))
-> Router env
forall env.
Proxy (BearerHeader a :> (BearerQueryParam a :> api))
-> Context ctx
-> Delayed
env (Server (BearerHeader a :> (BearerQueryParam a :> 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 @(BearerHeader a :> BearerQueryParam a :> api))
Context ctx
ctx
(((Maybe (Either Text a) -> ServerT api Handler)
-> Maybe (Either Text (Bearer a))
-> Maybe (Either Text a)
-> ServerT api Handler)
-> Delayed env (Maybe (Either Text a) -> ServerT api Handler)
-> Delayed
env
(Maybe (Either Text (Bearer a))
-> Maybe (Either Text a) -> ServerT api Handler)
forall a b. (a -> b) -> Delayed env a -> Delayed env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (Either Text a) -> ServerT api Handler
f Maybe (Either Text (Bearer a))
u Maybe (Either Text a)
v -> Maybe (Either Text a) -> ServerT api Handler
f ((Either Text (Bearer a) -> Either Text a)
-> Maybe (Either Text (Bearer a)) -> Maybe (Either Text a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bearer a -> a) -> Either Text (Bearer a) -> Either Text a
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bearer a -> a
forall a. Bearer a -> a
unBearer) Maybe (Either Text (Bearer a))
u Maybe (Either Text a)
-> Maybe (Either Text a) -> Maybe (Either Text a)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Either Text a)
v)) Delayed env (Server (Bearer a :> api))
Delayed env (Maybe (Either Text a) -> ServerT api Handler)
action)
hoistServerWithContext :: forall (m :: * -> *) (n :: * -> *).
Proxy (Bearer a :> api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (Bearer a :> api) m
-> ServerT (Bearer a :> api) n
hoistServerWithContext Proxy (Bearer a :> api)
_ Proxy ctx
ctx forall x. m x -> n x
f ServerT (Bearer a :> api) m
h = Proxy api
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT 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 api
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api) Proxy ctx
ctx m x -> n x
forall x. m x -> n x
f (ServerT api m -> ServerT api n)
-> (Maybe (Either Text a) -> ServerT api m)
-> Maybe (Either Text a)
-> ServerT api n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerT (Bearer a :> api) m
Maybe (Either Text a) -> ServerT api m
h