mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
hnix-store-db: init
This commit is contained in:
parent
a056181d7e
commit
4ce09d7650
@ -1,10 +1,14 @@
|
||||
packages:
|
||||
./hnix-store-core/hnix-store-core.cabal
|
||||
./hnix-store-db/hnix-store-db.cabal
|
||||
./hnix-store-remote/hnix-store-remote.cabal
|
||||
|
||||
-- till https://github.com/obsidiansystems/dependent-sum/pull/80
|
||||
allow-newer:
|
||||
dependent-sum:some
|
||||
|
||||
package hnix-store-db
|
||||
flags: +build-readme +build-bench
|
||||
|
||||
package hnix-store-remote
|
||||
flags: +build-readme +io-testsuite
|
||||
|
@ -3,5 +3,8 @@ tests: True
|
||||
package hnix-store-core
|
||||
ghc-options: -Wunused-packages -Wall -Werror
|
||||
|
||||
package hnix-store-db
|
||||
ghc-options: -Wunused-packages -Wall -Werror
|
||||
|
||||
package hnix-store-remote
|
||||
ghc-options: -Wunused-packages -Wall -Werror
|
||||
|
@ -21,6 +21,7 @@ let
|
||||
in {
|
||||
inherit (haskellPackages)
|
||||
hnix-store-core
|
||||
hnix-store-db
|
||||
hnix-store-remote;
|
||||
haskellPackages = lib.dontRecurseIntoAttrs haskellPackages;
|
||||
pkgs = lib.dontRecurseIntoAttrs pkgs;
|
||||
|
3
hnix-store-db/CHANGELOG.md
Normal file
3
hnix-store-db/CHANGELOG.md
Normal file
@ -0,0 +1,3 @@
|
||||
# Unreleased 202y-mm-dd
|
||||
|
||||
* First version.
|
201
hnix-store-db/LICENSE
Normal file
201
hnix-store-db/LICENSE
Normal file
@ -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.
|
1
hnix-store-db/README.lhs
Symbolic link
1
hnix-store-db/README.lhs
Symbolic link
@ -0,0 +1 @@
|
||||
README.md
|
82
hnix-store-db/README.md
Normal file
82
hnix-store-db/README.md
Normal file
@ -0,0 +1,82 @@
|
||||
# hnix-store-db
|
||||
|
||||
[Nix] SQLite database implementation.
|
||||
|
||||
Only read-only functionality provided for
|
||||
database schema version `10`.
|
||||
|
||||
[Nix]: https://nixos.org/nix
|
||||
|
||||
## API
|
||||
|
||||
The interface is experimental and might change wildly.
|
||||
|
||||
[System.Nix.Store.DB.Query]: ./src/System/Nix/Store/DB/Query.hs
|
||||
[System.Nix.Store.DB.Run]: ./src/System/Nix/Store/DB/Run.hs
|
||||
[System.Nix.Store.DB.Schema]: ./src/System/Nix/Store/DB/Schema.hs
|
||||
|
||||
## Example
|
||||
|
||||
This example is runnable via `cabal run db-readme`.
|
||||
|
||||
```haskell
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import Data.Default.Class (Default(def))
|
||||
|
||||
import qualified Control.Monad
|
||||
import qualified Control.Monad.IO.Class
|
||||
|
||||
import qualified Database.Esqueleto.Experimental
|
||||
|
||||
import qualified System.Nix.StorePath
|
||||
import qualified System.Nix.Store.DB.Run
|
||||
import qualified System.Nix.Store.DB.Schema
|
||||
|
||||
import System.Nix.Store.DB.Query
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
System.Nix.Store.DB.Run.runSystemSqlite $ do
|
||||
(paths, refs, drvOuts) <- queryEverything
|
||||
|
||||
Control.Monad.IO.Class.liftIO $ do
|
||||
putStrLn $ "Stats: "
|
||||
let stat name v = putStrLn $ "- " ++ name ++ ": " ++ show (length v)
|
||||
stat "ValidPath(s)" paths
|
||||
stat "Ref(s)" refs
|
||||
stat "DerivationOutput(s)" drvOuts
|
||||
|
||||
maybeValidPath <- queryOneValidDerivationEntity
|
||||
case maybeValidPath of
|
||||
Nothing -> pure ()
|
||||
Just validPathEntity -> do
|
||||
let pth =
|
||||
System.Nix.Store.DB.Schema.validPathPath
|
||||
$ Database.Esqueleto.Experimental.entityVal validPathEntity
|
||||
|
||||
(same, samePath, references, referrers, validDerivers, outputs) <- (,,,,,)
|
||||
<$> queryPathInfo pth
|
||||
<*> queryPathFromHashPart def (System.Nix.StorePath.storePathHash pth)
|
||||
<*> queryReferences validPathEntity
|
||||
<*> queryReferrers pth
|
||||
<*> queryValidDerivers pth
|
||||
<*> queryDerivationOutputs validPathEntity
|
||||
|
||||
Control.Monad.unless (same == Just (Database.Esqueleto.Experimental.entityVal validPathEntity))
|
||||
$ error "queryPathInfo failed to roundtrip"
|
||||
Control.Monad.unless (samePath == Just pth)
|
||||
$ error "queryPathFromHashPart failed to roundtrip"
|
||||
|
||||
Control.Monad.IO.Class.liftIO $ do
|
||||
putStrLn $ "References: "
|
||||
print references
|
||||
putStrLn $ "Referrers: "
|
||||
print referrers
|
||||
putStrLn $ "Valid derivers: "
|
||||
print validDerivers
|
||||
putStrLn $ "Derivation outputs: "
|
||||
print outputs
|
||||
|
||||
pure ()
|
||||
```
|
6
hnix-store-db/apps/Bench.hs
Normal file
6
hnix-store-db/apps/Bench.hs
Normal file
@ -0,0 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import qualified System.Nix.Store.DB.Run
|
||||
|
||||
main :: IO ()
|
||||
main = System.Nix.Store.DB.Run.bench
|
125
hnix-store-db/hnix-store-db.cabal
Normal file
125
hnix-store-db/hnix-store-db.cabal
Normal file
@ -0,0 +1,125 @@
|
||||
cabal-version: 2.2
|
||||
name: hnix-store-db
|
||||
version: 0.1.0.0
|
||||
synopsis: Nix store database support
|
||||
description: Implementation of the nix store database
|
||||
homepage: https://github.com/haskell-nix/hnix-store
|
||||
license: Apache-2.0
|
||||
license-file: LICENSE
|
||||
author: Richard Marko
|
||||
maintainer: srk@48.io
|
||||
copyright: 2023 Richard Marko
|
||||
category: Nix
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
CHANGELOG.md
|
||||
, README.md
|
||||
, README.lhs
|
||||
|
||||
flag build-bench
|
||||
default:
|
||||
False
|
||||
description:
|
||||
Build db-bench executable
|
||||
|
||||
flag build-readme
|
||||
default:
|
||||
False
|
||||
description:
|
||||
Build README.lhs example
|
||||
|
||||
common commons
|
||||
ghc-options: -Wall -Wunused-packages
|
||||
default-extensions:
|
||||
OverloadedStrings
|
||||
, DataKinds
|
||||
, DeriveGeneric
|
||||
, DeriveDataTypeable
|
||||
, DeriveFunctor
|
||||
, DeriveFoldable
|
||||
, DeriveTraversable
|
||||
, DeriveLift
|
||||
, DerivingStrategies
|
||||
, FlexibleContexts
|
||||
, FlexibleInstances
|
||||
, GADTs
|
||||
, GeneralizedNewtypeDeriving
|
||||
, RecordWildCards
|
||||
, ScopedTypeVariables
|
||||
, StandaloneDeriving
|
||||
, TypeApplications
|
||||
, TypeFamilies
|
||||
, TypeOperators
|
||||
, TypeSynonymInstances
|
||||
, InstanceSigs
|
||||
, MultiParamTypeClasses
|
||||
, TupleSections
|
||||
, LambdaCase
|
||||
, BangPatterns
|
||||
, ViewPatterns
|
||||
default-language: Haskell2010
|
||||
|
||||
library
|
||||
import: commons
|
||||
hs-source-dirs: src
|
||||
exposed-modules:
|
||||
System.Nix.Store.DB
|
||||
, System.Nix.Store.DB.Query
|
||||
, System.Nix.Store.DB.Instances
|
||||
, System.Nix.Store.DB.Run
|
||||
, System.Nix.Store.DB.Schema
|
||||
, System.Nix.Store.DB.Util
|
||||
|
||||
build-depends:
|
||||
base >=4.10 && <5
|
||||
, attoparsec
|
||||
, bytestring
|
||||
, bytestring
|
||||
, data-default-class
|
||||
, text
|
||||
, time
|
||||
, hnix-store-core
|
||||
, esqueleto >= 3.5.10 && < 3.6
|
||||
, persistent >= 2.14.5 && < 2.15
|
||||
, persistent-sqlite >= 2.13.1 && < 2.14
|
||||
, template-haskell
|
||||
, monad-logger
|
||||
, microlens
|
||||
, fast-logger
|
||||
, transformers
|
||||
, unliftio-core
|
||||
|
||||
executable db-readme
|
||||
if !flag(build-readme)
|
||||
buildable: False
|
||||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, data-default-class
|
||||
, esqueleto
|
||||
, hnix-store-core
|
||||
, hnix-store-db
|
||||
build-tool-depends:
|
||||
markdown-unlit:markdown-unlit
|
||||
default-language: Haskell2010
|
||||
main-is: README.lhs
|
||||
ghc-options: -pgmL markdown-unlit -Wall
|
||||
|
||||
executable db-bench
|
||||
if !flag(build-bench)
|
||||
buildable: False
|
||||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, hnix-store-db
|
||||
default-language: Haskell2010
|
||||
hs-source-dirs: apps
|
||||
main-is: Bench.hs
|
||||
ghc-options: -Wall
|
||||
|
||||
test-suite db
|
||||
import: commons
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Smoke.hs
|
||||
hs-source-dirs: tests
|
||||
build-depends:
|
||||
base
|
||||
, hnix-store-db
|
9
hnix-store-db/src/System/Nix/Store/DB.hs
Normal file
9
hnix-store-db/src/System/Nix/Store/DB.hs
Normal file
@ -0,0 +1,9 @@
|
||||
module System.Nix.Store.DB (
|
||||
module System.Nix.Store.DB.Query
|
||||
, module System.Nix.Store.DB.Run
|
||||
, module System.Nix.Store.DB.Schema
|
||||
) where
|
||||
|
||||
import System.Nix.Store.DB.Query
|
||||
import System.Nix.Store.DB.Run
|
||||
import System.Nix.Store.DB.Schema
|
87
hnix-store-db/src/System/Nix/Store/DB/Instances.hs
Normal file
87
hnix-store-db/src/System/Nix/Store/DB/Instances.hs
Normal file
@ -0,0 +1,87 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module System.Nix.Store.DB.Instances where
|
||||
|
||||
import Database.Persist (PersistField(..), PersistValue(..), SqlType(..))
|
||||
import Database.Persist.Sql (PersistFieldSql(..))
|
||||
|
||||
import Data.Time (UTCTime)
|
||||
import Data.Default.Class (Default(def))
|
||||
|
||||
import System.Nix.ContentAddress (ContentAddress)
|
||||
import System.Nix.StorePath (StorePath)
|
||||
import System.Nix.StorePath.Metadata (StorePathTrust(..))
|
||||
|
||||
import qualified Data.Attoparsec.Text
|
||||
import qualified Data.Bifunctor
|
||||
import qualified Data.Text
|
||||
import qualified Data.Time.Clock.POSIX
|
||||
|
||||
import qualified System.Nix.ContentAddress
|
||||
import qualified System.Nix.StorePath
|
||||
|
||||
instance PersistField StorePath where
|
||||
toPersistValue = PersistText . System.Nix.StorePath.storePathToText def
|
||||
fromPersistValue (PersistText t) = either
|
||||
(Left . Data.Text.pack)
|
||||
Right
|
||||
$ Data.Attoparsec.Text.parseOnly
|
||||
(System.Nix.StorePath.pathParser def)
|
||||
t
|
||||
fromPersistValue wrongValue = Left
|
||||
$ "Received "
|
||||
<> (Data.Text.pack $ show wrongValue)
|
||||
<> " when a value of type PersistText was expected."
|
||||
|
||||
instance PersistFieldSql StorePath where
|
||||
sqlType _ = SqlString
|
||||
|
||||
instance PersistField StorePathTrust where
|
||||
toPersistValue BuiltLocally = PersistInt64 1
|
||||
toPersistValue BuiltElsewhere = PersistNull
|
||||
|
||||
fromPersistValue (PersistInt64 1) = pure BuiltLocally
|
||||
fromPersistValue PersistNull = pure BuiltElsewhere
|
||||
fromPersistValue wrongValue = Left
|
||||
$ "Received "
|
||||
<> (Data.Text.pack $ show wrongValue)
|
||||
<> " when a value of type PersistNull"
|
||||
<> " or (PersistInt64 1) was expected."
|
||||
|
||||
instance PersistFieldSql StorePathTrust where
|
||||
sqlType _ = SqlInt64
|
||||
|
||||
newtype NixUTCTime = NixUTCTime UTCTime
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
instance PersistField NixUTCTime where
|
||||
toPersistValue (NixUTCTime u) = PersistInt64
|
||||
$ round $ Data.Time.Clock.POSIX.utcTimeToPOSIXSeconds u
|
||||
fromPersistValue (PersistInt64 i) = pure $ NixUTCTime
|
||||
$ Data.Time.Clock.POSIX.posixSecondsToUTCTime $ fromIntegral i
|
||||
fromPersistValue wrongValue = Left
|
||||
$ "Received "
|
||||
<> (Data.Text.pack $ show wrongValue)
|
||||
<> " when a value of (PersistInt64 _) was expected."
|
||||
|
||||
instance PersistFieldSql NixUTCTime where
|
||||
sqlType _ = SqlInt64
|
||||
|
||||
instance PersistField ContentAddress where
|
||||
toPersistValue =
|
||||
PersistText
|
||||
. System.Nix.ContentAddress.buildContentAddress
|
||||
|
||||
fromPersistValue (PersistText t) =
|
||||
Data.Bifunctor.first (\e -> error $ show (e, t))
|
||||
$ System.Nix.ContentAddress.parseContentAddress t
|
||||
fromPersistValue wrongValue = Left
|
||||
$ "Received "
|
||||
<> (Data.Text.pack $ show wrongValue)
|
||||
<> " when a value of type PersistText was expected."
|
||||
|
||||
instance PersistFieldSql ContentAddress where
|
||||
sqlType _ = SqlString
|
308
hnix-store-db/src/System/Nix/Store/DB/Query.hs
Normal file
308
hnix-store-db/src/System/Nix/Store/DB/Query.hs
Normal file
@ -0,0 +1,308 @@
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
|
||||
module System.Nix.Store.DB.Query
|
||||
( queryPathInfoEntity
|
||||
, queryPathInfo
|
||||
, queryReferencesEntity
|
||||
, queryReferences
|
||||
, queryReferrersEntity
|
||||
, queryReferrers
|
||||
, queryValidDerivers
|
||||
, queryDerivationOutputs
|
||||
, queryPathFromHashPart
|
||||
, queryValidPathsEntity
|
||||
, queryValidPaths
|
||||
-- * Testing
|
||||
, queryAllRefsEntity
|
||||
, queryAllRefs
|
||||
, queryAllDerivationOutputsEntity
|
||||
, queryAllDerivationOutputs
|
||||
, queryOneValidDerivationEntity
|
||||
, queryOneValidDerivation
|
||||
, queryEverything
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Monad.Logger (MonadLogger)
|
||||
import Data.Text (Text)
|
||||
import Database.Esqueleto.Experimental
|
||||
import System.Nix.StorePath (StoreDir, StorePath, StorePathHashPart)
|
||||
import System.Nix.Store.DB.Schema
|
||||
|
||||
import qualified Data.ByteString.Char8
|
||||
import qualified Data.Maybe
|
||||
import qualified Data.Text
|
||||
import qualified System.Nix.StorePath
|
||||
import qualified System.Nix.StorePath.Metadata
|
||||
|
||||
-- * Queries
|
||||
|
||||
-- | Query @Entity ValidPath@ for @StorePath@ if it exists.
|
||||
queryPathInfoEntity
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> StorePath
|
||||
-> SqlReadT m (Maybe (Entity ValidPath))
|
||||
queryPathInfoEntity path = do
|
||||
res <- select $ do
|
||||
validPaths <- from $ table @ValidPath
|
||||
where_ (validPaths ^. ValidPathPath ==. val path)
|
||||
pure validPaths
|
||||
pure $ Data.Maybe.listToMaybe res
|
||||
|
||||
-- | Query @ValidPath@ for @StorePath@ if it exists.
|
||||
queryPathInfo
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> StorePath
|
||||
-> SqlReadT m (Maybe ValidPath)
|
||||
queryPathInfo sp =
|
||||
-- this is expanded from >>= pure $ (fmap . fmap) entityVal
|
||||
-- to make older GHCs (like 9.0.2) happy
|
||||
queryPathInfoEntity sp >>= \case
|
||||
Nothing -> pure Nothing
|
||||
Just evp -> pure $ Just (entityVal evp)
|
||||
|
||||
-- | Query references as a list of @Entity Ref@s for @ValidPath@
|
||||
-- using id of @Entity ValidPath@
|
||||
queryReferencesEntity
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> Entity ValidPath
|
||||
-> SqlReadT m [Entity Ref]
|
||||
queryReferencesEntity referrer =
|
||||
select $ do
|
||||
(refs :& _validPaths) <-
|
||||
from $ table @Ref
|
||||
`innerJoin` table @ValidPath
|
||||
`on` (\(refs :& validPaths) ->
|
||||
refs ^. RefReference ==. validPaths ^. ValidPathId)
|
||||
where_ (refs ^. RefReferrer ==. val (entityKey referrer))
|
||||
pure refs
|
||||
|
||||
-- | Query references as a list of @Ref@s for @ValidPath@
|
||||
-- by id of @Entity ValidPath@
|
||||
queryReferences
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> Entity ValidPath
|
||||
-> SqlReadT m [Ref]
|
||||
queryReferences evp = do
|
||||
queryReferencesEntity evp >>= pure . fmap entityVal
|
||||
|
||||
-- | Query referrers as a list of @Entity Ref@s for @StorePath@
|
||||
queryReferrersEntity
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> StorePath
|
||||
-> SqlReadT m [Entity Ref]
|
||||
queryReferrersEntity path = do
|
||||
select $ do
|
||||
(refs :& _validPaths) <-
|
||||
from $ table @Ref
|
||||
`innerJoin` table @ValidPath
|
||||
`on` (\(refs :& validPaths) ->
|
||||
(refs ^. RefReference ==. validPaths ^. ValidPathId))
|
||||
where_
|
||||
(
|
||||
refs ^. RefReference
|
||||
`in_`
|
||||
(subList_select $ do
|
||||
validPaths <- from $ table @ValidPath
|
||||
where_ (validPaths ^. ValidPathPath ==. val path)
|
||||
pure $ validPaths ^. ValidPathId
|
||||
)
|
||||
)
|
||||
pure refs
|
||||
|
||||
-- | Query referrers as a list of @Ref@s for @StorePath@
|
||||
queryReferrers
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> StorePath
|
||||
-> SqlReadT m [Ref]
|
||||
queryReferrers sp =
|
||||
queryReferrersEntity sp
|
||||
>>= pure . (fmap entityVal)
|
||||
|
||||
-- | Query valid derivers as a list of @(Text, StorePath)@s
|
||||
-- for some @StorePath@
|
||||
queryValidDerivers
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> StorePath
|
||||
-> SqlReadT m [(Text, StorePath)]
|
||||
queryValidDerivers path = do
|
||||
res <- select $ do
|
||||
(drvOuts :& _validPaths) <-
|
||||
from $ table @DerivationOutput
|
||||
`innerJoin` table @ValidPath
|
||||
`on` (\(drvOuts :& validPaths) ->
|
||||
(drvOuts ^. DerivationOutputDrv ==. validPaths ^. ValidPathId))
|
||||
where_ (drvOuts ^. DerivationOutputPath ==. val path)
|
||||
pure (drvOuts ^. DerivationOutputName, drvOuts ^. DerivationOutputPath)
|
||||
|
||||
pure $ unValue2 <$> res
|
||||
|
||||
-- | Query derivation outputs as a list of @(Text, StorePath)@s
|
||||
-- for some @ValidPath@ by its id
|
||||
queryDerivationOutputs
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> Entity ValidPath
|
||||
-> SqlReadT m [(Text, StorePath)]
|
||||
queryDerivationOutputs drv = do
|
||||
res <- select $ do
|
||||
drvOuts <- from $ table @DerivationOutput
|
||||
where_ (drvOuts ^. DerivationOutputDrv ==. val (entityKey drv))
|
||||
pure (drvOuts ^. DerivationOutputName, drvOuts ^. DerivationOutputPath)
|
||||
|
||||
pure $ unValue2 <$> res
|
||||
|
||||
-- | Query @StorePath@ from its hash part
|
||||
queryPathFromHashPart
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> StoreDir
|
||||
-> StorePathHashPart
|
||||
-> SqlReadT m (Maybe StorePath)
|
||||
queryPathFromHashPart storeDir hp =
|
||||
let hashPart =
|
||||
( Data.Text.pack
|
||||
. Data.ByteString.Char8.unpack
|
||||
$ System.Nix.StorePath.unStoreDir storeDir
|
||||
)
|
||||
<> "/"
|
||||
<> System.Nix.StorePath.storePathHashPartToText hp
|
||||
in do
|
||||
-- We use rawSql here
|
||||
-- as otherwise, we would have to construct a @StorePath@
|
||||
-- to match the type of ValidPath.path, but the @StorePath@
|
||||
-- always includes name, so we would have to change
|
||||
-- the type of ValidPath.path to @Either StorePathHashPart StorePath@
|
||||
-- which isn't worth for a single query
|
||||
raw <- rawSql
|
||||
"select ?? from ValidPaths where path >= ? limit 1"
|
||||
[PersistText hashPart]
|
||||
pure
|
||||
$ Data.Maybe.listToMaybe
|
||||
$ validPathPath . entityVal
|
||||
<$> raw
|
||||
|
||||
-- | Query all valid paths as a list of @Entity ValidPath@s
|
||||
queryValidPathsEntity
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> SqlReadT m [Entity ValidPath]
|
||||
queryValidPathsEntity =
|
||||
select $ from $ table @ValidPath
|
||||
|
||||
-- | Query all valid paths as a list of @ValidPath@s
|
||||
queryValidPaths
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> SqlReadT m [ValidPath]
|
||||
queryValidPaths =
|
||||
queryValidPathsEntity
|
||||
>>= pure . fmap entityVal
|
||||
|
||||
-- * For testing
|
||||
|
||||
-- | Query all references as a list of @Entity Ref@s
|
||||
queryAllRefsEntity
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> SqlReadT m [Entity Ref]
|
||||
queryAllRefsEntity =
|
||||
select $ from $ table @Ref
|
||||
|
||||
-- | Query all references as a list of @Ref@s
|
||||
queryAllRefs
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> SqlReadT m [Ref]
|
||||
queryAllRefs =
|
||||
queryAllRefsEntity
|
||||
>>= pure . fmap entityVal
|
||||
|
||||
-- | Query all derivation outputs as a list of @Entity DerivationOutput@s
|
||||
queryAllDerivationOutputsEntity
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> SqlReadT m [Entity DerivationOutput]
|
||||
queryAllDerivationOutputsEntity =
|
||||
select $ from $ table @DerivationOutput
|
||||
|
||||
-- | Query all derivation outputs as a list of @DerivationOutput@s
|
||||
queryAllDerivationOutputs
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> SqlReadT m [DerivationOutput]
|
||||
queryAllDerivationOutputs =
|
||||
queryAllDerivationOutputsEntity
|
||||
>>= pure . fmap entityVal
|
||||
|
||||
-- | Query one random derivation as an @Entity ValidPath@
|
||||
queryOneValidDerivationEntity
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> SqlReadT m (Maybe (Entity ValidPath))
|
||||
queryOneValidDerivationEntity = do
|
||||
res <- select $ do
|
||||
validPath <- from $ table @ValidPath -- \validPath -> do
|
||||
where_
|
||||
(
|
||||
validPath ^. ValidPathUltimate
|
||||
==. (val $ Just System.Nix.StorePath.Metadata.BuiltLocally)
|
||||
)
|
||||
offset 100
|
||||
limit 1
|
||||
pure validPath
|
||||
|
||||
pure $ Data.Maybe.listToMaybe res
|
||||
|
||||
-- | Query one random derivation as a @ValidPath@
|
||||
queryOneValidDerivation
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> SqlReadT m (Maybe ValidPath)
|
||||
queryOneValidDerivation =
|
||||
queryOneValidDerivationEntity
|
||||
>>= pure . fmap entityVal
|
||||
|
||||
-- | Query everything
|
||||
queryEverything
|
||||
:: ( MonadIO m
|
||||
, MonadLogger m
|
||||
)
|
||||
=> SqlReadT m
|
||||
( [Entity ValidPath]
|
||||
, [Entity Ref]
|
||||
, [Entity DerivationOutput]
|
||||
)
|
||||
queryEverything = (,,)
|
||||
<$> queryValidPathsEntity
|
||||
<*> queryAllRefsEntity
|
||||
<*> queryAllDerivationOutputsEntity
|
||||
|
||||
-- * Utility
|
||||
|
||||
unValue2 :: (Value a, Value b) -> (a, b)
|
||||
unValue2 (a, b) = (unValue a, unValue b)
|
220
hnix-store-db/src/System/Nix/Store/DB/Run.hs
Normal file
220
hnix-store-db/src/System/Nix/Store/DB/Run.hs
Normal file
@ -0,0 +1,220 @@
|
||||
module System.Nix.Store.DB.Run
|
||||
( systemConnectionInfo
|
||||
, runSystemSqlite
|
||||
, memoryConnectionInfo
|
||||
, runInMemory
|
||||
, runCustom
|
||||
, runWithLogging
|
||||
, allMigrations
|
||||
, doMigrateAll
|
||||
, memTest
|
||||
, testMigrateAll
|
||||
, test
|
||||
, bench
|
||||
) where
|
||||
|
||||
import Control.Monad.Logger (LoggingT)
|
||||
import Control.Monad.Trans.Reader (ReaderT)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Monad.IO.Unlift (MonadUnliftIO)
|
||||
import Data.Default.Class (Default(def))
|
||||
import Data.Text (Text)
|
||||
import Database.Persist.Sql (SqlPersistM, SqlBackend, Migration)
|
||||
import Database.Persist.Sqlite (SqliteConnectionInfo)
|
||||
|
||||
import System.Nix.Store.DB.Query
|
||||
|
||||
import qualified Control.Monad
|
||||
import qualified Control.Monad.IO.Class
|
||||
import qualified Control.Monad.Logger
|
||||
import qualified Data.ByteString.Char8
|
||||
import qualified Database.Esqueleto.Experimental
|
||||
import qualified Database.Persist.Sql
|
||||
import qualified Database.Persist.Sqlite
|
||||
import qualified System.Log.FastLogger
|
||||
import qualified System.Nix.StorePath
|
||||
import qualified System.Nix.Store.DB.Schema
|
||||
import qualified System.Nix.Store.DB.Util
|
||||
|
||||
-- | @SqliteConnectionInfo@ for accessing
|
||||
-- systems database in /nix/var/nix/db/db.sqlite
|
||||
-- Currently set to immutable
|
||||
systemConnectionInfo :: SqliteConnectionInfo
|
||||
systemConnectionInfo =
|
||||
Database.Persist.Sqlite.mkSqliteConnectionInfo
|
||||
"file:/nix/var/nix/db/db.sqlite?immutable=1"
|
||||
|
||||
-- | Run with @systemConnectionInfo@
|
||||
runSystemSqlite
|
||||
:: SqlPersistM a
|
||||
-> IO a
|
||||
runSystemSqlite =
|
||||
Database.Persist.Sqlite.runSqliteInfo
|
||||
systemConnectionInfo
|
||||
|
||||
-- | @SqliteConnectionInfo@ for running in memory
|
||||
memoryConnectionInfo :: SqliteConnectionInfo
|
||||
memoryConnectionInfo =
|
||||
Database.Persist.Sqlite.mkSqliteConnectionInfo
|
||||
":memory:"
|
||||
|
||||
-- | Run with @memoryConnectionInfo@
|
||||
runInMemory
|
||||
:: SqlPersistM a
|
||||
-> IO a
|
||||
runInMemory =
|
||||
Database.Persist.Sqlite.runSqliteInfo
|
||||
memoryConnectionInfo
|
||||
|
||||
-- | Run with custom connection string
|
||||
runCustom
|
||||
:: Text
|
||||
-> SqlPersistM a
|
||||
-> IO a
|
||||
runCustom =
|
||||
Database.Persist.Sqlite.runSqlite
|
||||
|
||||
-- | Run with logging
|
||||
runWithLogging
|
||||
:: MonadUnliftIO m
|
||||
=> SqliteConnectionInfo
|
||||
-> ReaderT SqlBackend (LoggingT m) a
|
||||
-> m a
|
||||
runWithLogging connInfo act = do
|
||||
flip Control.Monad.Logger.runLoggingT
|
||||
(\_ _ _ s ->
|
||||
Data.ByteString.Char8.putStrLn
|
||||
$ System.Log.FastLogger.fromLogStr s
|
||||
)
|
||||
$ Database.Persist.Sqlite.withSqliteConnInfo
|
||||
connInfo
|
||||
$ Database.Persist.Sql.runSqlConn act
|
||||
|
||||
-- | Test that we can create in-memory database
|
||||
-- and run a dummy query, used by smoke test
|
||||
memTest :: IO ()
|
||||
memTest = runInMemory $ do
|
||||
doMigrateAll
|
||||
_ <- queryEverything
|
||||
pure ()
|
||||
|
||||
allMigrations :: Migration
|
||||
allMigrations = do
|
||||
let addSafeMigration
|
||||
-- the False means it is not unsafe to run (idempotent)
|
||||
= Database.Persist.Sql.addMigration False
|
||||
|
||||
System.Nix.Store.DB.Schema.migrateAll
|
||||
|
||||
addSafeMigration
|
||||
"CREATE INDEX IF NOT EXISTS IndexReferrer ON Refs(referrer)"
|
||||
addSafeMigration
|
||||
"CREATE INDEX IF NOT EXISTS IndexReference ON Refs(reference)"
|
||||
addSafeMigration
|
||||
"CREATE INDEX IF NOT EXISTS IndexDerivationOutputs ON DerivationOutputs(path)"
|
||||
addSafeMigration
|
||||
"CREATE TRIGGER IF NOT EXISTS DeleteSelfRefs before delete on ValidPaths \
|
||||
\begin delete from Refs where referrer = old.id and reference = old.id; end;"
|
||||
|
||||
-- | Perform migration
|
||||
doMigrateAll
|
||||
:: MonadIO m
|
||||
=> ReaderT SqlBackend m ()
|
||||
doMigrateAll =
|
||||
Database.Persist.Sql.runMigration allMigrations
|
||||
|
||||
-- | Perform migration on real database
|
||||
testMigrateAll :: IO ()
|
||||
testMigrateAll = do
|
||||
let connInfo =
|
||||
Database.Persist.Sqlite.mkSqliteConnectionInfo
|
||||
"/tmp/db.sqlite"
|
||||
runWithLogging
|
||||
-- We need to disable foreign key checking otherwise
|
||||
-- the migration would fail
|
||||
(System.Nix.Store.DB.Util.disableFK connInfo)
|
||||
-- this actually returns what queries were performed
|
||||
-- during migration so we just discard it
|
||||
$ Control.Monad.void
|
||||
-- use runMigrationSilent as we have logging enabled
|
||||
$ Database.Persist.Sql.runMigrationSilent allMigrations
|
||||
|
||||
-- | Elaborate test, testing most available query
|
||||
-- functionality. Same as README.md (db-readme executable)
|
||||
test :: IO ()
|
||||
test = do
|
||||
runSystemSqlite $ do
|
||||
(paths, refs, drvOuts) <- queryEverything
|
||||
|
||||
Control.Monad.IO.Class.liftIO $ do
|
||||
putStrLn $ "Stats: "
|
||||
let stat name v = putStrLn $ "- " ++ name ++ ": " ++ show (length v)
|
||||
stat "ValidPath(s)" paths
|
||||
stat "Ref(s)" refs
|
||||
stat "DerivationOutput(s)" drvOuts
|
||||
|
||||
maybeValidPath <- queryOneValidDerivationEntity
|
||||
case maybeValidPath of
|
||||
Nothing -> pure ()
|
||||
Just validPathEntity -> do
|
||||
let pth =
|
||||
System.Nix.Store.DB.Schema.validPathPath
|
||||
$ Database.Esqueleto.Experimental.entityVal validPathEntity
|
||||
|
||||
(same, samePath, references, referrers, validDerivers, outputs) <- (,,,,,)
|
||||
<$> queryPathInfo pth
|
||||
<*> queryPathFromHashPart def (System.Nix.StorePath.storePathHash pth)
|
||||
<*> queryReferences validPathEntity
|
||||
<*> queryReferrers pth
|
||||
<*> queryValidDerivers pth
|
||||
<*> queryDerivationOutputs validPathEntity
|
||||
|
||||
Control.Monad.unless (same == Just (Database.Esqueleto.Experimental.entityVal validPathEntity))
|
||||
$ error "queryPathInfo failed to roundtrip"
|
||||
Control.Monad.unless (samePath == Just pth)
|
||||
$ error "queryPathFromHashPart failed to roundtrip"
|
||||
|
||||
Control.Monad.IO.Class.liftIO $ do
|
||||
putStrLn $ "References: "
|
||||
print references
|
||||
putStrLn $ "Referrers: "
|
||||
print referrers
|
||||
putStrLn $ "Valid derivers: "
|
||||
print validDerivers
|
||||
putStrLn $ "Derivation outputs: "
|
||||
print outputs
|
||||
|
||||
pure ()
|
||||
|
||||
-- | Query everything and for each valid path
|
||||
-- perform detailed queries
|
||||
bench :: IO ()
|
||||
bench = do
|
||||
runSystemSqlite $ do
|
||||
(paths, refs, drvOuts) <- queryEverything
|
||||
Control.Monad.IO.Class.liftIO $ do
|
||||
putStrLn $ "Stats: "
|
||||
let stat name v = putStrLn $ "- " ++ name ++ ": " ++ show (length v)
|
||||
stat "ValidPath(s)" paths
|
||||
stat "Ref(s)" refs
|
||||
stat "DerivationOutput(s)" drvOuts
|
||||
|
||||
Control.Monad.forM_ paths proc
|
||||
where
|
||||
proc validPathEntity = do
|
||||
let pth =
|
||||
System.Nix.Store.DB.Schema.validPathPath
|
||||
$ Database.Esqueleto.Experimental.entityVal validPathEntity
|
||||
|
||||
(same, samePath, _references, _referrers, _validDerivers, _outputs) <- (,,,,,)
|
||||
<$> queryPathInfo pth
|
||||
<*> queryPathFromHashPart def (System.Nix.StorePath.storePathHash pth)
|
||||
<*> queryReferences validPathEntity
|
||||
<*> queryReferrers pth
|
||||
<*> queryValidDerivers pth
|
||||
<*> queryDerivationOutputs validPathEntity
|
||||
|
||||
Control.Monad.unless (same == Just (Database.Esqueleto.Experimental.entityVal validPathEntity))
|
||||
$ error "queryPathInfo failed to roundtrip"
|
||||
Control.Monad.unless (samePath == Just pth)
|
||||
$ error "queryPathFromHashPart failed to roundtrip"
|
63
hnix-store-db/src/System/Nix/Store/DB/Schema.hs
Normal file
63
hnix-store-db/src/System/Nix/Store/DB/Schema.hs
Normal file
@ -0,0 +1,63 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module System.Nix.Store.DB.Schema where
|
||||
|
||||
import Data.Text (Text)
|
||||
import Data.Word (Word64)
|
||||
|
||||
import Database.Persist.TH ( mkMigrate
|
||||
, mkPersist
|
||||
, share
|
||||
, sqlSettings
|
||||
)
|
||||
|
||||
import System.Nix.ContentAddress (ContentAddress)
|
||||
import System.Nix.StorePath (StorePath)
|
||||
import System.Nix.StorePath.Metadata (StorePathTrust(..))
|
||||
|
||||
import System.Nix.Store.DB.Instances (NixUTCTime)
|
||||
import System.Nix.Store.DB.Util (persistLikeNix)
|
||||
|
||||
-- shcema version 10
|
||||
-- cat /nix/var/nix/db/schema
|
||||
-- 10
|
||||
|
||||
share [ mkPersist sqlSettings
|
||||
, mkMigrate "migrateAll" ] [persistLikeNix|
|
||||
ValidPath
|
||||
path StorePath
|
||||
hash Text
|
||||
regTime NixUTCTime sql=registrationTime
|
||||
deriver StorePath Maybe
|
||||
narBytes Word64 sql=narSize
|
||||
ultimate StorePathTrust Maybe
|
||||
-- ^ null is BuiltElsewhere, 1 is BuiltLocally
|
||||
sigs Text Maybe
|
||||
-- ^ space separated
|
||||
ca ContentAddress Maybe
|
||||
-- ^ if not null, an assertion that the path is content-addressed
|
||||
deriving Eq Show Ord
|
||||
|
||||
Ref
|
||||
referrer ValidPathId
|
||||
reference ValidPathId
|
||||
|
||||
Primary referrer reference
|
||||
|
||||
Foreign ValidPath OnDeleteCascade fk_referrer referrer
|
||||
Foreign ValidPath OnDeleteRestrict fk_reference reference
|
||||
deriving Eq Show Ord
|
||||
|
||||
DerivationOutput
|
||||
drv ValidPathId
|
||||
name Text sql=id
|
||||
-- ^ symbolic output id, usually "out"
|
||||
path StorePath
|
||||
|
||||
Primary drv name
|
||||
|
||||
Foreign ValidPath OnDeleteCascade fk_drv drv
|
||||
deriving Eq Show Ord
|
||||
|]
|
71
hnix-store-db/src/System/Nix/Store/DB/Util.hs
Normal file
71
hnix-store-db/src/System/Nix/Store/DB/Util.hs
Normal file
@ -0,0 +1,71 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module System.Nix.Store.DB.Util
|
||||
( persistLikeNix
|
||||
, setWAL
|
||||
, enableWAL
|
||||
, disableWAL
|
||||
, setFK
|
||||
, enableFK
|
||||
, disableFK
|
||||
) where
|
||||
|
||||
import Language.Haskell.TH.Quote
|
||||
import Database.Persist.Quasi
|
||||
import Database.Persist.Sqlite (SqliteConnectionInfo)
|
||||
import Database.Persist.TH (persistWith)
|
||||
|
||||
import qualified Database.Persist.Sqlite
|
||||
import qualified Lens.Micro
|
||||
|
||||
-- | Coerce table names to their plural names
|
||||
-- i.e. ValidPath -> ValidPaths
|
||||
persistLikeNix :: QuasiQuoter
|
||||
persistLikeNix = persistWith $
|
||||
setPsToDBName
|
||||
(coerce . (getPsToDBName upperCaseSettings))
|
||||
upperCaseSettings
|
||||
where
|
||||
coerce x | x `elem` ["ValidPath", "Ref", "DerivationOutput"] = plural x
|
||||
coerce x = x
|
||||
|
||||
plural x = x <> "s"
|
||||
|
||||
-- * WAL and FK
|
||||
|
||||
-- | Configure WAL (write ahead log)
|
||||
setWAL
|
||||
:: Bool
|
||||
-> SqliteConnectionInfo
|
||||
-> SqliteConnectionInfo
|
||||
setWAL v = Lens.Micro.over Database.Persist.Sqlite.walEnabled (const v)
|
||||
|
||||
-- | Enable WAL (write ahead log)
|
||||
enableWAL
|
||||
:: SqliteConnectionInfo
|
||||
-> SqliteConnectionInfo
|
||||
enableWAL = setWAL True
|
||||
|
||||
-- | Disable WAL (write ahead log)
|
||||
disableWAL
|
||||
:: SqliteConnectionInfo
|
||||
-> SqliteConnectionInfo
|
||||
disableWAL = setWAL False
|
||||
|
||||
-- | Configure FK (foreign key constraints)
|
||||
setFK
|
||||
:: Bool
|
||||
-> SqliteConnectionInfo
|
||||
-> SqliteConnectionInfo
|
||||
setFK v = Lens.Micro.over Database.Persist.Sqlite.walEnabled (const v)
|
||||
|
||||
-- | Enable foreign key constraint checking
|
||||
enableFK
|
||||
:: SqliteConnectionInfo
|
||||
-> SqliteConnectionInfo
|
||||
enableFK = setFK True
|
||||
|
||||
-- | Disable foreign key constraint checking
|
||||
disableFK
|
||||
:: SqliteConnectionInfo
|
||||
-> SqliteConnectionInfo
|
||||
disableFK = setFK False
|
11
hnix-store-db/tests/Smoke.hs
Normal file
11
hnix-store-db/tests/Smoke.hs
Normal file
@ -0,0 +1,11 @@
|
||||
module Main where
|
||||
|
||||
import qualified System.Nix.Store.DB.Run
|
||||
|
||||
-- This only tests that database can be created
|
||||
-- in-memory using migrateAll and that queryEverything
|
||||
-- runs (with no data)
|
||||
--
|
||||
-- For better test, we would need a populated nix-store
|
||||
main :: IO ()
|
||||
main = System.Nix.Store.DB.Run.memTest
|
@ -50,6 +50,12 @@ in
|
||||
[
|
||||
haskellLib.compose.buildFromSdist
|
||||
];
|
||||
hnix-store-db =
|
||||
lib.pipe
|
||||
(hself.callCabal2nix "hnix-store-db" ./hnix-store-db {})
|
||||
[
|
||||
haskellLib.compose.buildFromSdist
|
||||
];
|
||||
hnix-store-remote =
|
||||
lib.pipe
|
||||
# enable -fio-testsuite for Linux systems as
|
||||
|
@ -3,7 +3,11 @@ let
|
||||
inherit (import ./. attrs) pkgs haskellPackages;
|
||||
hlib = pkgs.haskell.lib;
|
||||
|
||||
packages = [ "hnix-store-core" "hnix-store-remote" ];
|
||||
packages = [
|
||||
"hnix-store-core"
|
||||
"hnix-store-db"
|
||||
"hnix-store-remote"
|
||||
];
|
||||
extract-external-inputs = p:
|
||||
builtins.filter
|
||||
(dep: !(builtins.elem dep packages))
|
||||
|
Loading…
Reference in New Issue
Block a user