    {-# 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,
                                                             setRequestHeaders)
    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 "User-Agent" ["Haskell pantry package"]

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