-- | Things that can be fetched from the discord CDN
module Calamity.Types.CDNAsset
  ( CDNAsset (..),
    fetchAsset,
    fetchAsset',
  )
where

import qualified Control.Exception.Safe as Ex
import Data.ByteString.Lazy (ByteString)
import qualified Network.HTTP.Req as Req
import qualified Polysemy as P

-- | Retrieve the asset from the CDN, like 'fetchAsset' but gives you more control
fetchAsset' :: (CDNAsset a, Req.MonadHttp m) => a -> m ByteString
fetchAsset' :: forall a (m :: * -> *).
(CDNAsset a, MonadHttp m) =>
a -> m ByteString
fetchAsset' a
a = LbsResponse -> ByteString
forall response.
HttpResponse response =>
response -> HttpResponseBody response
Req.responseBody (LbsResponse -> ByteString) -> m LbsResponse -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET
-> Url 'Https
-> NoReqBody
-> Proxy LbsResponse
-> Option 'Https
-> m LbsResponse
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
Req.req GET
Req.GET (a -> Url 'Https
forall a. CDNAsset a => a -> Url 'Https
assetURL a
a) NoReqBody
Req.NoReqBody Proxy LbsResponse
Req.lbsResponse Option 'Https
forall a. Monoid a => a
mempty

-- | Retrieve the asset from the CDN
fetchAsset :: (CDNAsset a, P.Member (P.Embed IO) r) => a -> P.Sem r (Either Req.HttpException ByteString)
fetchAsset :: forall a (r :: EffectRow).
(CDNAsset a, Member (Embed IO) r) =>
a -> Sem r (Either HttpException ByteString)
fetchAsset a
a = IO (Either HttpException ByteString)
-> Sem r (Either HttpException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO (Either HttpException ByteString)
 -> Sem r (Either HttpException ByteString))
-> IO (Either HttpException ByteString)
-> Sem r (Either HttpException ByteString)
forall a b. (a -> b) -> a -> b
$ IO (Either HttpException ByteString)
-> (HttpException -> IO (Either HttpException ByteString))
-> IO (Either HttpException ByteString)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
Ex.catch (ByteString -> Either HttpException ByteString
forall a b. b -> Either a b
Right (ByteString -> Either HttpException ByteString)
-> IO ByteString -> IO (Either HttpException ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
r) (\(HttpException
e :: Req.HttpException) -> Either HttpException ByteString
-> IO (Either HttpException ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HttpException ByteString
 -> IO (Either HttpException ByteString))
-> Either HttpException ByteString
-> IO (Either HttpException ByteString)
forall a b. (a -> b) -> a -> b
$ HttpException -> Either HttpException ByteString
forall a b. a -> Either a b
Left HttpException
e)
  where
    r :: IO ByteString
r = HttpConfig -> Req ByteString -> IO ByteString
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
Req.runReq HttpConfig
reqConfig (Req ByteString -> IO ByteString)
-> Req ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ a -> Req ByteString
forall a (m :: * -> *).
(CDNAsset a, MonadHttp m) =>
a -> m ByteString
fetchAsset' a
a

reqConfig :: Req.HttpConfig
reqConfig :: HttpConfig
reqConfig =
  HttpConfig
Req.defaultHttpConfig
    { httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
Req.httpConfigCheckResponse = \Request
_ Response b
_ ByteString
_ -> Maybe HttpExceptionContent
forall a. Maybe a
Nothing
    }

class CDNAsset a where
  assetURL :: a -> Req.Url 'Req.Https