|
| 1 | +{-# LANGUAGE OverloadedStrings #-} |
| 2 | +{-# LANGUAGE DataKinds #-} |
| 3 | +{-# LANGUAGE TypeApplications #-} |
| 4 | + |
| 5 | +{-| |
| 6 | +Description : Internal path utilities |
| 7 | +Maintainer : srk <[email protected]> |
| 8 | +|-} |
| 9 | +module System.Nix.Internal.Path where |
| 10 | + |
| 11 | +import Control.Monad |
| 12 | +import qualified Data.ByteString.Lazy as BSL |
| 13 | +import qualified Data.ByteString.Char8 as BSC |
| 14 | +import Data.Text (Text) |
| 15 | +import qualified Data.Text as T |
| 16 | +import System.FilePath.Posix (takeBaseName, takeDirectory) |
| 17 | +import System.Nix.Path (Path(..), PathName(..), pathName, PathHashAlgo) |
| 18 | +import System.Nix.Internal.Hash (Digest(..), HashAlgorithm'( SHA256 )) |
| 19 | +import System.Nix.Hash (HasDigest, printAsBase16, printAsBase32, printHashAlgo) |
| 20 | +import qualified System.Nix.Hash |
| 21 | + |
| 22 | +-- | Parse store location |
| 23 | +parseStore :: BSL.ByteString -> T.Text |
| 24 | +parseStore = T.pack . takeDirectory . BSC.unpack . BSL.toStrict |
| 25 | + |
| 26 | +-- | Parse path from string |
| 27 | +-- |
| 28 | +-- in form <storeDir>/<hash>-<pathName> |
| 29 | +-- into (Just (Path <hash> (PathName <pathName>))) |
| 30 | +-- or Nothing on error |
| 31 | +-- |
| 32 | +-- XXX: should check for @PathHashAlgo length |
| 33 | +parsePath :: BSL.ByteString -> Maybe Path |
| 34 | +parsePath p = case name of |
| 35 | + Nothing -> Nothing |
| 36 | + Just n -> Just $ Path digest n |
| 37 | + where |
| 38 | + base = T.pack . takeBaseName . BSC.unpack . BSL.toStrict $ p |
| 39 | + parts = T.breakOn "-" base |
| 40 | + digest = Digest . BSC.pack . T.unpack . fst $ parts |
| 41 | + name = pathName . T.drop 1 . snd $ parts |
| 42 | + |
| 43 | + |
| 44 | +-- experimental |
| 45 | +-- Directory of the store |
| 46 | +type StoreDir = Text |
| 47 | +type Stored a = (StoreDir, a) |
| 48 | + |
| 49 | +-- wrap StoreDir and Path into tuple |
| 50 | +makeStored :: StoreDir -> Path -> Stored Path |
| 51 | +makeStored sl p = (sl, p) |
| 52 | + |
| 53 | +type PathType = Text |
| 54 | +-- "text:<r1>:<r2>:...<rN>" |
| 55 | +-- "source" |
| 56 | +-- "output:<id>" |
| 57 | +-- <id> is the name of the output (usually, "out"). |
| 58 | + |
| 59 | +-- store settings |
| 60 | +data Settings = Settings { |
| 61 | + storeDir :: StoreDir -- settings.nixStore |
| 62 | + } deriving (Eq, Show) |
| 63 | + |
| 64 | +-- build a store path in the following form: |
| 65 | +-- <storeDir>/<hash>-<pathName> |
| 66 | +storedToText :: Stored Path -> Text |
| 67 | +storedToText (storeLoc, (Path digest pName)) = T.concat |
| 68 | + [ storeLoc |
| 69 | + , "/" |
| 70 | + , printAsBase32 @PathHashAlgo digest |
| 71 | + , "-" |
| 72 | + , pathNameContents pName |
| 73 | + ] |
| 74 | + |
| 75 | +makeStorePath :: (HasDigest a) => PathType -> PathName -> Digest a -> Settings -> Text |
| 76 | +makeStorePath typ pName digest settings = T.concat |
| 77 | + [ storeDir settings |
| 78 | + , "/" |
| 79 | + , printAsBase32 @PathHashAlgo $ pathHash typ pName digest (storeDir settings) |
| 80 | + , "-" |
| 81 | + , pathNameContents pName |
| 82 | + ] |
| 83 | + |
| 84 | +makeStorePath' :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Path |
| 85 | +makeStorePath' typ pName digest storeLoc = snd $ makeStoredPath typ pName digest storeLoc |
| 86 | + |
| 87 | +-- | build Stored Path from the type of the path, path name and a digest stored at StoreDir |
| 88 | +-- As StoreDir is part of the path hashing process we need to take it into account |
| 89 | +-- when building Path(s) |
| 90 | +makeStoredPath :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Stored Path |
| 91 | +makeStoredPath typ pName digest storeLoc = makeStored storeLoc $ Path (pathHash typ pName digest storeLoc) pName |
| 92 | + |
| 93 | +-- build <h> string which is a truncated base32 formatted SHA256 hash of <s> |
| 94 | +pathHash :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Digest PathHashAlgo |
| 95 | +pathHash typ pName digest storeLoc = System.Nix.Hash.hash . BSC.pack . T.unpack $ |
| 96 | + makePathDigestString typ pName digest storeLoc |
| 97 | + |
| 98 | +-- build <s> string which is hashed and used in makeStorePath |
| 99 | +-- <s> = "<pathType>:<hash_algo>:<base16_hash>:<storeDir>:<pathName>" |
| 100 | +-- (exposed for testing purposes only) |
| 101 | +makePathDigestString :: (HasDigest a) => PathType -> PathName -> Digest a -> StoreDir -> Text |
| 102 | +makePathDigestString typ pName digest storeLoc = T.intercalate (T.pack ":") |
| 103 | + [ typ |
| 104 | + , printHashAlgo digest |
| 105 | + , printAsBase16 digest |
| 106 | + , storeLoc |
| 107 | + , pathNameContents pName |
| 108 | + ] |
| 109 | + |
| 110 | +-- make output path from `PathName` digest and outputId which typically is "out" |
| 111 | +makeOutputPath :: (HasDigest a) => PathName -> Digest a -> T.Text -> Settings -> Text |
| 112 | +makeOutputPath pName digest outputId settings = |
| 113 | + makeStorePath typ (adjustName pName) digest settings |
| 114 | + where |
| 115 | + typ = T.concat [ "output:", outputId ] |
| 116 | + adjustName n | outputId == "out" = n |
| 117 | + adjustName (PathName name) | otherwise = PathName $ T.concat [ name, T.pack "-", outputId ] |
| 118 | + |
| 119 | +type Recursive = Bool |
| 120 | +-- make fixed output path from `PathName` and Recursive option |
| 121 | +makeFixedOutputPath :: (HasDigest a) => PathName -> Digest a -> Recursive -> Settings -> Text |
| 122 | +makeFixedOutputPath pName digest True settings = -- XXX: this needs be restricted to @a == @SHA256 |
| 123 | + makeStorePath ("source") pName digest settings |
| 124 | +makeFixedOutputPath pName digest recursive settings = |
| 125 | + makeStorePath ("output:out") pName digest' settings |
| 126 | + where |
| 127 | + rec True = "r:" |
| 128 | + rec False = T.empty |
| 129 | + digest' = System.Nix.Hash.hash @SHA256 $ BSC.pack . T.unpack . T.concat $ |
| 130 | + [ "fixed:out:" |
| 131 | + , rec recursive |
| 132 | + , printHashAlgo digest |
| 133 | + , printAsBase16 digest |
| 134 | + , ":" |
| 135 | + ] |
| 136 | + |
| 137 | +-- references should be PathSet not [T.Text] |
| 138 | +-- but how to turn PathSet into store paths (texts) again |
| 139 | +-- when we don't have PathType |
| 140 | +type References = [T.Text] |
| 141 | + |
| 142 | +makeTextPath :: (HasDigest a) => PathName -> Digest a -> References-> Settings -> Text |
| 143 | +makeTextPath pName digest references settings = |
| 144 | + makeStorePath typ pName digest settings |
| 145 | + where typ = T.concat $ [ "text" ] ++ (map (T.cons ':') references) |
| 146 | + |
| 147 | +storePathForText :: PathName -> T.Text -> References -> Settings -> Text |
| 148 | +storePathForText pName contents references settings = |
| 149 | + makeTextPath pName hashOfContents references settings |
| 150 | + where hashOfContents = System.Nix.Hash.hash @SHA256 (BSC.pack . T.unpack $ contents) |
0 commit comments