From c37c3017e50312b38b8a2312a590897dc044f20f Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Mon, 16 Jul 2018 09:09:23 +0200 Subject: [PATCH 1/7] Extend core types --- hnix-store-core/hnix-store-core.cabal | 4 ++ hnix-store-core/src/System/Nix/Build.hs | 50 ++++++++++++++++++++ hnix-store-core/src/System/Nix/Derivation.hs | 28 +++++++++++ hnix-store-core/src/System/Nix/GC.hs | 47 ++++++++++++++++++ hnix-store-core/src/System/Nix/Path.hs | 44 ++++++++++++++++- hnix-store-core/src/System/Nix/Util.hs | 48 +++++++++++++++++++ 6 files changed, 219 insertions(+), 2 deletions(-) create mode 100644 hnix-store-core/src/System/Nix/Build.hs create mode 100644 hnix-store-core/src/System/Nix/Derivation.hs create mode 100644 hnix-store-core/src/System/Nix/GC.hs create mode 100644 hnix-store-core/src/System/Nix/Util.hs diff --git a/hnix-store-core/hnix-store-core.cabal b/hnix-store-core/hnix-store-core.cabal index 520d6bb9..713b4b68 100644 --- a/hnix-store-core/hnix-store-core.cabal +++ b/hnix-store-core/hnix-store-core.cabal @@ -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 diff --git a/hnix-store-core/src/System/Nix/Build.hs b/hnix-store-core/src/System/Nix/Build.hs new file mode 100644 index 00000000..f77c2b0d --- /dev/null +++ b/hnix-store-core/src/System/Nix/Build.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE RecordWildCards #-} +{-| +Description : Build related types +Maintainer : srk +|-} +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 diff --git a/hnix-store-core/src/System/Nix/Derivation.hs b/hnix-store-core/src/System/Nix/Derivation.hs new file mode 100644 index 00000000..56ccefc2 --- /dev/null +++ b/hnix-store-core/src/System/Nix/Derivation.hs @@ -0,0 +1,28 @@ +{-| +Description : Derivation types +Maintainer : srk +|-} + +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) diff --git a/hnix-store-core/src/System/Nix/GC.hs b/hnix-store-core/src/System/Nix/GC.hs new file mode 100644 index 00000000..5291e622 --- /dev/null +++ b/hnix-store-core/src/System/Nix/GC.hs @@ -0,0 +1,47 @@ +{-| +Description : Garbage collection actions / options +Maintainer : srk +|-} +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) + diff --git a/hnix-store-core/src/System/Nix/Path.hs b/hnix-store-core/src/System/Nix/Path.hs index 36307ebf..197e80ca 100644 --- a/hnix-store-core/src/System/Nix/Path.hs +++ b/hnix-store-core/src/System/Nix/Path.hs @@ -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:’ (paths by makeTextPath() / addTextToStore()) + -- * ‘fixed:::’ (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 diff --git a/hnix-store-core/src/System/Nix/Util.hs b/hnix-store-core/src/System/Nix/Util.hs new file mode 100644 index 00000000..62a17ab5 --- /dev/null +++ b/hnix-store-core/src/System/Nix/Util.hs @@ -0,0 +1,48 @@ +{-| +Description : Utilities for packing stuff +Maintainer : srk +|-} +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 + From d8828913ec5b24b449ff4f6065a17908a9f4fb5e Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Mon, 16 Jul 2018 09:12:23 +0200 Subject: [PATCH 2/7] hnix-store-remote prototype --- hnix-store-remote/LICENSE | 201 +++++++++++++++ hnix-store-remote/README.md | 26 ++ hnix-store-remote/hnix-store-remote.cabal | 40 +++ .../src/System/Nix/Store/Remote.hs | 243 ++++++++++++++++++ .../src/System/Nix/Store/Remote/Logger.hs | 60 +++++ .../src/System/Nix/Store/Remote/Protocol.hs | 155 +++++++++++ .../src/System/Nix/Store/Remote/Types.hs | 40 +++ .../src/System/Nix/Store/Remote/Util.hs | 100 +++++++ 8 files changed, 865 insertions(+) create mode 100644 hnix-store-remote/LICENSE create mode 100644 hnix-store-remote/README.md create mode 100644 hnix-store-remote/hnix-store-remote.cabal create mode 100644 hnix-store-remote/src/System/Nix/Store/Remote.hs create mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs create mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs create mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Types.hs create mode 100644 hnix-store-remote/src/System/Nix/Store/Remote/Util.hs diff --git a/hnix-store-remote/LICENSE b/hnix-store-remote/LICENSE new file mode 100644 index 00000000..6b9e8a2a --- /dev/null +++ b/hnix-store-remote/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright 2018 Shea Levy. + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/hnix-store-remote/README.md b/hnix-store-remote/README.md new file mode 100644 index 00000000..16a59db2 --- /dev/null +++ b/hnix-store-remote/README.md @@ -0,0 +1,26 @@ +hnix-store-remote +================= + +Nix worker protocol implementation for interacting with remote Nix store +via `nix-daemon`. + +## API + +[System.Nix.Store.Remote]: ./src/System/Nix/Store/Remote.hs + +## Example + +```haskell + +import Data.HashSet as HS +import System.Nix.Store.Remote + +main = do + runStore $ do + syncWithGC + roots <- findRoots + liftIO $ print roots + + res <- addTextToStore "hnix-store" "test" (HS.fromList []) False + print res +``` diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal new file mode 100644 index 00000000..ee2fde3c --- /dev/null +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -0,0 +1,40 @@ +name: hnix-store-remote +version: 0.1.0.0 +synopsis: Remote hnix store +description: +homepage: https://github.com/haskell-nix/hnix-store +license: Apache-2.0 +license-file: LICENSE +author: Richard Marko +maintainer: srk@48.io +copyright: 2018 Richard Marko +category: System +build-type: Simple +extra-source-files: ChangeLog.md, README.md +cabal-version: >=1.10 + +library + exposed-modules: System.Nix.Store.Remote + , System.Nix.Store.Remote.Logger + , System.Nix.Store.Remote.Protocol + , System.Nix.Store.Remote.Types + + build-depends: base >=4.10 && <4.11 + , bytestring + , binary + , bytestring + , containers + , text + , unix + , network + , mtl + , cryptonite + , unordered-containers + , memory +-- , pretty-simple +-- , base16-bytestring +-- , base32-bytestring + , hnix-store-core + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs new file mode 100644 index 00000000..c5c0e139 --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE OverloadedStrings #-} +module System.Nix.Store.Remote ( + runStore + , isValidPathUncached + , queryValidPaths + , queryAllValidPaths + , querySubstitutablePaths + , querySubstitutablePathInfos + , queryPathInfoUncached + , queryReferrers + , queryValidDerivers + , queryDerivationOutputs + , queryDerivationOutputNames + , queryPathFromHashPart + , addToStoreNar + , addToStore + , addTextToStore + , buildPaths + , buildDerivation + , ensurePath + , addTempRoot + , addIndirectRoot + , syncWithGC + , findRoots + , collectGarbage + , optimiseStore + , verifyStore + , addSignatures + , queryMissing + ) where + +import Data.Maybe +import Data.ByteArray (convert) +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Map.Strict as M + +import Control.Monad + +import qualified System.Nix.Build as Build +import qualified System.Nix.Derivation as Drv +import qualified System.Nix.GC as GC +import System.Nix.Path +import System.Nix.Util + +import System.Nix.Store.Remote.Types +import System.Nix.Store.Remote.Protocol +import System.Nix.Store.Remote.Util + +import Crypto.Hash + +type RepairFlag = Bool +type CheckFlag = Bool +type CheckSigsFlag = Bool +type SubstituteFlag = Bool + +-- TODO: error handling via ErrorT, some of these will just log Error, +-- which means we need to bail out and not wait for results +-- +--setOptions :: StoreSetting -> MonadStore () + +isValidPathUncached :: Path -> MonadStore Bool +isValidPathUncached p = simpleOpArgs IsValidPath $ putPath p + +queryValidPaths :: PathSet -> SubstituteFlag -> MonadStore PathSet +queryValidPaths ps substitute = do + runOpArgs QueryValidPaths $ do + putPaths ps + putBool substitute + sockGetPaths + +queryAllValidPaths :: MonadStore PathSet +queryAllValidPaths = do + runOp QueryAllValidPaths + sockGetPaths + +querySubstitutablePaths :: PathSet -> MonadStore PathSet +querySubstitutablePaths ps = do + runOpArgs QuerySubstitutablePaths $ do + putPaths ps + sockGetPaths + +querySubstitutablePathInfos :: PathSet -> MonadStore [SubstitutablePathInfo] +querySubstitutablePathInfos ps = do + runOpArgs QuerySubstitutablePathInfos $ do + putPaths ps + + cnt <- sockGetInt + forM (take cnt $ cycle [(0 :: Int)]) $ pure $ do + _pth <- sockGetPath + drv <- sockGetStr + refs <- sockGetPaths + dlSize <- sockGetInt + narSize' <- sockGetInt + return $ SubstitutablePathInfo { + deriver = mkPath drv + , references = refs + , downloadSize = dlSize + , narSize = narSize' + } + +queryPathInfoUncached :: Path -> MonadStore ValidPathInfo +queryPathInfoUncached p = do + runOpArgs QueryPathInfo $ do + putPath p + + valid <- sockGetBool + unless valid $ error "Path is not valid" + + drv <- sockGetStr + hash' <- lBSToText <$> sockGetStr + refs <- sockGetPaths + regTime <- sockGetInt + size <- sockGetInt + ulti <- sockGetBool + sigs' <- map lBSToText <$> sockGetStrings + ca' <- lBSToText <$> sockGetStr + return $ ValidPathInfo { + path = p + , deriverVP = mkPath drv + , narHash = hash' + , referencesVP = refs + , registrationTime = regTime + , narSizeVP = size + , ultimate = ulti + , sigs = sigs' + , ca = ca' + } + +queryReferrers :: Path -> MonadStore PathSet +queryReferrers p = do + runOpArgs QueryReferrers $ do + putPath p + sockGetPaths + +queryValidDerivers :: Path -> MonadStore PathSet +queryValidDerivers p = do + runOpArgs QueryValidDerivers $ do + putPath p + sockGetPaths + +queryDerivationOutputs :: Path -> MonadStore PathSet +queryDerivationOutputs p = do + runOpArgs QueryDerivationOutputs $ + putPath p + sockGetPaths + +queryDerivationOutputNames :: Path -> MonadStore PathSet +queryDerivationOutputNames p = do + runOpArgs QueryDerivationOutputNames $ + putPath p + sockGetPaths + +-- XXX: this is broken as I don't know how to get hashes from paths (fix mkPath) +queryPathFromHashPart :: Digest PathHashAlgo -> MonadStore (Maybe Path) +queryPathFromHashPart d = do + runOpArgs QueryPathFromHashPart $ + putByteStringLen $ LBS.fromStrict $ convert d + sockGetPath + +type Source = () -- abstract binary source +addToStoreNar :: ValidPathInfo -> Source -> RepairFlag -> CheckSigsFlag -> MonadStore () +addToStoreNar = undefined -- XXX + +type PathFilter = Path -> Bool +addToStore :: LBS.ByteString -> Path -> Bool -> PathHashAlgo -> PathFilter -> RepairFlag -> MonadStore Path +addToStore name pth recursive hashAlgo pfilter repair = undefined -- XXX + +addTextToStore :: LBS.ByteString -> LBS.ByteString -> PathSet -> RepairFlag -> MonadStore (Maybe Path) +addTextToStore name text references' repair = do + runOpArgs AddTextToStore $ do + putByteStringLen name + putByteStringLen text + putPaths references' + sockGetPath + +buildPaths :: PathSet -> Build.BuildMode -> MonadStore () +buildPaths ps bm = void $ simpleOpArgs EnsurePath $ do + putPaths ps + putInt $ fromEnum bm + +buildDerivation :: PathName -> Drv.BasicDerivation -> Build.BuildMode -> MonadStore Build.BuildResult +buildDerivation = undefined -- XXX + +ensurePath :: Path -> MonadStore () +ensurePath pn = void $ simpleOpArgs EnsurePath $ putPath pn + +addTempRoot :: Path -> MonadStore () +addTempRoot pn = void $ simpleOpArgs AddTempRoot $ putPath pn + +addIndirectRoot :: Path -> MonadStore () +addIndirectRoot pn = void $ simpleOpArgs AddIndirectRoot $ putPath pn + +syncWithGC :: MonadStore () +syncWithGC = void $ simpleOp SyncWithGC + +findRoots :: MonadStore Roots +findRoots = do + runOp FindRoots + res <- getSocketIncremental (do + count <- getInt + res <- sequence $ replicate count ((,) <$> getPath <*> getPath) + return res + ) + + return $ M.fromList $ catMaybesTupled res + where + catMaybesTupled :: [(Maybe a, Maybe b)] -> [(a, b)] + catMaybesTupled ls = map (\(Just x, Just y) -> (x, y)) $ filter (\(x,y) -> isJust x && isJust y) ls + +collectGarbage :: GC.Options -> MonadStore GC.Result +collectGarbage opts = do + runOpArgs CollectGarbage $ do + putInt $ fromEnum $ GC.operation opts + putPaths $ GC.pathsToDelete opts + putBool $ GC.ignoreLiveness opts + putInt $ GC.maxFreed opts + forM_ [(0 :: Int)..2] $ pure $ putInt (0 :: Int) -- removed options + + paths <- sockGetPaths + freed <- sockGetInt + _obsolete <- sockGetInt :: MonadStore Int + + return $ GC.Result paths freed + +optimiseStore :: MonadStore () +optimiseStore = void $ simpleOp OptimiseStore + +-- returns True on errors +verifyStore :: CheckFlag -> RepairFlag -> MonadStore Bool +verifyStore check repair = simpleOpArgs VerifyStore $ do + putBool check + putBool repair + +addSignatures :: Path -> [LBS.ByteString] -> MonadStore () +addSignatures p signatures = void $ simpleOpArgs AddSignatures $ do + putPath p + putByteStrings signatures + +-- TODO: +queryMissing :: PathSet -> MonadStore (PathSet, PathSet, PathSet, Integer, Integer) +queryMissing ps = undefined -- willBuild willSubstitute unknown downloadSize narSize + + diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs new file mode 100644 index 00000000..36648453 --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs @@ -0,0 +1,60 @@ +module System.Nix.Store.Remote.Logger ( + Logger(..) + , Field(..) + , processOutput) + where + +import Control.Monad.Reader (ask, liftIO) +import Data.Binary.Get + +import Network.Socket.ByteString (recv) + +import System.Nix.Store.Remote.Types +import System.Nix.Util + +controlParser :: Get Logger +controlParser = do + ctrl <- getInt + case (ctrl :: Int) of + 0x6f6c6d67 -> Next <$> getByteStringLen + 0x64617461 -> Read <$> getInt + 0x64617416 -> Write <$> getByteStringLen + 0x616c7473 -> pure Last + 0x63787470 -> flip Error <$> getByteStringLen <*> getInt + 0x53545254 -> StartActivity <$> getInt <*> getInt <*> getInt <*> getByteStringLen <*> getFields <*> getInt + 0x53544f50 -> StopActivity <$> getInt + 0x52534c54 -> Result <$> getInt <*> getInt <*> getFields + x -> fail $ "Invalid control message received:" ++ show x + +processOutput :: MonadStore [Logger] +processOutput = go decoder + where decoder = runGetIncremental controlParser + go :: Decoder Logger -> MonadStore [Logger] + go (Done _leftover _consumed ctrl) = do + case ctrl of + e@(Error _ _) -> return [e] + Last -> return [Last] + -- we should probably handle Read here as well + x -> do + next <- go decoder + return $ x:next + go (Partial k) = do + soc <- ask + chunk <- liftIO (Just <$> recv soc 8) + go (k chunk) + + go (Fail _leftover _consumed msg) = do + error msg + +getFields :: Get [Field] +getFields = do + cnt <- getInt + sequence $ replicate cnt getField + +getField :: Get Field +getField = do + typ <- getInt + case (typ :: Int) of + 0 -> LogInt <$> getInt + 1 -> LogStr <$> getByteStringLen + x -> fail $ "Unknown log type: " ++ show x diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs new file mode 100644 index 00000000..920868ac --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs @@ -0,0 +1,155 @@ +module System.Nix.Store.Remote.Protocol ( + WorkerOp(..) + , simpleOp + , simpleOpArgs + , runOp + , runOpArgs + , runStore) where + +import Control.Exception (bracket) +import Control.Monad.Reader +import Control.Monad.State + +import Data.Binary.Get +import Data.Binary.Put +import qualified Data.ByteString.Lazy as LBS + +import Network.Socket hiding (send, sendTo, recv, recvFrom) +import Network.Socket.ByteString (recv) + +import System.Nix.Store.Remote.Logger +import System.Nix.Store.Remote.Types +import System.Nix.Store.Remote.Util +import System.Nix.Util + +protoVersion :: Int +protoVersion = 0x115 +-- major protoVersion & 0xFF00 +-- minor .. & 0x00FF + +workerMagic1 :: Int +workerMagic1 = 0x6e697863 +workerMagic2 :: Int +workerMagic2 = 0x6478696f + +sockPath :: String +sockPath = "/nix/var/nix/daemon-socket/socket" + +data WorkerOp = + IsValidPath + | HasSubstitutes + | QueryReferrers + | AddToStore + | AddTextToStore + | BuildPaths + | EnsurePath + | AddTempRoot + | AddIndirectRoot + | SyncWithGC + | FindRoots + | SetOptions + | CollectGarbage + | QuerySubstitutablePathInfo + | QueryDerivationOutputs + | QueryAllValidPaths + | QueryFailedPaths + | ClearFailedPaths + | QueryPathInfo + | QueryDerivationOutputNames + | QueryPathFromHashPart + | QuerySubstitutablePathInfos + | QueryValidPaths + | QuerySubstitutablePaths + | QueryValidDerivers + | OptimiseStore + | VerifyStore + | BuildDerivation + | AddSignatures + | NarFromPath + | AddToStoreNar + | QueryMissing + deriving (Eq, Ord, Show) + +opNum :: WorkerOp -> Int +opNum IsValidPath = 1 +opNum HasSubstitutes = 3 +opNum QueryReferrers = 6 +opNum AddToStore = 7 +opNum AddTextToStore = 8 +opNum BuildPaths = 9 +opNum EnsurePath = 10 +opNum AddTempRoot = 11 +opNum AddIndirectRoot = 12 +opNum SyncWithGC = 13 +opNum FindRoots = 14 +opNum SetOptions = 19 +opNum CollectGarbage = 20 +opNum QuerySubstitutablePathInfo = 21 +opNum QueryDerivationOutputs = 22 +opNum QueryAllValidPaths = 23 +opNum QueryFailedPaths = 24 +opNum ClearFailedPaths = 25 +opNum QueryPathInfo = 26 +opNum QueryDerivationOutputNames = 28 +opNum QueryPathFromHashPart = 29 +opNum QuerySubstitutablePathInfos = 30 +opNum QueryValidPaths = 31 +opNum QuerySubstitutablePaths = 32 +opNum QueryValidDerivers = 33 +opNum OptimiseStore = 34 +opNum VerifyStore = 35 +opNum BuildDerivation = 36 +opNum AddSignatures = 37 +opNum NarFromPath = 38 +opNum AddToStoreNar = 39 +opNum QueryMissing = 40 + + +simpleOp :: WorkerOp -> MonadStore Bool +simpleOp op = do + simpleOpArgs op $ return () + +simpleOpArgs :: WorkerOp -> Put -> MonadStore Bool +simpleOpArgs op args = do + runOpArgs op args + err <- gotError + case err of + True -> return False -- XXX: ErrorT? + False -> do + sockGetBool + +runOp :: WorkerOp -> MonadStore () +runOp op = runOpArgs op $ return () + +runOpArgs :: WorkerOp -> Put -> MonadStore () +runOpArgs op args = do + sockPut $ do + putInt $ opNum op + args + + out <- processOutput + put out + +runStore :: MonadStore a -> IO (a, [Logger]) +runStore code = do + bracket (open sockPath) close run + where + open path = do + soc <- socket AF_UNIX Stream 0 + connect soc (SockAddrUnix path) + return soc + greet = do + sockPut $ putInt workerMagic1 + soc <- ask + vermagic <- liftIO $ recv soc 16 + let (magic2, daemonProtoVersion) = flip runGet (LBS.fromStrict vermagic) $ (,) <$> getInt <*> getInt + unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch" + + sockPut $ putInt protoVersion -- clientVersion + sockPut $ putInt (0 :: Int) -- affinity + sockPut $ putInt (0 :: Int) -- obsolete reserveSpace + + processOutput + + run sock = + flip runReaderT sock $ flip runStateT [] (greet >> code) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs new file mode 100644 index 00000000..0a46a79b --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs @@ -0,0 +1,40 @@ +module System.Nix.Store.Remote.Types ( + MonadStore + , Logger(..) + , Field(..) + , gotError) where + + +import qualified Data.ByteString.Lazy as LBS +import Network.Socket (Socket) +import Control.Monad.Reader +import Control.Monad.State + +type MonadStore a = StateT [Logger] (ReaderT Socket IO) a + +type ActivityID = Int +type ActivityParentID = Int +type ActivityType = Int +type Verbosity = Int +type ResultType = Int + +data Field = LogStr LBS.ByteString | LogInt Int + deriving (Eq, Ord, Show) + +data Logger = + Next LBS.ByteString + | Read Int -- data needed from source + | Write LBS.ByteString -- data for sink + | Last + | Error Int LBS.ByteString + | StartActivity ActivityID Verbosity ActivityType LBS.ByteString [Field] ActivityParentID + | StopActivity ActivityID + | Result ActivityID ResultType [Field] + deriving (Eq, Ord, Show) + +isError :: Logger -> Bool +isError (Error _ _) = True +isError _ = False + +gotError :: MonadStore Bool +gotError = any isError <$> get diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs new file mode 100644 index 00000000..beac1066 --- /dev/null +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs @@ -0,0 +1,100 @@ +module System.Nix.Store.Remote.Util where + +import Control.Monad.Reader + +import Data.Maybe +import Data.Binary.Get +import Data.Binary.Put +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Lazy as LBS +import qualified Data.HashSet as HashSet + +import Network.Socket.ByteString (recv, sendAll) + +import System.Nix.Store.Remote.Types +import System.Nix.Path +import System.Nix.Util + +import Crypto.Hash + +genericIncremental :: (MonadIO m) => m (Maybe B.ByteString) -> Get a -> m a +genericIncremental getsome parser = go decoder + where decoder = runGetIncremental parser + go (Done _leftover _consumed x) = do + return x + go (Partial k) = do + chunk <- getsome + go (k chunk) + go (Fail _leftover _consumed msg) = do + error msg + +getSocketIncremental :: Get a -> MonadStore a +getSocketIncremental = genericIncremental sockGet + +sockPut :: Put -> MonadStore () +sockPut p = do + soc <- ask + liftIO $ sendAll soc $ LBS.toStrict $ runPut p + +sockGet :: MonadStore (Maybe BSC.ByteString) +sockGet = do + soc <- ask + liftIO $ Just <$> recv soc 8 + +sockGetPath :: MonadStore (Maybe Path) +sockGetPath = getSocketIncremental getPath + +sockGetPaths :: MonadStore PathSet +sockGetPaths = getSocketIncremental getPaths + +sockGetInt :: Integral a => MonadStore a +sockGetInt = getSocketIncremental getInt + +sockGetBool :: MonadStore Bool +sockGetBool = (== (1 :: Int)) <$> sockGetInt + +sockGetStr :: MonadStore LBS.ByteString +sockGetStr = getSocketIncremental getByteStringLen + +sockGetStrings :: MonadStore [LBS.ByteString] +sockGetStrings = getSocketIncremental getByteStrings + +lBSToText :: LBS.ByteString -> Text +lBSToText = T.pack . BSC.unpack . LBS.toStrict + +textToLBS :: Text -> LBS.ByteString +textToLBS = LBS.fromStrict . BSC.pack . T.unpack + +-- XXX: needs work +mkPath :: LBS.ByteString -> Maybe Path +mkPath p = case (pathName $ lBSToText p) of + Just x -> Just $ Path (hash $ LBS.toStrict p) x --XXX: hash + Nothing -> Nothing + +-- WOOT +-- import Data.ByteString.Base32 as Base32 +--drvP = Path (fromJust $ digestFromByteString $ pls $ Base32.decode $ BSC.take 32 $ BSC.drop (BSC.length "/nix/store/") drv) (fromJust $ pathName $ T.pack $ BSC.unpack drv) +--pls (Left _) = error "unable to decode hash" +--pls (Right x) = x + +getPath :: Get (Maybe Path) +getPath = mkPath <$> getByteStringLen + +getPaths :: Get PathSet +getPaths = HashSet.fromList . catMaybes . map mkPath <$> getByteStrings + +putPathName :: PathName -> Put +putPathName = putByteStringLen . textToLBS . pathNameContents + +putPath :: Path -> Put +putPath (Path _hash name) = putPathName name + +putPaths :: PathSet -> Put +putPaths = putByteStrings . HashSet.map (\(Path _hash name) -> textToLBS $ pathNameContents name) + +putBool :: Bool -> Put +putBool True = putInt (1 :: Int) +putBool False = putInt (0 :: Int) From be8311f4b96e59c7c471ac0778e932d6bbe4801b Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Mon, 16 Jul 2018 09:12:34 +0200 Subject: [PATCH 3/7] add cabal.project --- cabal.project | 1 + 1 file changed, 1 insertion(+) create mode 100644 cabal.project diff --git a/cabal.project b/cabal.project new file mode 100644 index 00000000..cbe7dc7d --- /dev/null +++ b/cabal.project @@ -0,0 +1 @@ +packages: ./hnix-store-core/*.cabal ./hnix-store-remote/*.cabal From a01bff9eb85a030ee98a17399dfc41bf92d7e302 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Tue, 17 Jul 2018 10:03:08 +0200 Subject: [PATCH 4/7] squash! hnix-store-remote prototype add missing Util --- hnix-store-remote/hnix-store-remote.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index ee2fde3c..be6d02ad 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -18,6 +18,7 @@ library , System.Nix.Store.Remote.Logger , System.Nix.Store.Remote.Protocol , System.Nix.Store.Remote.Types + , System.Nix.Store.Remote.Util build-depends: base >=4.10 && <4.11 , bytestring From b8354d8b422c6658ec1bba360b01a06c8b408343 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Tue, 17 Jul 2018 10:05:17 +0200 Subject: [PATCH 5/7] squash! hnix-store-remote prototype use ExceptT, concat logs, utility log functions --- .../src/System/Nix/Store/Remote/Protocol.hs | 16 ++++++++++++---- .../src/System/Nix/Store/Remote/Types.hs | 17 +++++++++++++++-- 2 files changed, 27 insertions(+), 6 deletions(-) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs index 920868ac..2c39858e 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Protocol.hs @@ -7,11 +7,13 @@ module System.Nix.Store.Remote.Protocol ( , runStore) where import Control.Exception (bracket) +import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State import Data.Binary.Get import Data.Binary.Put +import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as LBS import Network.Socket hiding (send, sendTo, recv, recvFrom) @@ -114,7 +116,9 @@ simpleOpArgs op args = do runOpArgs op args err <- gotError case err of - True -> return False -- XXX: ErrorT? + True -> do + Error _num msg <- head <$> getError + throwError $ BSC.unpack $ LBS.toStrict msg False -> do sockGetBool @@ -128,9 +132,13 @@ runOpArgs op args = do args out <- processOutput - put out + modify (++out) + err <- gotError + when err $ do + Error _num msg <- head <$> getError + throwError $ BSC.unpack $ LBS.toStrict msg -runStore :: MonadStore a -> IO (a, [Logger]) +runStore :: MonadStore a -> IO (Either String a, [Logger]) runStore code = do bracket (open sockPath) close run where @@ -152,4 +160,4 @@ runStore code = do processOutput run sock = - flip runReaderT sock $ flip runStateT [] (greet >> code) + flip runReaderT sock $ flip runStateT [] $ runExceptT (greet >> code) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs index 0a46a79b..eb2520cd 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types.hs @@ -2,15 +2,19 @@ module System.Nix.Store.Remote.Types ( MonadStore , Logger(..) , Field(..) - , gotError) where + , getLog + , flushLog + , gotError + , getError) where import qualified Data.ByteString.Lazy as LBS import Network.Socket (Socket) +import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State -type MonadStore a = StateT [Logger] (ReaderT Socket IO) a +type MonadStore a = ExceptT String (StateT [Logger] (ReaderT Socket IO)) a type ActivityID = Int type ActivityParentID = Int @@ -38,3 +42,12 @@ isError _ = False gotError :: MonadStore Bool gotError = any isError <$> get + +getError :: MonadStore [Logger] +getError = filter isError <$> get + +getLog :: MonadStore [Logger] +getLog = get + +flushLog :: MonadStore () +flushLog = put [] From cf51ba3b391266ad344caeb35ec169a063e8dfc1 Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Tue, 17 Jul 2018 11:15:21 +0200 Subject: [PATCH 6/7] temp: add hnix-store-temporary-live-test --- hnix-store-remote/app/Main.hs | 67 +++++++++++++++++++++++ hnix-store-remote/hnix-store-remote.cabal | 11 ++++ 2 files changed, 78 insertions(+) create mode 100644 hnix-store-remote/app/Main.hs diff --git a/hnix-store-remote/app/Main.hs b/hnix-store-remote/app/Main.hs new file mode 100644 index 00000000..70d1be0e --- /dev/null +++ b/hnix-store-remote/app/Main.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} +import qualified Data.ByteString.Lazy as LBS +import qualified Data.HashSet as HS +import qualified System.Nix.GC as GC +import System.Nix.Store.Remote +import System.Nix.Store.Remote.Util +import Data.Maybe +import Control.Monad.Reader + +import Text.Pretty.Simple + +noSuchPath = fromJust $ mkPath "blah" + +main = do + x <- runStore $ do + syncWithGC + + verifyStore False False + + (Just path) <- addTextToStore "hnix-store" "test" (HS.fromList []) False + + valid <- isValidPathUncached path + case valid of + True -> do + info <- queryPathInfoUncached path + return (path, info) + _ -> error "shouldn't happen" + + pPrint x + case x of + (Left err, log) -> putStrLn err >> print log + (Right (path, pathinfo), log) -> do + gcres <- runStore $ do + collectGarbage $ GC.Options + { GC.operation = GC.DeleteSpecific + , GC.pathsToDelete = HS.fromList [path] + , GC.ignoreLiveness = False + -- XXX: this breaks stuff - we don't get Last, + -- only a message with limit reached, stopping.. + -- + -- gcDeleteSpecific and options.maxFreed + -- are two distinct branches in + -- nix/src/libstore.gc + -- so maybe this combination is not supported + --, GC.maxFreed = 1000 + , GC.maxFreed = -1 + } + + pPrint gcres + + -- test ExceptT + e <- runStore $ do + isValidPathUncached $ noSuchPath + + pPrint e + + {- + e <- runStore $ do + queryPathInfoUncached $ noSuchPath + + pPrint e + -} + + --res <- queryDerivationOutputs drvP + --liftIO $ print res + --res <- findRoots + --liftIO $ pPrint res diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal index be6d02ad..d3deca18 100644 --- a/hnix-store-remote/hnix-store-remote.cabal +++ b/hnix-store-remote/hnix-store-remote.cabal @@ -39,3 +39,14 @@ library hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall + +executable hnix-store-temporary-live-test + main-is: Main.hs + hs-source-dirs: app + build-depends: base + , mtl + , bytestring + , hnix-store-core + , hnix-store-remote + , unordered-containers + , pretty-simple From d5eb32e5d9bba387431a7a2e28f0b655b3e3e32d Mon Sep 17 00:00:00 2001 From: Richard Marko Date: Tue, 17 Jul 2018 11:21:50 +0200 Subject: [PATCH 7/7] squash! hnix-store-remote prototype drop ExceptT todo --- hnix-store-remote/src/System/Nix/Store/Remote.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index c5c0e139..31419631 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -53,9 +53,6 @@ type CheckFlag = Bool type CheckSigsFlag = Bool type SubstituteFlag = Bool --- TODO: error handling via ErrorT, some of these will just log Error, --- which means we need to bail out and not wait for results --- --setOptions :: StoreSetting -> MonadStore () isValidPathUncached :: Path -> MonadStore Bool