{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS -fno-warn-unused-do-bind #-}
module Stack.Types.PackageIdentifier
( PackageIdentifier(..)
, PackageIdentifierRevision(..)
, CabalHash
, mkCabalHashFromSHA256
, computeCabalHash
, showCabalHash
, CabalFileInfo(..)
, toTuple
, fromTuple
, parsePackageIdentifier
, parsePackageIdentifierFromString
, parsePackageIdentifierRevision
, packageIdentifierParser
, packageIdentifierString
, packageIdentifierRevisionString
, packageIdentifierText
, toCabalPackageIdentifier
, fromCabalPackageIdentifier
, StaticSHA256
, mkStaticSHA256FromText
, mkStaticSHA256FromFile
, mkStaticSHA256FromDigest
, staticSHA256ToText
, staticSHA256ToBase16
, staticSHA256ToRaw
)
where
import Stack.Prelude
import Crypto.Hash.Conduit (hashFile)
import Crypto.Hash as Hash (hashlazy, Digest, SHA256)
import Data.Aeson.Extended
import Data.Attoparsec.Text as A
import qualified Data.ByteArray
import qualified Data.ByteArray.Encoding as Mem
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Distribution.Package as C
import Stack.StaticBytes
import Stack.Types.PackageName
import Stack.Types.Version
data PackageIdentifierParseFail
= PackageIdentifierParseFail Text
| PackageIdentifierRevisionParseFail Text
deriving (Typeable)
instance Show PackageIdentifierParseFail where
show (PackageIdentifierParseFail bs) = "Invalid package identifier: " ++ show bs
show (PackageIdentifierRevisionParseFail bs) = "Invalid package identifier (with optional revision): " ++ show bs
instance Exception PackageIdentifierParseFail
data PackageIdentifier = PackageIdentifier
{
packageIdentifierName :: !PackageName
, packageIdentifierVersion :: !Version
} deriving (Eq,Ord,Generic,Data,Typeable)
instance NFData PackageIdentifier where
rnf (PackageIdentifier !p !v) =
seq (rnf p) (rnf v)
instance Hashable PackageIdentifier
instance Store PackageIdentifier
instance Show PackageIdentifier where
show = show . packageIdentifierString
instance Display PackageIdentifier where
display = fromString . packageIdentifierString
instance ToJSON PackageIdentifier where
toJSON = toJSON . packageIdentifierString
instance FromJSON PackageIdentifier where
parseJSON = withText "PackageIdentifier" $ \t ->
case parsePackageIdentifier t of
Left e -> fail $ show (e, t)
Right x -> return x
data PackageIdentifierRevision = PackageIdentifierRevision
{ pirIdent :: !PackageIdentifier
, pirRevision :: !CabalFileInfo
} deriving (Eq,Ord,Generic,Data,Typeable)
instance NFData PackageIdentifierRevision where
rnf (PackageIdentifierRevision !i !c) =
seq (rnf i) (rnf c)
instance Hashable PackageIdentifierRevision
instance Store PackageIdentifierRevision
instance Show PackageIdentifierRevision where
show = show . packageIdentifierRevisionString
instance ToJSON PackageIdentifierRevision where
toJSON = toJSON . packageIdentifierRevisionString
instance FromJSON PackageIdentifierRevision where
parseJSON = withText "PackageIdentifierRevision" $ \t ->
case parsePackageIdentifierRevision t of
Left e -> fail $ show (e, t)
Right x -> return x
newtype CabalHash = CabalHash { unCabalHash :: StaticSHA256 }
deriving (Generic, Show, Eq, NFData, Data, Typeable, Ord, Store, Hashable)
newtype StaticSHA256 = StaticSHA256 Bytes32
deriving (Generic, Show, Eq, NFData, Data, Typeable, Ord, Hashable, Store)
mkStaticSHA256FromText :: Text -> Either SomeException StaticSHA256
mkStaticSHA256FromText t =
mapLeft (toException . stringException) (Mem.convertFromBase Mem.Base16 (encodeUtf8 t))
>>= either (Left . toE) (Right . StaticSHA256)
. toStaticExact
. (id :: ByteString -> ByteString)
where
toE e = toException $ stringException $ concat
[ "Unable to convert "
, show t
, " into SHA256: "
, show e
]
mkStaticSHA256FromFile :: MonadIO m => Path Abs File -> m StaticSHA256
mkStaticSHA256FromFile fp = liftIO $ mkStaticSHA256FromDigest <$> hashFile (toFilePath fp)
mkStaticSHA256FromDigest :: Hash.Digest Hash.SHA256 -> StaticSHA256
mkStaticSHA256FromDigest digest
= StaticSHA256
$ either impureThrow id
$ toStaticExact
(Data.ByteArray.convert digest :: ByteString)
staticSHA256ToText :: StaticSHA256 -> Text
staticSHA256ToText = decodeUtf8 . staticSHA256ToBase16
staticSHA256ToBase16 :: StaticSHA256 -> ByteString
staticSHA256ToBase16 (StaticSHA256 x) = Mem.convertToBase Mem.Base16 x
staticSHA256ToRaw :: StaticSHA256 -> ByteString
staticSHA256ToRaw (StaticSHA256 x) = Data.ByteArray.convert x
mkCabalHashFromSHA256 :: Text -> Either SomeException CabalHash
mkCabalHashFromSHA256 = fmap CabalHash . mkStaticSHA256FromText
cabalHashToText :: CabalHash -> Text
cabalHashToText = staticSHA256ToText . unCabalHash
computeCabalHash :: L.ByteString -> CabalHash
computeCabalHash = CabalHash . mkStaticSHA256FromDigest . Hash.hashlazy
showCabalHash :: CabalHash -> Text
showCabalHash = T.append (T.pack "sha256:") . cabalHashToText
data CabalFileInfo
= CFILatest
| CFIHash
!(Maybe Int)
!CabalHash
| CFIRevision !Word
deriving (Generic, Show, Eq, Ord, Data, Typeable)
instance Store CabalFileInfo
instance NFData CabalFileInfo
instance Hashable CabalFileInfo
toTuple :: PackageIdentifier -> (PackageName,Version)
toTuple (PackageIdentifier n v) = (n,v)
fromTuple :: (PackageName,Version) -> PackageIdentifier
fromTuple (n,v) = PackageIdentifier n v
packageIdentifierParser :: Parser PackageIdentifier
packageIdentifierParser =
do name <- packageNameParser
char '-'
PackageIdentifier name <$> versionParser
parsePackageIdentifier :: MonadThrow m => Text -> m PackageIdentifier
parsePackageIdentifier x = go x
where go =
either (const (throwM (PackageIdentifierParseFail x))) return .
parseOnly (packageIdentifierParser <* endOfInput)
parsePackageIdentifierFromString :: MonadThrow m => String -> m PackageIdentifier
parsePackageIdentifierFromString =
parsePackageIdentifier . T.pack
parsePackageIdentifierRevision :: MonadThrow m => Text -> m PackageIdentifierRevision
parsePackageIdentifierRevision x = go x
where
go =
either (const (throwM (PackageIdentifierRevisionParseFail x))) return .
parseOnly (parser <* endOfInput)
parser = PackageIdentifierRevision
<$> packageIdentifierParser
<*> (cfiHash <|> cfiRevision <|> pure CFILatest)
cfiHash = do
_ <- string $ T.pack "@sha256:"
hash' <- A.takeWhile (/= ',')
hash'' <- either (\e -> fail $ "Invalid SHA256: " ++ show e) return
$ mkCabalHashFromSHA256 hash'
msize <- optional $ do
_ <- A.char ','
A.decimal
A.endOfInput
return $ CFIHash msize hash''
cfiRevision = do
_ <- string $ T.pack "@rev:"
y <- A.decimal
A.endOfInput
return $ CFIRevision y
packageIdentifierString :: PackageIdentifier -> String
packageIdentifierString (PackageIdentifier n v) = show n ++ "-" ++ show v
packageIdentifierRevisionString :: PackageIdentifierRevision -> String
packageIdentifierRevisionString (PackageIdentifierRevision ident cfi) =
concat $ packageIdentifierString ident : rest
where
rest =
case cfi of
CFILatest -> []
CFIHash msize hash' ->
"@sha256:"
: T.unpack (cabalHashToText hash')
: showSize msize
CFIRevision rev -> ["@rev:", show rev]
showSize Nothing = []
showSize (Just int) = [',' : show int]
packageIdentifierText :: PackageIdentifier -> Text
packageIdentifierText = T.pack . packageIdentifierString
toCabalPackageIdentifier :: PackageIdentifier -> C.PackageIdentifier
toCabalPackageIdentifier x =
C.PackageIdentifier
(toCabalPackageName (packageIdentifierName x))
(toCabalVersion (packageIdentifierVersion x))
fromCabalPackageIdentifier :: C.PackageIdentifier -> PackageIdentifier
fromCabalPackageIdentifier (C.PackageIdentifier name version) =
PackageIdentifier
(fromCabalPackageName name)
(fromCabalVersion version)