Extend core types

This commit is contained in:
Richard Marko 2018-07-16 09:09:23 +02:00
parent 2075aae5ac
commit c37c3017e5
6 changed files with 219 additions and 2 deletions

View File

@ -18,9 +18,13 @@ cabal-version: >=1.10
library
exposed-modules: Crypto.Hash.Truncated
, System.Nix.Build
, System.Nix.Derivation
, System.Nix.GC
, System.Nix.Nar
, System.Nix.Path
, System.Nix.Store
, System.Nix.Util
build-depends: base >=4.10 && <4.11
, basement
, bytestring

View File

@ -0,0 +1,50 @@
{-# LANGUAGE RecordWildCards #-}
{-|
Description : Build related types
Maintainer : srk <srk@48.io>
|-}
module System.Nix.Build (
BuildMode(..)
, BuildStatus(..)
, BuildResult(..)
, buildSuccess
) where
import Data.Text (Text)
import Data.HashSet (HashSet)
import System.Nix.Path (Path)
data BuildMode = Normal | Repair | Check
deriving (Eq, Ord, Enum, Show)
data BuildStatus =
Built
| Substituted
| AlreadyValid
| PermanentFailure
| InputRejected
| OutputRejected
| TransientFailure -- possibly transient
| CachedFailure -- no longer used
| TimedOut
| MiscFailure
| DependencyFailed
| LogLimitExceeded
| NotDeterministic
deriving (Eq, Ord, Enum, Show)
-- | Result of the build
data BuildResult = BuildResult
{ -- | build status, MiscFailure should be default
status :: !BuildStatus
, -- | possible build error message
error :: !(Maybe Text)
, -- | How many times this build was performed
timesBuilt :: !Integer
, -- | If timesBuilt > 1, whether some builds did not produce the same result
isNonDeterministic :: !Bool
-- XXX: | startTime stopTime time_t
} deriving (Eq, Ord, Show)
buildSuccess BuildResult{..} = status == Built || status == Substituted || status == AlreadyValid

View File

@ -0,0 +1,28 @@
{-|
Description : Derivation types
Maintainer : srk <srk@48.io>
|-}
module System.Nix.Derivation (
BasicDerivation(..)
) where
import Data.Text (Text)
import Data.HashMap.Strict (HashMap)
import System.Nix.Path
data BasicDerivation = BasicDerivation
{ -- | Derivation outputs
outputs :: !(HashMap Text Path)
, -- | Inputs that are sources
inputSrcs :: !PathSet
, -- | Platform
platform :: !Text
, -- | Path to builder
builder :: !Path
, -- | Arguments
args :: ![Text]
, -- | Environment
env :: ![HashMap Text Text]
} deriving (Eq, Ord, Show)

View File

@ -0,0 +1,47 @@
{-|
Description : Garbage collection actions / options
Maintainer : srk <srk@48.io>
|-}
module System.Nix.GC (
Action(..)
, Options(..)
, Result(..)
) where
import System.Nix.Path (PathSet)
{- Garbage collector operation:
- ReturnLive: return the set of paths reachable from
(i.e. in the closure of) the roots.
- ReturnDead: return the set of paths not reachable from
the roots.
- DeleteDead: actually delete the latter set.
- DeleteSpecific: delete the paths listed in
`pathsToDelete', insofar as they are not reachable.
-}
data Action = ReturnLive | ReturnDead | DeleteDead | DeleteSpecific
deriving (Eq, Ord, Enum, Show)
-- | Garbage collector operation options
data Options = Options
{ -- | operation
operation :: !Action
-- | If `ignoreLiveness' is set, then reachability from the roots is
-- ignored (dangerous!). However, the paths must still be
-- unreferenced *within* the store (i.e., there can be no other
-- store paths that depend on them).
, ignoreLiveness :: !Bool
-- | For DeleteSpecific, the paths to delete
, pathsToDelete :: !PathSet
, -- | Stop after at least `maxFreed` bytes have been freed
maxFreed :: !Integer
} deriving (Eq, Ord, Show)
data Result = Result
{ -- | Depending on the action, the GC roots, or the paths that would be or have been deleted
paths :: !PathSet
, -- | For ReturnDead, DeleteDead and DeleteSpecific, the number of bytes that would be or was freed
bytesFreed :: !Integer
} deriving (Eq, Ord, Show)

View File

@ -8,10 +8,13 @@ module System.Nix.Path
( FilePathPart(..)
, PathHashAlgo
, Path(..)
, PathSet
, SubstitutablePathInfo(..)
, ValidPathInfo(..)
, PathName(..)
, filePathPart
, pathName
, Roots
) where
import Crypto.Hash (Digest)
@ -23,6 +26,7 @@ import qualified Data.ByteString.Char8 as BSC
import Data.Hashable (Hashable (..), hashPtrWithSalt)
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import Data.Map.Strict (Map)
import Data.Text (Text)
import qualified Data.Text as T
import System.IO.Unsafe (unsafeDupablePerformIO)
@ -53,6 +57,7 @@ type PathHashAlgo = Truncated SHA256 20
-- | A path in a store.
data Path = Path !(Digest PathHashAlgo) !PathName
deriving (Eq, Ord, Show)
-- | Wrapper to defined a 'Hashable' instance for 'Digest'.
newtype HashableDigest a = HashableDigest (Digest a)
@ -67,18 +72,51 @@ instance Hashable Path where
(HashableDigest digest) `hashWithSalt` name
type PathSet = HashSet Path
-- | Information about substitutes for a 'Path'.
data SubstitutablePathInfo = SubstitutablePathInfo
{ -- | The .drv which led to this 'Path'.
deriver :: !(Maybe Path)
, -- | The references of the 'Path'
references :: !(HashSet Path)
references :: !PathSet
, -- | The (likely compressed) size of the download of this 'Path'.
downloadSize :: !Integer
, -- | The size of the uncompressed NAR serialization of this
-- 'Path'.
narSize :: !Integer
}
} deriving (Eq, Ord, Show)
-- | Information about 'Path'.
data ValidPathInfo = ValidPathInfo
{ -- | Path itself
path :: !Path
, -- | The .drv which led to this 'Path'.
deriverVP :: !(Maybe Path)
, -- | NAR hash
narHash :: !Text
, -- | The references of the 'Path'
referencesVP :: !PathSet
, -- | Registration time should be time_t
registrationTime :: !Integer
, -- | The size of the uncompressed NAR serialization of this
-- 'Path'.
narSizeVP :: !Integer
, -- | Whether the path is ultimately trusted, that is, it's a
-- derivation output that was built locally.
ultimate :: !Bool
, -- | Signatures
sigs :: ![Text]
, -- | Content-addressed
-- Store path is computed from a cryptographic hash
-- of the contents of the path, plus some other bits of data like
-- the "name" part of the path.
--
-- ca has one of the following forms:
-- * text:sha256:<sha256 hash of file contents> (paths by makeTextPath() / addTextToStore())
-- * fixed:<r?>:<ht>:<h> (paths by makeFixedOutputPath() / addToStore())
ca :: !Text
} deriving (Eq, Ord, Show)
-- | A valid filename or directory name
newtype FilePathPart = FilePathPart { unFilePathPart :: BSC.ByteString }
@ -90,3 +128,5 @@ filePathPart :: BSC.ByteString -> Maybe FilePathPart
filePathPart p = case BSC.any (`elem` ['/', '\NUL']) p of
False -> Just $ FilePathPart p
True -> Nothing
type Roots = Map Path Path

View File

@ -0,0 +1,48 @@
{-|
Description : Utilities for packing stuff
Maintainer : srk <srk@48.io>
|-}
module System.Nix.Util where
import Control.Monad
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString.Lazy as LBS
putInt :: Integral a => a -> Put
putInt = putWord64le . fromIntegral
getInt :: Integral a => Get a
getInt = fromIntegral <$> getWord64le
-- length prefixed string packing with padding to 8 bytes
putByteStringLen :: LBS.ByteString -> Put
putByteStringLen x = do
putInt $ fromIntegral $ len
putLazyByteString x
when (len `mod` 8 /= 0) $
pad $ fromIntegral $ 8 - (len `mod` 8)
where len = LBS.length x
pad x = forM_ (take x $ cycle [0]) putWord8
putByteStrings :: Foldable t => t LBS.ByteString -> Put
putByteStrings xs = do
putInt $ fromIntegral $ length xs
mapM_ putByteStringLen xs
getByteStringLen :: Get LBS.ByteString
getByteStringLen = do
len <- getInt
st <- getLazyByteString len
when (len `mod` 8 /= 0) $ do
pads <- unpad $ fromIntegral $ 8 - (len `mod` 8)
unless (all (==0) pads) $ fail $ "No zeroes" ++ show (st, len, pads)
return st
where unpad x = sequence $ replicate x getWord8
getByteStrings :: Get [LBS.ByteString]
getByteStrings = do
count <- getInt
res <- sequence $ replicate count getByteStringLen
return res