module Stack.Types.PackageIndex
( PackageDownload (..)
, HSPackageDownload (..)
, PackageCache (..)
, PackageCacheMap (..)
, OffsetSize (..)
, PackageIndex(..)
, IndexName(..)
, indexNameText
, IndexLocation(..)
, SimplifiedIndexLocation (..)
, simplifyIndexLocation
, HttpType (..)
, HackageSecurity (..)
) where
import Control.DeepSeq (NFData)
import Control.Monad (mzero)
import Data.Aeson.Extended
import Data.ByteString (ByteString)
import qualified Data.Foldable as F
import Data.Hashable (Hashable)
import Data.Data (Data, Typeable)
import Data.HashMap.Strict (HashMap)
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.BuildPlan (GitSHA1)
import Stack.Types.PackageIdentifier
data PackageCache = PackageCache
{ pcOffsetSize :: !OffsetSize
, pcDownload :: !(Maybe PackageDownload)
}
deriving (Generic, Eq, Show, Data, Typeable)
instance Store PackageCache
instance NFData PackageCache
data OffsetSize = OffsetSize !Int64 !Int64
deriving (Generic, Eq, Show, Data, Typeable)
instance Store OffsetSize
instance NFData OffsetSize
data PackageCacheMap = PackageCacheMap
{ pcmIdent :: !(Map PackageIdentifier PackageCache)
, pcmSHA :: !(HashMap GitSHA1 OffsetSize)
}
deriving (Generic, Eq, Show, Data, Typeable)
instance Store PackageCacheMap
instance NFData PackageCacheMap
data PackageDownload = PackageDownload
{ pdSHA256 :: !ByteString
, pdUrl :: !ByteString
, pdSize :: !Word64
}
deriving (Show, Generic, Eq, Data, Typeable)
instance Store PackageDownload
instance NFData PackageDownload
instance FromJSON PackageDownload where
parseJSON = withObject "PackageDownload" $ \o -> do
hashes <- o .: "package-hashes"
sha256 <- maybe mzero return (Map.lookup ("SHA256" :: Text) hashes)
locs <- o .: "package-locations"
url <-
case reverse locs of
[] -> mzero
x:_ -> return x
size <- o .: "package-size"
return PackageDownload
{ pdSHA256 = encodeUtf8 sha256
, pdUrl = encodeUtf8 url
, pdSize = size
}
newtype HSPackageDownload = HSPackageDownload { unHSPackageDownload :: PackageDownload }
instance FromJSON HSPackageDownload where
parseJSON = withObject "HSPackageDownload" $ \o1 -> do
o2 <- o1 .: "signed"
Object o3 <- o2 .: "targets"
Object o4:_ <- return $ F.toList o3
len <- o4 .: "length"
hashes <- o4 .: "hashes"
sha256 <- hashes .: "sha256"
return $ HSPackageDownload PackageDownload
{ pdSHA256 = encodeUtf8 sha256
, pdSize = len
, pdUrl = ""
}
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 HttpType = HTHackageSecurity !HackageSecurity | HTVanilla
deriving (Show, Eq, Ord)
data HackageSecurity = HackageSecurity
{ hsKeyIds :: ![Text]
, hsKeyThreshold :: !Int
}
deriving (Show, Eq, Ord)
instance FromJSON HackageSecurity where
parseJSON = withObject "HackageSecurity" $ \o -> HackageSecurity
<$> o .: "keyids"
<*> o .: "key-threshold"
data IndexLocation
= ILGit !Text
| ILHttp !Text !HttpType
| ILGitHttp !Text !Text !HttpType
deriving (Show, Eq, Ord)
data SimplifiedIndexLocation = SILGit !Text | SILHttp !Text !HttpType
deriving (Show, Eq, Ord)
simplifyIndexLocation :: IndexLocation -> SimplifiedIndexLocation
simplifyIndexLocation (ILGit t) = SILGit t
simplifyIndexLocation (ILHttp t ht) = SILHttp t ht
simplifyIndexLocation (ILGitHttp _ t ht) = SILHttp t ht
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"
mhackageSecurity <- o ..:? "hackage-security"
let httpType = maybe HTVanilla HTHackageSecurity mhackageSecurity
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 httpType
(Just git, Just http) -> return $ ILGitHttp git http httpType
gpgVerify <- o ..:? "gpg-verify" ..!= False
reqHashes <- o ..:? "require-hashes" ..!= False
return PackageIndex
{ indexName = name
, indexLocation = loc
, indexDownloadPrefix = prefix
, indexGpgVerify = gpgVerify
, indexRequireHashes = reqHashes
}