module Stack.Types.PackageIndex
( PackageDownload (..)
, PackageCache (..)
, PackageCacheMap (..)
, PackageIndex(..)
, IndexName(..)
, indexNameText
, IndexLocation(..)
) where
import Control.DeepSeq (NFData)
import Control.Monad (mzero)
import Data.Aeson.Extended
import Data.ByteString (ByteString)
import Data.Hashable (Hashable)
import Data.Data (Data, Typeable)
import Data.Int (Int64)
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Store (Store)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Word (Word64)
import GHC.Generics (Generic)
import Path
import Stack.Types.PackageIdentifier
data PackageCache = PackageCache
{ pcOffset :: !Int64
, pcSize :: !Int64
, pcDownload :: !(Maybe PackageDownload)
}
deriving (Generic, Eq, Show, Data, Typeable)
instance Store PackageCache
instance NFData PackageCache
newtype PackageCacheMap = PackageCacheMap (Map PackageIdentifier PackageCache)
deriving (Generic, Store, NFData, Eq, Show, Data, Typeable)
data PackageDownload = PackageDownload
{ pdSHA512 :: !ByteString
, pdUrl :: !ByteString
, pdSize :: !Word64
}
deriving (Show, Generic, Eq, Data, Typeable)
instance Store PackageDownload
instance NFData PackageDownload
instance FromJSON PackageDownload where
parseJSON = withObject "Package" $ \o -> do
hashes <- o .: "package-hashes"
sha512 <- maybe mzero return (Map.lookup ("SHA512" :: Text) hashes)
locs <- o .: "package-locations"
url <-
case reverse locs of
[] -> mzero
x:_ -> return x
size <- o .: "package-size"
return PackageDownload
{ pdSHA512 = encodeUtf8 sha512
, pdUrl = encodeUtf8 url
, pdSize = size
}
newtype IndexName = IndexName { unIndexName :: ByteString }
deriving (Show, Eq, Ord, Hashable, Store)
indexNameText :: IndexName -> Text
indexNameText = decodeUtf8 . unIndexName
instance ToJSON IndexName where
toJSON = toJSON . indexNameText
instance FromJSON IndexName where
parseJSON = withText "IndexName" $ \t ->
case parseRelDir (T.unpack t) of
Left e -> fail $ "Invalid index name: " ++ show e
Right _ -> return $ IndexName $ encodeUtf8 t
data IndexLocation = ILGit !Text | ILHttp !Text | ILGitHttp !Text !Text
deriving (Show, Eq, Ord)
data PackageIndex = PackageIndex
{ indexName :: !IndexName
, indexLocation :: !IndexLocation
, indexDownloadPrefix :: !Text
, indexGpgVerify :: !Bool
, indexRequireHashes :: !Bool
}
deriving Show
instance FromJSON (WithJSONWarnings PackageIndex) where
parseJSON = withObjectWarnings "PackageIndex" $ \o -> do
name <- o ..: "name"
prefix <- o ..: "download-prefix"
mgit <- o ..:? "git"
mhttp <- o ..:? "http"
loc <-
case (mgit, mhttp) of
(Nothing, Nothing) -> fail $
"Must provide either Git or HTTP URL for " ++
T.unpack (indexNameText name)
(Just git, Nothing) -> return $ ILGit git
(Nothing, Just http) -> return $ ILHttp http
(Just git, Just http) -> return $ ILGitHttp git http
gpgVerify <- o ..:? "gpg-verify" ..!= False
reqHashes <- o ..:? "require-hashes" ..!= False
return PackageIndex
{ indexName = name
, indexLocation = loc
, indexDownloadPrefix = prefix
, indexGpgVerify = gpgVerify
, indexRequireHashes = reqHashes
}