diff options
author | Andrew Cady <d@jerkface.net> | 2018-06-17 16:14:53 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2018-06-17 16:15:40 -0400 |
commit | 019a2a64ffd8286f2f272199bedca1d62589764a (patch) | |
tree | 8e4f631bee787bb339386c9318840c0047a4d0c5 |
initial commit
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | Setup.hs | 2 | ||||
-rw-r--r-- | fsmgr.cabal | 53 | ||||
-rw-r--r-- | fsmgr.hs | 48 | ||||
-rw-r--r-- | src/Crypto/Hash/Types/Digest/Read.hs | 20 | ||||
-rw-r--r-- | stack.yaml | 5 |
6 files changed, 129 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3a5b475 --- /dev/null +++ b/.gitignore | |||
@@ -0,0 +1 @@ | |||
.stack-work/ | |||
diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs | |||
@@ -0,0 +1,2 @@ | |||
1 | import Distribution.Simple | ||
2 | main = defaultMain | ||
diff --git a/fsmgr.cabal b/fsmgr.cabal new file mode 100644 index 0000000..06a6bdb --- /dev/null +++ b/fsmgr.cabal | |||
@@ -0,0 +1,53 @@ | |||
1 | name: fsmgr | ||
2 | version: 0.1.0.0 | ||
3 | -- description: Please see the README on GitHub at <https://github.com/afcady/fsmgr#readme> | ||
4 | -- homepage: https://github.com/afcady/fsmgr#readme | ||
5 | -- bug-reports: https://github.com/afcady/fsmgr/issues | ||
6 | author: Andrew Cady | ||
7 | maintainer: d@jerkface.net | ||
8 | copyright: AllRightsReserved | ||
9 | -- license-file: LICENSE | ||
10 | build-type: Simple | ||
11 | cabal-version: >= 1.10 | ||
12 | -- extra-source-files: | ||
13 | -- ChangeLog.md | ||
14 | -- README.md | ||
15 | |||
16 | source-repository head | ||
17 | type: git | ||
18 | location: https://github.com/afcady/fsmgr | ||
19 | |||
20 | library | ||
21 | exposed-modules: | ||
22 | Crypto.Hash.Types.Digest.Read | ||
23 | other-modules: | ||
24 | Paths_fsmgr | ||
25 | hs-source-dirs: | ||
26 | src | ||
27 | build-depends: | ||
28 | base >=4.7 && <5, rebase, optparse-applicative, typed-process, | ||
29 | directory, filepath, yaml, lens, lens-aeson, cryptonite, memory, basement | ||
30 | default-language: Haskell2010 | ||
31 | |||
32 | executable fsmgr | ||
33 | main-is: fsmgr.hs | ||
34 | other-modules: | ||
35 | Paths_fsmgr | ||
36 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -W -Wall | ||
37 | build-depends: | ||
38 | base >=4.7 && <5, rebase, optparse-applicative, typed-process, | ||
39 | directory, filepath, yaml, lens, lens-aeson, cryptonite, memory, basement, fsmgr | ||
40 | default-language: Haskell2010 | ||
41 | |||
42 | -- test-suite fsmgr-test | ||
43 | -- type: exitcode-stdio-1.0 | ||
44 | -- main-is: Spec.hs | ||
45 | -- other-modules: | ||
46 | -- Paths_fsmgr | ||
47 | -- hs-source-dirs: | ||
48 | -- test | ||
49 | -- ghc-options: -threaded -rtsopts -with-rtsopts=-N | ||
50 | -- build-depends: | ||
51 | -- base >=4.7 && <5 | ||
52 | -- , fsmgr | ||
53 | -- default-language: Haskell2010 | ||
diff --git a/fsmgr.hs b/fsmgr.hs new file mode 100644 index 0000000..3c5e72f --- /dev/null +++ b/fsmgr.hs | |||
@@ -0,0 +1,48 @@ | |||
1 | {-# LANGUAGE InstanceSigs #-} | ||
2 | {-# LANGUAGE NoImplicitPrelude #-} | ||
3 | {-# LANGUAGE PartialTypeSignatures #-} | ||
4 | module Main where | ||
5 | import Rebase.Prelude hiding (hash) | ||
6 | |||
7 | import Crypto.Hash | ||
8 | import Crypto.Hash.Types.Digest.Read () | ||
9 | |||
10 | {- | ||
11 | |||
12 | Basic idea is to have a fs.yaml that specifies the build procedure. Analogous to | ||
13 | stack.yaml, it should specify everything (every source) directly or indirectly. | ||
14 | |||
15 | We want to make new images from CoW copies of old ones. We want to build these | ||
16 | things incrementally, but still end up with something that will be reproducible | ||
17 | from scratch. | ||
18 | |||
19 | Anyway, what we'll have is a list of packages, which will be unpacked first. | ||
20 | Then a list of debconf values, which will be applied. Then we will have the rest | ||
21 | of the other, slower changes to the image (including dpkg --configure -a). Some | ||
22 | changes can be assumed to produce the same results out of order. Oh right, and | ||
23 | the zeroeth step is to generate the empty (or just initial) filesystem image. | ||
24 | The initial filesystem image, if nonempty, is specified by filename (otherwise, | ||
25 | by size), while the hash of the configuration determines the output filename. | ||
26 | |||
27 | |||
28 | -} | ||
29 | |||
30 | newtype DebconfConfig = DebconfConfig Text deriving (Show, Read, Eq, Ord) | ||
31 | newtype Package = Package Text deriving (Show, Read, Eq, Ord) | ||
32 | data Patch = Patch deriving (Show, Read) | ||
33 | |||
34 | sha1 :: ByteString -> Digest SHA1 | ||
35 | sha1 = hash | ||
36 | |||
37 | data DiskImageConfig = DiskImageConfig { | ||
38 | initialImage :: Either Integer (Digest SHA1) | ||
39 | , unpacked :: Set Package | ||
40 | , debconfConfig :: DebconfConfig | ||
41 | , configured :: Set Package | ||
42 | , patched :: [Patch] | ||
43 | } deriving (Show, Read) | ||
44 | |||
45 | |||
46 | |||
47 | main :: IO () | ||
48 | main = return () | ||
diff --git a/src/Crypto/Hash/Types/Digest/Read.hs b/src/Crypto/Hash/Types/Digest/Read.hs new file mode 100644 index 0000000..f371f30 --- /dev/null +++ b/src/Crypto/Hash/Types/Digest/Read.hs | |||
@@ -0,0 +1,20 @@ | |||
1 | {-# OPTIONS_GHC -fno-warn-orphans #-} | ||
2 | {-# LANGUAGE InstanceSigs #-} | ||
3 | {-# LANGUAGE NoImplicitPrelude #-} | ||
4 | {-# LANGUAGE PartialTypeSignatures #-} | ||
5 | {-# LANGUAGE ViewPatterns #-} | ||
6 | module Crypto.Hash.Types.Digest.Read where | ||
7 | import Rebase.Prelude hiding (hash) | ||
8 | |||
9 | import Crypto.Hash | ||
10 | import Data.ByteArray.Encoding | ||
11 | import qualified Rebase.Data.Text as Text | ||
12 | |||
13 | instance HashAlgorithm a => | ||
14 | Read (Digest a) where | ||
15 | readsPrec :: Int -> (String -> [(Digest a, String)]) | ||
16 | readsPrec _ (Text.encodeUtf8 . Text.pack -> bytes) = | ||
17 | toList $ (flip (,) "") <$> (digestFromByteString =<< baseConv bytes) | ||
18 | where | ||
19 | baseConv :: ByteString -> Maybe (ByteString) | ||
20 | baseConv = listToMaybe . toList . convertFromBase Base16 | ||
diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..c7632a6 --- /dev/null +++ b/stack.yaml | |||
@@ -0,0 +1,5 @@ | |||
1 | resolver: lts-11.13 | ||
2 | packages: | ||
3 | - . | ||
4 | extra-deps: | ||
5 | - rebase-1.2.4 | ||