{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Pantry.HTTP
  ( module Export
  , withResponse
  , httpSink
  , httpSinkChecked
  ) where

import           Conduit
import           Network.HTTP.Client          as Export (parseRequest)
import           Network.HTTP.Client          as Export (parseUrlThrow)
import           Network.HTTP.Client          as Export (BodyReader, HttpExceptionContent (StatusCodeException))
import qualified Network.HTTP.Client          as HTTP (withResponse)
import           Network.HTTP.Client.Internal as Export (setUri)
import           Network.HTTP.Client.TLS      (getGlobalManager)
import           Network.HTTP.Simple          as Export (HttpException (..),
                                                         Request, Response,
                                                         addRequestHeader,
                                                         defaultRequest,
                                                         getResponseBody,
                                                         getResponseHeaders,
                                                         getResponseStatus,
                                                         setRequestHeader)
import qualified Network.HTTP.Simple          as HTTP hiding (withResponse)
import           Network.HTTP.Types           as Export (Header, HeaderName,
                                                         Status, hCacheControl,
                                                         hRange, ok200,
                                                         partialContent206,
                                                         statusCode)
import qualified Pantry.SHA256                as SHA256
import           Pantry.Types
import           RIO
import qualified RIO.ByteString               as B
import qualified RIO.Text                     as T

setUserAgent :: Request -> Request
setUserAgent :: Request -> Request
setUserAgent = HeaderName -> [ByteString] -> Request -> Request
setRequestHeader HeaderName
"User-Agent" [ByteString
"Haskell pantry package"]

withResponse
  :: MonadUnliftIO m
  => HTTP.Request
  -> (Response BodyReader -> m a)
  -> m a
withResponse :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Request -> (Response BodyReader -> m a) -> m a
withResponse Request
req Response BodyReader -> m a
inner = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
  Manager
manager <- IO Manager
getGlobalManager
  forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
HTTP.withResponse (Request -> Request
setUserAgent Request
req) Manager
manager (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> m a
inner)

httpSink
  :: MonadUnliftIO m
  => Request
  -> (Response () -> ConduitT ByteString Void m a)
  -> m a
httpSink :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Request -> (Response () -> ConduitT ByteString Void m a) -> m a
httpSink Request
req Response () -> ConduitT ByteString Void m a
inner = forall (m :: * -> *) a.
MonadUnliftIO m =>
Request -> (Response () -> ConduitT ByteString Void m a) -> m a
HTTP.httpSink (Request -> Request
setUserAgent Request
req) Response () -> ConduitT ByteString Void m a
inner

httpSinkChecked
  :: MonadUnliftIO m
  => Text
  -> Maybe SHA256
  -> Maybe FileSize
  -> ConduitT ByteString Void m a
  -> m (SHA256, FileSize, a)
httpSinkChecked :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Text
-> Maybe SHA256
-> Maybe FileSize
-> ConduitT ByteString Void m a
-> m (SHA256, FileSize, a)
httpSinkChecked Text
url Maybe SHA256
msha Maybe FileSize
msize ConduitT ByteString Void m a
sink = do
    Request
req <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
url
    forall (m :: * -> *) a.
MonadUnliftIO m =>
Request -> (Response () -> ConduitT ByteString Void m a) -> m a
httpSink Request
req forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall i (m :: * -> *) r. ZipSink i m r -> ConduitT i Void m r
getZipSink forall a b. (a -> b) -> a -> b
$ (,,)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
ZipSink (forall {m :: * -> *} {t :: * -> *} {o}.
(Foldable t, MonadIO m) =>
t SHA256 -> ConduitT ByteString o m SHA256
checkSha Maybe SHA256
msha)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
ZipSink (forall {m :: * -> *} {o}.
MonadIO m =>
Maybe FileSize -> ConduitT ByteString o m FileSize
checkSize Maybe FileSize
msize)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
ZipSink ConduitT ByteString Void m a
sink
  where
    checkSha :: t SHA256 -> ConduitT ByteString o m SHA256
checkSha t SHA256
mexpected = do
      SHA256
actual <- forall (m :: * -> *) o. Monad m => ConduitT ByteString o m SHA256
SHA256.sinkHash
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ t SHA256
mexpected forall a b. (a -> b) -> a -> b
$ \SHA256
expected -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SHA256
actual forall a. Eq a => a -> a -> Bool
== SHA256
expected) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> Mismatch SHA256 -> PantryException
DownloadInvalidSHA256 Text
url Mismatch
          { mismatchExpected :: SHA256
mismatchExpected = SHA256
expected
          , mismatchActual :: SHA256
mismatchActual = SHA256
actual
          }
      forall (f :: * -> *) a. Applicative f => a -> f a
pure SHA256
actual
    checkSize :: Maybe FileSize -> ConduitT ByteString o m FileSize
checkSize Maybe FileSize
mexpected =
      forall {m :: * -> *} {o}.
MonadIO m =>
Word -> ConduitT ByteString o m FileSize
loop Word
0
      where
        loop :: Word -> ConduitT ByteString o m FileSize
loop Word
accum = do
          Maybe ByteString
mbs <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
          case Maybe ByteString
mbs of
            Maybe ByteString
Nothing ->
              case Maybe FileSize
mexpected of
                Just (FileSize Word
expected) | Word
expected forall a. Eq a => a -> a -> Bool
/= Word
accum ->
                  forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> Mismatch FileSize -> PantryException
DownloadInvalidSize Text
url Mismatch
                    { mismatchExpected :: FileSize
mismatchExpected = Word -> FileSize
FileSize Word
expected
                    , mismatchActual :: FileSize
mismatchActual = Word -> FileSize
FileSize Word
accum
                    }
                Maybe FileSize
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> FileSize
FileSize Word
accum)
            Just ByteString
bs -> do
              let accum' :: Word
accum' = Word
accum forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)
              case Maybe FileSize
mexpected of
                Just (FileSize Word
expected)
                  | Word
accum' forall a. Ord a => a -> a -> Bool
> Word
expected ->
                    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> Mismatch FileSize -> PantryException
DownloadTooLarge Text
url Mismatch
                      { mismatchExpected :: FileSize
mismatchExpected = Word -> FileSize
FileSize Word
expected
                      , mismatchActual :: FileSize
mismatchActual = Word -> FileSize
FileSize Word
accum'
                      }
                Maybe FileSize
_ -> Word -> ConduitT ByteString o m FileSize
loop Word
accum'