    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE OverloadedStrings #-}

    module Pantry.HTTP
      ( module Export
      , withResponse
      , httpSink
      , httpSinkChecked
      ) where

    import           Conduit
    import           Network.HTTP.Client as Export
                       ( BodyReader, HttpExceptionContent (StatusCodeException)
                       , parseRequest, parseUrlThrow
                       )
    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 a. m a -> IO a) -> IO a) -> m a
    forall b. ((forall a. m a -> IO a) -> IO b) -> m b
    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
    $ \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 :: forall (m :: * -> *) a.
    MonadUnliftIO m =>
    Request -> (Response () -> ConduitT ByteString Void m a) -> m a
    httpSink Request
    req = Request -> (Response () -> ConduitM ByteString Void m a) -> m a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    Request -> (Response () -> ConduitT ByteString Void m a) -> m a
    HTTP.httpSink (Request -> Request
    setUserAgent Request
    req)

    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 <- IO Request -> m Request
    forall a. IO a -> m a
    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 () -> ConduitT 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 -> ConduitT i Void 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
    <$> ConduitT ByteString Void m SHA256 -> ZipSink ByteString m SHA256
    forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
    ZipSink (Maybe SHA256 -> ConduitT ByteString Void 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 a b.
    ZipSink ByteString m (a -> b)
    -> ZipSink ByteString m a -> ZipSink ByteString m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ConduitT ByteString Void m FileSize
    -> ZipSink ByteString m FileSize
    forall i (m :: * -> *) r. ConduitT i Void m r -> ZipSink i m r
    ZipSink (Maybe FileSize -> ConduitT ByteString Void 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 a b.
    ZipSink ByteString m (a -> b)
    -> ZipSink ByteString m a -> ZipSink ByteString m b
    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. 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 <- 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
    $ \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 Mismatch
            { mismatchExpected :: SHA256
    mismatchExpected = SHA256
    expected
            , mismatchActual :: SHA256
    mismatchActual = SHA256
    actual
            }
        SHA256 -> ConduitT ByteString o m SHA256
    forall a. a -> ConduitT ByteString o m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SHA256
    actual
      checkSize :: Maybe FileSize -> ConduitT ByteString o m FileSize
    checkSize Maybe FileSize
    mexpected =
        Word -> ConduitT ByteString o m FileSize
    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 <- ConduitT ByteString o m (Maybe ByteString)
    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 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 Mismatch
                    { mismatchExpected :: FileSize
    mismatchExpected = Word -> FileSize
    FileSize Word
    expected
                    , mismatchActual :: FileSize
    mismatchActual = Word -> FileSize
    FileSize Word
    accum
                    }
                Maybe FileSize
    _ -> FileSize -> ConduitT ByteString o m FileSize
    forall a. a -> ConduitT ByteString o m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Word -> FileSize
    FileSize Word
    accum)
            Just 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 Word
    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 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'