awakesecurity/hocker
1
1
Fork 0
mirror of https://github.com/awakesecurity/hocker.git synced 2024-11-22 02:12:35 +03:00
Code Issues Projects Releases Wiki Activity

Merge master

Browse Source
This commit is contained in:
John C. Carey 2019-03-22 18:01:04 -07:00
commit 9645c7ab1e
17 changed files with 95 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
default.nix
View File

@ -1,13 +1,13 @@
{ mkDerivation, aeson, aeson-pretty, async, base, bytestring
, concurrentoutput, containers, cryptonite, data-fix, deepseq
, directory, exceptions, filepath, foldl, hnix, http-client
, http-types, lens, lens-aeson, lifted-base, memory, mtl
, neat-interpolation, network, network-uri, nix-paths
, http-types, lens, lens-aeson, lifted-base, megaparsec, memory
, mtl, neat-interpolation, network, network-uri, nix-paths
, optional-args, optparse-applicative, optparse-generic, pooled-io
, prettyprinter, pureMD5, scientific, stdenv, tar, tasty
, tasty-golden, tasty-hunit, tasty-quickcheck, tasty-smallcheck
, temporary, text, time, transformers, turtle, unordered-containers
, uri-bytestring, vector, wreq, zlib
, uri-bytestring, vector, word8, wreq, zlib
}:
mkDerivation {
pname = "hocker";
@ -20,9 +20,9 @@ mkDerivation {
aeson aeson-pretty async base bytestring concurrentoutput
containers cryptonite data-fix deepseq directory exceptions
filepath foldl hnix http-client http-types lens lens-aeson
lifted-base memory mtl neat-interpolation network network-uri
nix-paths optparse-applicative optparse-generic pooled-io
prettyprinter pureMD5 scientific tar temporary text time
lifted-base megaparsec memory mtl neat-interpolation network
network-uri nix-paths optparse-applicative optparse-generic
pooled-io prettyprinter pureMD5 scientific tar temporary text time
transformers turtle unordered-containers uri-bytestring vector wreq
zlib
];
@ -33,7 +33,7 @@ mkDerivation {
testHaskellDepends = [
aeson base bytestring containers cryptonite mtl network network-uri
prettyprinter tasty tasty-golden tasty-hunit tasty-quickcheck
tasty-smallcheck text unordered-containers
tasty-smallcheck text unordered-containers word8
];
homepage = "https://github.com/awakesecurity/hocker#readme";
description = "Interact with the docker registry and generate nix build instructions";

3
hocker.cabal
View File

@ -240,7 +240,8 @@ test-suite hocker-tests
tasty-quickcheck >= 0.8,
tasty-smallcheck >= 0.8,
text >= 1.2,
unordered-containers >= 0.2
unordered-containers >= 0.2,
word8 >= 0.1.0
ghc-options: -threaded -rtsopts -with-rtsopts=-N

40
src/Data/Docker/Nix/FetchDocker.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
@ -23,14 +24,14 @@ import qualified Data.Bifunctor as Bifunctor
import Data.Coerce
import Data.Fix
import Data.Maybe
import Data.Monoid
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8')
import Data.Text.Encoding.Error
import Nix.Expr
import Nix.Expr hiding (inherit)
import qualified Nix.Expr (inherit)
import URI.ByteString
import qualified Text.Megaparsec.Pos
import Data.Docker.Image.Types
import Data.Docker.Nix.Lib as Nix.Lib
@ -39,6 +40,20 @@ import Network.Wreq.Docker.Registry (pluckLayersFrom)
import Hocker.Types
import Hocker.Types.Exceptions
import Hocker.Types.ImageTag
import Text.Megaparsec.Pos (Pos, mkPos)
-- | @hnix-0.5.0:inherit@ requires a source location as its final argument.
inheritAdapter :: FilePath -> Pos -> Pos -> [NKeyName e] -> Binding e
inheritAdapter sourceName sourceLine sourceColumn ks = Nix.Expr.inherit ks
#if MIN_VERSION_hnix(0,5,0)
SourcePos{..}
#endif
-- | @hnix-0.5.0@ omits mkApp.
#if MIN_VERSION_hnix(0,5,0)
mkApp :: NExpr -> NExpr -> NExpr
mkApp e = Fix . NBinary NApp e
#endif
{- Example output of the pretty-printed, generated Nix expression AST.
{ fetchdocker, fetchDockerConfig, fetchDockerLayer }:
@ -100,9 +115,6 @@ generate dim@HockerImageMeta{..} = runExceptT $
pluckedConfigDigest = Hocker.Lib.stripHashId $ manifestJSON ^. key "config" . key "digest" . _String
pluckedLayerDigests = Hocker.Lib.stripHashId <$> pluckLayersFrom manifestJSON
emptySourcePos :: SourcePos
emptySourcePos = Text.Megaparsec.Pos.initialPos ""
{-| Generate a top-level Nix Expression AST from a 'HockerImageMeta'
record, a config digest, and a list of layer digests.
@ -136,20 +148,24 @@ generateFetchDockerExpr dim@HockerImageMeta{..} configDigest layerDigests = do
, StaticKey "imageName"
]
let genLayerId i = mkSym . Text.pack $ "layer" <> show i
let fetchconfig = mkFetchDockerConfig (inherit ((StaticKey "tag"):commonInherits) emptySourcePos) configDigest
let fetchconfig = mkFetchDockerConfig (inheritAdapter ("generated for " ++ show imageName) (mkPos 1) (mkPos 1) $ ((StaticKey "tag"):commonInherits)) configDigest
fetchlayers =
mkLets
(mkFetchDockerLayers (inherit commonInherits emptySourcePos) layerDigests)
(mkFetchDockerLayers (inheritAdapter "common inherits" (mkPos 1) (mkPos 1) commonInherits) layerDigests)
(mkList $ fmap genLayerId [0..(Prelude.length layerDigests)-1])
fetchDockerExpr <- mkFetchDocker dim fetchconfig fetchlayers
pure
(mkFunction
(mkParamset
[ ("fetchdocker", Nothing)
, ("fetchDockerConfig", Nothing)
[ ("fetchDockerConfig", Nothing)
, ("fetchDockerLayer", Nothing)
]
False) fetchDockerExpr)
, ("fetchdocker", Nothing)
] -- List keys in sorted order so that we do not care
-- whether hnix sorts keys or preserves this order.
#if MIN_VERSION_hnix(0,5,0)
False -- not variadic
#endif
) fetchDockerExpr)
-- | Generate a @fetchdocker { ... }@ function call and argument
-- attribute set. Please see 'generateFetchDockerExpr' documentation

2
src/Data/Docker/Nix/Lib.hs
View File

@ -15,7 +15,7 @@
module Data.Docker.Nix.Lib where
import Control.Foldl as Foldl
import qualified Control.Foldl as Foldl
import Turtle
import Control.Monad.Except as Except
import qualified Data.Text as Text

4
src/Hocker/Lib.hs
View File

@ -28,10 +28,10 @@ import Data.Aeson.Lens
import qualified Data.ByteString.Char8 as C8
import Data.ByteString.Lazy.Char8 as C8L
import Data.Coerce
import Data.Monoid
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Prettyprint.Doc (Doc, LayoutOptions(..),
import Data.Text.Prettyprint.Doc (LayoutOptions(..),
PageWidth(..), SimpleDocStream)
import qualified Data.Text.Prettyprint.Doc
import qualified Data.Text.Prettyprint.Doc.Render.Text

2
src/Hocker/Types.hs
View File

@ -31,7 +31,7 @@ import Control.Monad.Reader.Class
import qualified Crypto.Hash as Hash
import qualified Data.ByteString.Lazy
import Data.Char (toUpper)
import Data.Monoid
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Network.Wreq as Wreq

2
src/Hocker/Types/Exceptions.hs
View File

@ -19,7 +19,7 @@ module Hocker.Types.Exceptions where
import Control.DeepSeq
import Control.Exception
import Data.Monoid
import Data.Semigroup ((<>))
import GHC.Generics
data HockerException = HockerException

2
src/Hocker/Types/Hash.hs
View File

@ -17,7 +17,7 @@ import qualified Crypto.Hash as Hash
import qualified Data.ByteArray as BA
import qualified Data.ByteArray.Encoding as BA
import qualified Data.ByteString.Char8 as C8
import Data.Monoid
import Data.Semigroup ((<>))
import qualified Data.Text
import qualified Options.Applicative as Options
import Options.Generic

2
src/Hocker/Types/ImageName.hs
View File

@ -15,7 +15,7 @@
module Hocker.Types.ImageName where
import Control.DeepSeq
import Data.Monoid
import Data.Semigroup ((<>))
import qualified Options.Applicative as Options
import Options.Generic

2
src/Hocker/Types/ImageTag.hs
View File

@ -15,7 +15,7 @@
module Hocker.Types.ImageTag where
import Control.DeepSeq
import Data.Monoid
import Data.Semigroup ((<>))
import qualified Options.Applicative as Options
import Options.Generic

2
src/Hocker/Types/URI.hs
View File

@ -16,7 +16,7 @@ module Hocker.Types.URI where
import Control.Lens
import qualified Data.ByteString.Char8 as C8
import Data.Monoid
import Data.Semigroup ((<>))
import qualified Data.Text as Text
import qualified Options.Applicative as Options
import Options.Applicative.Builder

2
src/Network/Wreq/Docker/Image.hs
View File

@ -25,7 +25,7 @@ import Data.ByteString.Lazy.Char8 as C8L
import Data.Coerce
import Data.Either
import Data.HashSet as Set
import Data.Monoid
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8')

2
src/Network/Wreq/Docker/Image/Lib.hs
View File

@ -24,7 +24,7 @@ import Control.Monad.Reader
import qualified Data.ByteString.Lazy.Char8 as C8L
import Data.Coerce
import qualified Data.HashMap.Strict as HashMap
import Data.Monoid
import Data.Semigroup ((<>))
import qualified Data.Text as Text
import qualified Network.Wreq as Wreq
import qualified System.Directory as Directory

6
src/Network/Wreq/Docker/Registry.hs
View File

@ -27,7 +27,6 @@ module Network.Wreq.Docker.Registry where
import Control.Lens
import qualified Control.Monad.Except as Except
import Control.Monad.Reader
import Data.Monoid
import qualified Crypto.Hash as Hash
import Data.Aeson.Lens
import Data.ByteString.Lazy.Char8 as C8L
@ -35,6 +34,7 @@ import qualified Data.ByteString.Char8 as C8
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import URI.ByteString
import NeatInterpolation
import Data.Semigroup ((<>))
import qualified Data.Text as Text
import qualified Network.Wreq as Wreq
import System.Directory
@ -64,7 +64,7 @@ defaultRegistry = URI
--
-- If 'Credentials' is either 'BearerToken' or 'Basic' then produce a
-- 'Wreq.Auth' value for that type of credential.
--
--
-- If @Nothing@ is provided _and_ the provided 'RegistryURI' matches
-- the default registry, make a request to
-- @https://auth.docker.io/token@ for a temporary pull-only bearer
@ -131,7 +131,7 @@ fetchImageConfig (showSHA -> digest) = ask >>= \HockerMeta{..} ->
mkURL (ImageName n) r = C8.unpack (serializeURIRef' $ Hocker.Lib.joinURIPath [n, "blobs", digest] r)
-- | Retrieve a compressed layer blob by its hash digest.
--
--
-- TODO: take advantage of registry's support for the Range header so
-- we can stream downloads.
fetchLayer :: Layer -> Hocker RspBS

2
src/Network/Wreq/ErrorHandling.hs
View File

@ -21,7 +21,7 @@ import Control.Exception.Lifted as Lifted
import Control.Lens
import Control.Monad.Except
import Data.ByteString.Char8 as C8
import Data.Monoid
import Data.Semigroup ((<>))
import Network.HTTP.Client
import Network.HTTP.Types.Status

41
test/Tests/Data/Docker/Nix/FetchDocker.hs
View File

@ -15,15 +15,19 @@ module Tests.Data.Docker.Nix.FetchDocker where
import Control.Exception as CE
import Control.Monad.Except as Except
import Data.ByteString as BS
import Data.ByteString.Lazy.Char8 as C8L
import Data.Either (either)
import qualified Data.Text as Text
import qualified Data.Text.Prettyprint.Doc.Render.String
import Data.Word8 as W8
import Network.URI
import Test.Tasty
import Test.Tasty.Golden
import Test.Tasty.Golden.Advanced (goldenTest)
import Test.Tasty.HUnit
import Text.Printf (printf)
import Data.Docker.Image.Types
import Data.Docker.Nix.FetchDocker as Nix.FetchDocker
@ -33,8 +37,43 @@ import Network.Wreq.Docker.Registry as Docker.Registry
import Hocker.Types
import Hocker.Types.ImageTag
-- | Compare a given string against the golden file contents,
-- ignoring differences in contiguous nonempty spans of whitespace,
-- and the presence or absence of whitespace before or after a comma.
goldenVsStringCanonicalize
:: TestName -- ^ test name
-> FilePath -- ^ path to golden file
-> IO C8L.ByteString -- ^ action that returns string to compare
-> TestTree -- ^ the test verifies that the returned string equals the
-- golden file contents when ignoring differences in whitespace
goldenVsStringCanonicalize name ref act =
goldenTest
name
(BS.readFile ref)
(C8L.toStrict <$> act)
cmp
upd
where
cmp x y = cmpCanonicalize msg x y
where
msg = printf "Test output was different from '%s'. It was: %s" ref (show y)
upd = BS.writeFile ref
cmpCanonicalize ::
String -> BS.ByteString -> BS.ByteString -> IO (Maybe String)
cmpCanonicalize e x y =
return $ if canonicalize x == canonicalize y then Nothing else Just e
where
canonicalize = BS.pack . BS.foldr op []
op x acc
| W8.isSpace x, y : _ <- acc, y == W8._space = acc
| W8.isSpace x, y : _ <- acc, y == W8._comma = acc
| W8.isSpace x = W8._space : acc
| x == W8._comma, y : ys <- acc, y == W8._space = W8._comma : ys
| otherwise = x : acc
tests = testGroup "FetchDocker Nix Generation Tests"
[ goldenVsString
[ goldenVsStringCanonicalize
"Golden vs. Generated `fetchDocker' Nix Expression"
"test/data/golden-debian_jessie.nix"
generateFetchDockerNix

6
test/data/golden-debian_jessie.nix
View File

@ -1,6 +1,6 @@
{ fetchdocker
, fetchDockerConfig
, fetchDockerLayer }:
{ fetchDockerConfig
, fetchDockerLayer
, fetchdocker }:
fetchdocker rec {
name = "debian";
registry = "https://registry-1.docker.io/v2/";