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

module Stack.Types.DownloadInfo
  ( DownloadInfo (..)
  , parseDownloadInfoFromObject
  ) where

import           Pantry.Internal.AesonExtended
                   ( FromJSON (..), Object, WarningParser
                   , WithJSONWarnings (..), (..:), (..:?), withObjectWarnings
                   )
import           Stack.Prelude

-- | Build of the compiler distribution (e.g. standard, gmp4, tinfo6)

-- | Information for a file to download.

data DownloadInfo = DownloadInfo
  { DownloadInfo -> Text
downloadInfoUrl :: Text
    -- ^ URL or absolute file path

  , DownloadInfo -> Maybe Int
downloadInfoContentLength :: Maybe Int
  , DownloadInfo -> Maybe ByteString
downloadInfoSha1 :: Maybe ByteString
  , DownloadInfo -> Maybe ByteString
downloadInfoSha256 :: Maybe ByteString
  }
  deriving Int -> DownloadInfo -> ShowS
[DownloadInfo] -> ShowS
DownloadInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DownloadInfo] -> ShowS
$cshowList :: [DownloadInfo] -> ShowS
show :: DownloadInfo -> String
$cshow :: DownloadInfo -> String
showsPrec :: Int -> DownloadInfo -> ShowS
$cshowsPrec :: Int -> DownloadInfo -> ShowS
Show

instance FromJSON (WithJSONWarnings DownloadInfo) where
  parseJSON :: Value -> Parser (WithJSONWarnings DownloadInfo)
parseJSON = forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"DownloadInfo" Object -> WarningParser DownloadInfo
parseDownloadInfoFromObject

-- | Parse JSON in existing object for 'DownloadInfo'

parseDownloadInfoFromObject :: Object -> WarningParser DownloadInfo
parseDownloadInfoFromObject :: Object -> WarningParser DownloadInfo
parseDownloadInfoFromObject Object
o = do
  Text
url <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser a
..: Text
"url"
  Maybe Int
contentLength <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"content-length"
  Maybe Text
sha1TextMay <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha1"
  Maybe Text
sha256TextMay <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"sha256"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    DownloadInfo
    { downloadInfoUrl :: Text
downloadInfoUrl = Text
url
    , downloadInfoContentLength :: Maybe Int
downloadInfoContentLength = Maybe Int
contentLength
    , downloadInfoSha1 :: Maybe ByteString
downloadInfoSha1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8 Maybe Text
sha1TextMay
    , downloadInfoSha256 :: Maybe ByteString
downloadInfoSha256 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8 Maybe Text
sha256TextMay
    }