diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# Changelog +## 1.0.0 +- Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/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 2016 Awake Networks + + 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,133 @@ +# Welcome! +The `hocker` package provides a small set of utilities to fetch docker image +artifacts from docker registries and produce Nix derivations marrying docker and +Nix elegantly: + +- [`hocker-image`](./hocker-image/README.md) for fetching a docker image +- [`hocker-layer`](./hocker-layer/README.md) for fetching a docker image's layers +- [`hocker-config`](./hocker-config/README.md) for fetching a docker image's configuration JSON +- [`hocker-manifest`](./hocker-manifest/README.md) for fetching a docker registry image manifest +- [`docker2nix`](./docker2nix/README.md) for generating Nix expressions calling the `fetchdocker` + derivations, given a docker registry image manifest + +These tools _only_ work with version 2 of the **docker registry** and **docker +(>=) v1.10**. + +The motivation for this tool came from a need to fetch docker image artifacts +from a docker registry without the stock docker tooling designed to only work +with the docker daemon. + +Our use case (and the reason why this package exposes a `docker2nix` tool) is pulling +docker images into a [NixOS system's store](https://nixos.org/nix/manual/#ch-about-nix) and +loading those images from the store into the docker daemon running on that same system. + +We desired this for two critical reasons: +1. The docker daemon no longer required an internet connection in order to load + the docker images +2. By virtue of fetching the docker images at build-time as opposed to run-time, + failures from non-existent images or image tags are caught earlier + +We strived to make this tool useful outside of the context of Nix and NixOS, +therefore all of these tools are usable without Nix in the workflow. + +For high-level documentation of each utility, please refer to the README's in +their respective directories (links are in the above list). + +## Quickstart +Let's first retrieve a docker registry image manifest for the `debian:jessie` +docker image (note that we need the `library/` repository prefix because we are +pulling from the official debian repository!): + +```shell +$ hocker-manifest library/debian jessie +{ + "schemaVersion": 2, + "mediaType": "application/vnd.docker.distribution.manifest.v2+json", + "config": { + "mediaType": "application/vnd.docker.container.image.v1+json", + "size": 1528, + "digest": "sha256:054abe38b1e6f863befa4258cbfaf127b1cc9440d2e2e349b15d22e676b591e7" + }, + "layers": [ + { + "mediaType": "application/vnd.docker.image.rootfs.diff.tar.gzip", + "size": 52550276, + "digest": "sha256:cd0a524342efac6edff500c17e625735bbe479c926439b263bbe3c8518a0849c" + } + ] +} +``` + +Next, we can easily generate a `fetchdocker` derivation using `docker2nix`: + +```shell +$ hocker-manifest library/debian jessie | docker2nix library/debian jessie +{ fetchDockerConfig, fetchDockerLayer, fetchdocker }: +fetchdocker rec { + name = "debian"; + registry = "https://registry-1.docker.io/v2/"; + repository = "library"; + imageName = "debian"; + tag = "jessie"; + imageConfig = fetchDockerConfig { + inherit tag registry repository imageName; + sha256 = "1rwinmvfc8jxn54y7qnj82acrc97y7xcnn22zaz67y76n4wbwjh5"; + }; + imageLayers = let + layer0 = fetchDockerLayer { + inherit registry repository imageName; + layerDigest = "cd0a524342efac6edff500c17e625735bbe479c926439b263bbe3c8518a0849c"; + sha256 = "1744l0c8ag5y7ck9nhr6r5wy9frmaxi7xh80ypgnxb7g891m42nd"; + }; + in [ layer0 ]; + } +``` + +## Private registries +We developed these tools with private registries in-mind and they currently +support three modes of authentication: + +1. Nothing at all (simply do not supply `--token` or `--username` and + `--password`) +2. Bearer token-based authentication, you should retrieve a token and then give + it via the `--token` flag +3. Basic authentication with `--username` and `--password` (most common with + nginx proxied registries providing basic auth protection; you should be + careful to ensure you're only sending requests to registries exposed via TLS + or SSL!) + +A caveat to #1 if you do not supply any authentication credential flags and you +also do not supply a `--registry` flag then the tools assume you wish to make a +request to the public docker hub registry, in which case they ask for a +short-lived authentication token from the registry auth server and then make the +request to the public docker hub registry. + +## How to build + +Building (and developing a patch for) this project using `cabal` is +straight-forward if we have Nix installed: + +```bash +$ nix-shell +[nix-shell:]$ cabal --version +cabal-install version 1.24.0.2 +compiled using version 1.24.2.0 of the Cabal library +``` + +... `cabal` and all of the package dependencies will be in the shell environment +so that we can then: + +```bash +[nix-shell:]$ cabal build +``` + +Alternatively we can `nix-build` the project, this is not recommended for +development because Nix will not build the project incrementally: + +```bash +$ nix-build --attr hocker release.nix +these derivations will be built: + /nix/store/3dwvcm66360fpfqrrc4swp9y4q0jzvh9-hocker-0.1.0.0.drv +building path(s) ‘/nix/store/g16mrfhlmb1z3qkdzr0diaqn2dhl8bv6-hocker-0.1.0.0’ +... +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/docker2nix/Main.hs b/docker2nix/Main.hs new file mode 100644 --- /dev/null +++ b/docker2nix/Main.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS -fno-warn-orphans #-} +{-# OPTIONS -fno-warn-unused-do-bind #-} + +----------------------------------------------------------------------------- +-- | +-- Module : docker2nix/Main +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Main where + +import Data.ByteString.Lazy.Char8 as C8L +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Options.Generic +import System.IO (hWaitForInput, stdin) + +import Data.Docker.Image.Types +import Data.Docker.Nix.FetchDocker as Nix.FetchDocker +import Hocker.Lib +import Network.Wreq.Docker.Registry as Docker.Registry +import Hocker.Types +import Hocker.Types.ImageName +import Hocker.Types.ImageTag + +-- | Top-level optparse-generic CLI args data type and specification. +data ProgArgs w = ProgArgs + { -- | URI for the registry, optional + registry :: w ::: Maybe RegistryURI + "URI of registry, defaults to the Docker Hub registry" + -- | Filepath to a file containing the manifest JSON + , manifest :: w ::: Maybe FilePath + "Fetch image manifest from a path on the filesystem" + -- | Alternative docker image name made available in the Nix + -- expression fetchdocker derivation + , altImageName :: w ::: Maybe Text + "Alternate image name provided in the `fetcdocker` derivation" + -- | Docker image name (includes the reponame, e.g: library/debian) + , name :: ImageName + -- | Docker image tag + , imageTag :: ImageTag + } deriving (Generic) + + +instance ParseRecord (ProgArgs Wrapped) +deriving instance Show (ProgArgs Unwrapped) + +progSummary :: Text +progSummary = "Produce a Nix expression given a manifest for a docker image via stdin or via a filepath" + +main :: IO () +main = unwrapRecord progSummary >>= \ProgArgs{..} -> do + let (imageRepo, imageName) = Hocker.Lib.splitRepository name + dockerRegistry = fromMaybe defaultRegistry registry + + manifestJSON <- + case manifest of + Just f -> C8L.readFile f + Nothing -> do + let h = stdin + hWaitForInput h (-1) + C8L.hGetContents h + + exprs <- Nix.FetchDocker.generate HockerImageMeta{..} + either (Hocker.Lib.exitProgFail . show) Hocker.Lib.pprintNixExpr exprs diff --git a/hocker-config/Main.hs b/hocker-config/Main.hs new file mode 100644 --- /dev/null +++ b/hocker-config/Main.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : hocker-config/Main +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Main where + +import Data.Maybe (fromMaybe) +import qualified Data.Text +import Options.Generic + +import Hocker.Lib +import Network.Wreq.Docker.Image as Docker.Image +import Network.Wreq.Docker.Registry +import Hocker.Types + +progSummary :: Data.Text.Text +progSummary = "Fetch a docker image config JSON from the registry" + +main :: IO () +main = unwrapRecord progSummary >>= \Options{..} -> do + let dockerRegistry = fromMaybe defaultRegistry registry + + auth <- mkAuth dockerRegistry imageName credentials + config <- Docker.Image.fetchConfig $ + HockerMeta + { outDir = Nothing + , imageLayer = Nothing + , .. + } + either (Hocker.Lib.exitProgFail . show) (Hocker.Lib.writeOrPrint out) config diff --git a/hocker-image/Main.hs b/hocker-image/Main.hs new file mode 100644 --- /dev/null +++ b/hocker-image/Main.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : hocker-fetch/Main +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Main where + +import Data.Maybe (fromMaybe) +import qualified Data.Text +import Data.Text.IO as TIO +import Options.Generic +import System.IO.Temp as Tmp + +import Hocker.Lib +import Network.Wreq.Docker.Image as Docker.Image +import Network.Wreq.Docker.Registry +import Hocker.Types + +progSummary :: Data.Text.Text +progSummary = "Fetch a docker image from a docker registry without using docker" + +main :: IO () +main = unwrapRecord progSummary >>= \Options{..} -> do + let dockerRegistry = fromMaybe defaultRegistry registry + + auth <- mkAuth dockerRegistry imageName credentials + img <- withSystemTempDirectory "hocker-image-XXXXXX" $ \d -> + Docker.Image.fetchImage $ + HockerMeta + { outDir = Just d + , imageLayer = Nothing + , .. + } + either (Hocker.Lib.exitProgFail . show) TIO.putStrLn img diff --git a/hocker-layer/Main.hs b/hocker-layer/Main.hs new file mode 100644 --- /dev/null +++ b/hocker-layer/Main.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : hocker-layer/Main +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Main where + +import qualified Crypto.Hash as Hash +import Data.Maybe (fromMaybe) +import qualified Data.Text +import Options.Generic + +import Hocker.Lib +import Network.Wreq.Docker.Image as Docker.Image +import Network.Wreq.Docker.Registry +import Hocker.Types +import Hocker.Types.Hash () +import Hocker.Types.ImageName +import Hocker.Types.ImageTag +import Hocker.Types.URI () + +data ProgArgs w = ProgArgs + { -- | URI for the registry, optional + registry :: w ::: Maybe RegistryURI + "URI of registry, defaults to the Docker Hub registry" + , credentials :: Maybe Credentials + -- | Filesystem path to write output to + , out :: w ::: Maybe FilePath + "Write content to location" + -- | Layer sha256 hash digest to fetch from registry + , imageLayer :: w ::: Hash.Digest Hash.SHA256 + "Hash digest of layer to fetch" + -- | Docker image name (includes the repository, e.g: library/debian) + , imageName :: ImageName + -- | Docker image tag + , imageTag :: ImageTag + } deriving (Generic) + +instance ParseRecord (ProgArgs Wrapped) +deriving instance Show (ProgArgs Unwrapped) + +progSummary :: Data.Text.Text +progSummary = "Fetch a docker image layer from a docker registry without using docker" + +main :: IO () +main = unwrapRecord progSummary >>= \ProgArgs{..} -> do + let dockerRegistry = fromMaybe defaultRegistry registry + + auth <- mkAuth dockerRegistry imageName credentials + layerPath <- Docker.Image.fetchLayer $ + HockerMeta + { outDir = Nothing + , imageLayer = Just imageLayer + , .. + } + either (Hocker.Lib.exitProgFail . show) Prelude.putStrLn layerPath diff --git a/hocker-manifest/Main.hs b/hocker-manifest/Main.hs new file mode 100644 --- /dev/null +++ b/hocker-manifest/Main.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : hocker-manifest/Main +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Main where + +import Data.Maybe (fromMaybe) +import qualified Data.Text +import Options.Generic + +import Hocker.Lib +import Network.Wreq.Docker.Image as Docker.Image +import Network.Wreq.Docker.Registry +import Hocker.Types + +progSummary :: Data.Text.Text +progSummary = "Pull a docker image manifest from the registry" + +main :: IO () +main = unwrapRecord progSummary >>= \Options{..} -> do + let dockerRegistry = fromMaybe defaultRegistry registry + + auth <- mkAuth dockerRegistry imageName credentials + manifest <- Docker.Image.fetchImageManifest $ + HockerMeta + { outDir = Nothing + , imageLayer = Nothing + , .. + } + either (Hocker.Lib.exitProgFail . show) (Hocker.Lib.writeOrPrint out) manifest diff --git a/hocker.cabal b/hocker.cabal new file mode 100644 --- /dev/null +++ b/hocker.cabal @@ -0,0 +1,241 @@ +name: hocker +version: 1.0.0 +synopsis: Interact with the docker registry and generate nix build instructions +homepage: https://github.com/awakesecurity/hocker#readme +Bug-Reports: https://github.com/awakesecurity/hocker/issues +license: Apache-2.0 +license-file: LICENSE +author: Awake Security +maintainer: opensource@awakesecurity.com +copyright: 2016 Awake Security +category: Utilities +build-type: Simple + +cabal-version: >=1.10 +Tested-With: GHC == 8.0.2 +Description: + @hocker@ is a suite of command line utilities and a library for: + . + * fetching a docker image + * fetching a layer of an image + * fetching an image's configuration + * fetching a docker registry image manifest + * generating nix build instructions from a registry image manifest + . + The motivation for this tool came from a need to fetch docker + image artifacts from a docker registry without the stock docker + tooling that is designed to only work with the docker daemon. + . + These tools /only/ work with version 2 of the docker registry and + docker version (>=) 1.10. + . + For a complete set of usage examples please see the project's . + +extra-source-files: + LICENSE + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/awakesecurity/hocker.git + +library + ghc-options: -Wall + hs-source-dirs: src + exposed-modules: + Data.Docker.Image.AesonHelpers, + Data.Docker.Image.Types, + Data.Docker.Nix, + Data.Docker.Nix.FetchDocker, + Data.Docker.Nix.Lib, + Hocker.Lib, + Hocker.Types, + Hocker.Types.Exceptions, + Hocker.Types.Hash, + Hocker.Types.ImageName, + Hocker.Types.ImageTag, + Hocker.Types.URI, + Network.Wreq.Docker.Image, + Network.Wreq.Docker.Image.Lib, + Network.Wreq.Docker.Registry, + Network.Wreq.ErrorHandling + build-depends: + base >= 4.9 && < 5, + aeson >= 0.9.0.1, + aeson-pretty >= 0.8, + ansi-wl-pprint >= 0.6.7.3, + async >= 2.0.0.0 && < 2.2, + bytestring >= 0.10, + concurrentoutput >= 0.2, + containers >= 0.5, + cryptonite >= 0.13, + data-fix >= 0.0.3, + deepseq >= 1.4, + directory >= 1.2.2.0, + exceptions >= 0.8, + filepath >= 1.4, + foldl >= 1.0, + hnix >= 0.3.4, + http-client >= 0.4, + http-types >= 0.9.1, + lens >= 4.0, + lens-aeson >= 1.0, + lifted-base >= 0.2.3.8, + memory >= 0.11, + mtl >= 2.2, + neat-interpolation >= 0.3.2, + network >= 2.6, + network-uri >= 2.6, + optparse-applicative >= 0.13, + optparse-generic >= 1.2.0, + pooled-io >= 0.0.2, + pureMD5 >= 2.1, + scientific >= 0.3, + tar >= 0.5, + temporary >= 1.2, + text >= 1.2, + time >= 1.4, + transformers >= 0.4, + turtle >= 1.3, + unordered-containers >= 0.2, + uri-bytestring >= 0.2, + vector >= 0.11, + wreq >= 0.4, + zlib >= 0.6 + + default-language: Haskell2010 + +executable hocker-image + hs-source-dirs: hocker-image + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + base >= 4.9 && < 5, + bytestring >= 0.10, + filepath >= 1.4, + hocker, + lens >= 4.0, + mtl >= 2.2, + network >= 2.6, + optional-args, + optparse-applicative >= 0.13, + optparse-generic >= 1.2.0, + temporary >= 1.2, + text >= 1.2 + + default-language: Haskell2010 + +executable hocker-layer + hs-source-dirs: hocker-layer + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + base >= 4.9 && < 5, + bytestring >= 0.10, + cryptonite >= 0.13, + filepath >= 1.4, + hocker, + lens >= 4.0, + mtl >= 2.2, + network >= 2.6, + optional-args, + optparse-applicative >= 0.13, + optparse-generic >= 1.2.0, + temporary >= 1.2, + text >= 1.2 + + default-language: Haskell2010 + +executable hocker-config + hs-source-dirs: hocker-config + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + base >= 4.9 && < 5, + bytestring >= 0.10, + filepath >= 1.4, + hocker, + lens >= 4.0, + mtl >= 2.2, + network >= 2.6, + optional-args, + optparse-applicative >= 0.13, + optparse-generic >= 1.2.0, + temporary >= 1.2, + text >= 1.2 + + default-language: Haskell2010 + +executable hocker-manifest + hs-source-dirs: hocker-manifest + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + base >= 4.9 && < 5, + text >= 1.2, + lens >= 4.0, + optparse-generic >= 1.2.0, + temporary >= 1.2, + optparse-applicative >= 0.13, + filepath >= 1.4, + mtl >= 2.2, + network >= 2.6, + bytestring >= 0.10, + optional-args, + hocker + + default-language: Haskell2010 + +executable docker2nix + hs-source-dirs: docker2nix + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + base >= 4.9 && < 5, + bytestring >= 0.10, + data-fix >= 0.0.3, + filepath >= 1.4, + hnix >= 0.3.4, + hocker, + lens >= 4.0, + mtl >= 2.2, + network >= 2.6, + optional-args, + optparse-applicative >= 0.13, + optparse-generic >= 1.2.0, + temporary >= 1.2, + text >= 1.2 + + + default-language: Haskell2010 + +test-suite hocker-tests + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + other-modules: + Tests.Data.Docker.Image, + Tests.Data.Docker.Nix.FetchDocker + build-depends: + base >= 4.9 && < 5, + aeson >= 0.9.0.1, + ansi-wl-pprint >= 0.6.7.3, + bytestring >= 0.10, + containers >= 0.5, + cryptonite >= 0.13, + hocker, + mtl >= 2.2, + network >= 2.6, + network-uri >= 2.6, + tasty >= 0.11, + tasty-golden >= 2.3, + tasty-hunit >= 0.9, + tasty-quickcheck >= 0.8, + tasty-smallcheck >= 0.8, + text >= 1.2, + unordered-containers >= 0.2 + + + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 diff --git a/src/Data/Docker/Image/AesonHelpers.hs b/src/Data/Docker/Image/AesonHelpers.hs new file mode 100644 --- /dev/null +++ b/src/Data/Docker/Image/AesonHelpers.hs @@ -0,0 +1,18 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Docker.Image.AesonHelpers +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Data.Docker.Image.AesonHelpers where + +import Data.Aeson +import Data.Aeson.TH + +-- | Produce a default option record with @omitNothingFields@ set to +-- True by default. +stdOpts :: Options +stdOpts = defaultOptions{ omitNothingFields = True } diff --git a/src/Data/Docker/Image/Types.hs b/src/Data/Docker/Image/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Docker/Image/Types.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Docker.Image.Types +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Data.Docker.Image.Types where + +import qualified Crypto.Hash as Hash +import Data.Aeson +import Data.Aeson.TH +import Data.Aeson.Types +import qualified Data.ByteArray as BA +import qualified Data.ByteArray.Encoding as BA +import qualified Data.ByteString.Char8 as C8 +import Data.ByteString.Lazy.Char8 as C8L +import Data.HashMap.Strict as H +import Data.Text (Text) + +import Data.Docker.Image.AesonHelpers +import Hocker.Types +import Hocker.Types.ImageTag + +-- | Metadata needed for constructing a docker image. +data HockerImageMeta = HockerImageMeta + { -- | Docker image repo, the first part of a repository+name + -- separated by a "/"; e.g: library/debian. + imageRepo :: RepoNamePart + -- | Docker image name, the second part of a repository+name + -- separated by a "/"; e.g: library/debian. + , imageName :: ImageNamePart + -- | Docker image tag + , imageTag :: ImageTag + -- | A docker image manifest JSON blob as usually fetched from a + -- docker registry. + , manifestJSON :: C8L.ByteString + -- | The URI (even if the default public registry) of the docker + -- registry. + , dockerRegistry :: RegistryURI + -- | An alternative name for the docker image in the generated nix + -- build instructions. + , altImageName :: Maybe Text + } deriving (Show) + +-- | Parse a 'C8.ByteString' into a 'Hash.SHA256'. +-- +-- A digest value, as seen in the docker registry manifest, is the +-- hexadecimal encoding of a hashing function's digest with the +-- hashing function identifier prefixed onto the string. At this time +-- the only prefix used is @sha256:@. +toDigest :: C8.ByteString -> Maybe (Hash.Digest Hash.SHA256) +toDigest = from . C8.break (== ':') + where + from ("sha256", r) = either (const Nothing) Hash.digestFromByteString . toBytes $ C8.tail r + from (_, _) = Nothing + + toBytes :: C8.ByteString -> Either String BA.Bytes + toBytes = BA.convertFromBase BA.Base16 + +-- | Show a hexadecimal encoded 'SHA256' hash digest and prefix +-- @sha256:@ to it. +showSHA :: Hash.Digest Hash.SHA256 -> String +showSHA = ("sha256:" ++) . show + +-- Pretty-printed example of the `manifest.json` file. +{- + [ + { + "Config": "3e83c23dba6a16cd936a3dc044df71b26706c5a4c28181bc3ca4a4af9f5f38ee.json", + "Layers": [ + "10a267c67f423630f3afe5e04bbbc93d578861ddcc54283526222f3ad5e895b9.tar" + ], + "RepoTags": [ + "library/debian:jessie" + ] + } +] +-} + +-- Pretty-printed example of the `repositories` json file. +{- + { + "library/debian": { + "jessie": "10a267c67f423630f3afe5e04bbbc93d578861ddcc54283526222f3ad5e895b9" + } + } +-} + +-- | A layer hash digest from a docker image's config JSON. This hash +-- is different from those found in the image's manifest JSON. +type RefLayer = Text + +-- | A 'String' representing the full repository tag, e.g: @library/debian@. +type RepoTag = String + +-- | A v1.2 docker image manifest. +data ImageManifest = ImageManifest + { -- | 'FilePath' within the image archive of the image's config + -- JSON + config :: FilePath + -- | List of image repository tags + , repoTags :: [Text] + -- | List of layers within the image archive named by their hash + -- digest and with a @.tar@ extension + , layers :: [FilePath] + } deriving (Show, Eq) + +-- | A map of 'ImageRepo's. The repository names are the top-level +-- keys and their value is a map who's keys are the tags of the +-- repository with the hash-value of the layer that tag references. +data ImageRepositories = ImageRepositories [ImageRepo] + deriving (Show, Eq) + +data ImageRepo = ImageRepo + { -- | Repository tag + repo :: Text + -- | 'HashMap' of tags to the top-most layer associated with that tag + , tags :: H.HashMap Text Text + } deriving (Show, Eq) + +$(deriveJSON stdOpts{ fieldLabelModifier = upperFirst } ''ImageManifest) + + + +instance ToJSON ImageRepositories where + toJSON (ImageRepositories r) = + Object . H.unions $ [i | o@(Object i) <- (fmap toJSON r), isObject o] + where + isObject (Object _) = True + isObject _ = False + +instance ToJSON ImageRepo where + toJSON (ImageRepo r t) = object [ r .= toJSON t ] + +instance FromJSON ImageRepositories where + parseJSON (Object v) = ImageRepositories <$> (mapM buildRepo $ H.toList v) + where + buildRepo (k,v') = ImageRepo k <$> parseJSON v' + parseJSON v = typeMismatch "ImageRepositories" v diff --git a/src/Data/Docker/Nix.hs b/src/Data/Docker/Nix.hs new file mode 100644 --- /dev/null +++ b/src/Data/Docker/Nix.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Docker.Nix +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +-- +-- This module only re-exports Nix modules providing Docker-specific +-- functionality as it pertains to generation of Nix expression. +---------------------------------------------------------------------------- + +module Data.Docker.Nix +( -- * Generate nix build instructions for a docker image + module Data.Docker.Nix.FetchDocker +) where + +import Data.Docker.Nix.FetchDocker diff --git a/src/Data/Docker/Nix/FetchDocker.hs b/src/Data/Docker/Nix/FetchDocker.hs new file mode 100644 --- /dev/null +++ b/src/Data/Docker/Nix/FetchDocker.hs @@ -0,0 +1,217 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Docker.Nix.FetchDocker +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Data.Docker.Nix.FetchDocker where + +import Control.Lens +import Control.Monad +import Control.Monad.Except as Except +import Data.Aeson.Lens +import qualified Data.Bifunctor as Bifunctor +import Data.Coerce +import Data.Fix +import Data.Maybe +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Text.Encoding (decodeUtf8') +import Data.Text.Encoding.Error +import Nix.Expr +import URI.ByteString + +import Data.Docker.Image.Types +import Data.Docker.Nix.Lib as Nix.Lib +import Hocker.Lib +import Network.Wreq.Docker.Registry (pluckLayersFrom) +import Hocker.Types +import Hocker.Types.Exceptions +import Hocker.Types.ImageTag + +{- Example output of the pretty-printed, generated Nix expression AST. +{ fetchdocker, fetchDockerConfig, fetchDockerLayer }: +fetchdocker rec { + name = "debian"; + registry = "https://registry-1.docker.io/v2/"; + repository = "library"; + imageName = "debian"; + tag = "latest"; + imageConfig = fetchDockerConfig { + inherit registry repository imageName tag; + sha256 = "1viqbygsz9547jy830f2lk2hcrxjf7gl9h1xda9ws5kap8yw50ry"; + }; + imageLayers = let + layer0 = fetchDockerLayer { + inherit registry repository imageName; + layerDigest = "10a267c67f423630f3afe5e04bbbc93d578861ddcc54283526222f3ad5e895b9"; + sha256 = "1fcmx3aklbr24qsjhm6cvmhqhmrxr6xlpq75mzrk0dj2gz36g8hh"; + }; + in [ layer0 ]; +} +-} + +-- | @fetchdocker@ function name. +constFetchdocker :: Text +constFetchdocker = "fetchdocker" + +-- | @fetchDockerConfig@ function name. +constFetchDockerConfig :: Text +constFetchDockerConfig = "fetchDockerConfig" + +-- | @fetchDockerLayer@ function name. +constFetchDockerLayer :: Text +constFetchDockerLayer = "fetchDockerLayer" + +-- | Generate a Nix expression AST from a @HockerImageMeta@ +-- record. +-- +-- This function checks that the supplied manifest JSON contains a key +-- in the top-level object describing what version of the manifest we +-- have. +generate :: HockerImageMeta -> IO (Either HockerException NExpr) +generate dim@HockerImageMeta{..} = runExceptT $ + case (manifestJSON ^? key "schemaVersion" . _Integer) of + Just 2 -> do + nixhash <- Hocker.Lib.findExec "nix-hash" + configDigest <- Nix.Lib.toBase32Nix nixhash . Base16Digest $ pluckedConfigDigest + layerDigests <- forM pluckedLayerDigests $ \d16 -> + (Base16Digest d16,) <$> (Nix.Lib.toBase32Nix nixhash $ Base16Digest d16) + + ExceptT (pure $ generateFetchDockerExpr dim configDigest layerDigests) + Just v -> + throwError $ HockerException ("Expected a version 2 manifest but got version " <> (show v)) Nothing Nothing + Nothing -> + throwError $ HockerException "No key 'schemaVersion' in JSON object" Nothing Nothing + + where + -- 'stripHashId' is necessary because digests in the manifest are + -- prefixed by the hash algorithm used to generate them + pluckedConfigDigest = Hocker.Lib.stripHashId $ manifestJSON ^. key "config" . key "digest" . _String + pluckedLayerDigests = Hocker.Lib.stripHashId <$> pluckLayersFrom manifestJSON + + + +{-| Generate a top-level Nix Expression AST from a 'HockerImageMeta' +record, a config digest, and a list of layer digests. + +The generated AST, pretty printed, may look similar to the following: + +> { fetchdocker, fetchDockerConfig, fetchDockerLayer }: +> fetchdocker rec { +> name = "debian"; +> registry = "https://registry-1.docker.io/v2/"; +> repository = "library"; +> imageName = "debian"; +> tag = "latest"; +> imageConfig = fetchDockerConfig { +> inherit registry repository imageName tag; +> sha256 = "1viqbygsz9547jy830f2lk2hcrxjf7gl9h1xda9ws5kap8yw50ry"; +> }; +> imageLayers = let +> layer0 = fetchDockerLayer { +> inherit registry repository imageName; +> layerDigest = "10a267c67f423630f3afe5e04bbbc93d578861ddcc54283526222f3ad5e895b9"; +> sha256 = "1fcmx3aklbr24qsjhm6cvmhqhmrxr6xlpq75mzrk0dj2gz36g8hh"; +> }; +> in [ layer0 ]; +> } +-} +generateFetchDockerExpr :: HockerImageMeta -> ConfigDigest -> [(Base16Digest, Base32Digest)] -> Either HockerException NExpr +generateFetchDockerExpr dim@HockerImageMeta{..} configDigest layerDigests = do + let commonInherits = + [ StaticKey "registry" + , StaticKey "repository" + , StaticKey "imageName" + ] + let genLayerId i = mkSym . Text.pack $ "layer" <> show i + let fetchconfig = mkFetchDockerConfig (inherit $ ((StaticKey "tag"):commonInherits)) configDigest + fetchlayers = + mkLets + (mkFetchDockerLayers (inherit commonInherits) layerDigests) + (mkList $ fmap genLayerId [0..(Prelude.length layerDigests)-1]) + fetchDockerExpr <- mkFetchDocker dim fetchconfig fetchlayers + pure + (mkFunction + (mkParamset + [ ("fetchdocker", Nothing) + , ("fetchDockerConfig", Nothing) + , ("fetchDockerLayer", Nothing) + ]) fetchDockerExpr) + +-- | Generate a @fetchdocker { ... }@ function call and argument +-- attribute set. Please see 'generateFetchDockerExpr' documentation +-- for an example of full output. +mkFetchDocker :: HockerImageMeta -> NExpr -> NExpr -> Either HockerException NExpr +mkFetchDocker HockerImageMeta{..} fetchconfig fetchlayers = do + registry <- Bifunctor.first mkHockerException serializedRegistry + pure + (mkApp (mkSym constFetchdocker) + (recAttrsE + [ ("name", mkStr $ fromMaybe imageName altImageName) + , ("registry", mkStr registry) + , ("repository", mkStr imageRepo) + , ("imageName", mkStr imageName) + , ("tag", mkStr (Text.pack $ coerce imageTag)) + , ("imageConfig", fetchconfig) + , ("imageLayers", fetchlayers) + ])) + where + serializedRegistry = decodeUtf8' (serializeURIRef' dockerRegistry) + mkHockerException (DecodeError err char) = + HockerException (err <> " " <> (show char)) Nothing Nothing + mkHockerException err = + HockerException (show err) Nothing Nothing + + +-- | Generate a @fetchDockerConfig { ... }@ function call and +-- argument attrset. +-- +-- This function takes an argument for a list of static keys to +-- inherit from the parent attribute set; it helps reduce the noise in +-- the output expression. +mkFetchDockerConfig :: Binding NExpr -> Base32Digest -> NExpr +mkFetchDockerConfig inherits (Base32Digest digest) = + mkApp (mkSym constFetchDockerConfig) + (Fix $ NSet [ inherits, "sha256" $= (mkStr digest) ]) + +-- | Generate a list of Nix expression ASTs representing +-- @fetchDockerLayer { ... }@ function calls. +-- +-- This function takes an argument for a list of static keys to +-- inherit from the parent attribute set; it helps reduce the noise in +-- the output expression. +-- +-- NB: the hash digest tuple in the second argument is the base16 +-- encoded hash digest plucked from the image's manifest JSON and a +-- @nix-hash@ base32 encoded copy. +-- +-- This is necessary because fixed output derivations require a +-- pre-computed hash (which we have, thanks to the manifest) and the +-- hash must be base32 encoded using @nix-hash@'s own base32 +-- encoding. The base16 encoded hash digest is needed intact in order +-- for the @fetchDockerLayer@ builder script (which calls the +-- @hocker-layer@ utility) to download the layer from a docker +-- registry. +mkFetchDockerLayers :: Binding NExpr -> [(Base16Digest, Base32Digest)] -> [Binding NExpr] +mkFetchDockerLayers inherits layerDigests = + fmap mkFetchLayer $ Prelude.zip [0..(Prelude.length layerDigests)] layerDigests + where + mkLayerId i = Text.pack $ "layer" <> show i + mkFetchLayer (i, ((Base16Digest d16), (Base32Digest d32))) = + (mkLayerId i) $= mkApp (mkSym constFetchDockerLayer) + (Fix $ NSet + [ inherits + , "layerDigest" $= (mkStr d16) -- Required in order to perform a registry request + , "sha256" $= (mkStr d32) -- Required by Nix for fixed output derivations + ]) diff --git a/src/Data/Docker/Nix/Lib.hs b/src/Data/Docker/Nix/Lib.hs new file mode 100644 --- /dev/null +++ b/src/Data/Docker/Nix/Lib.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE FlexibleContexts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Docker.Nix.Lib +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Data.Docker.Nix.Lib where + +import Control.Foldl as Foldl +import Turtle +import Control.Monad.Except as Except +import qualified Data.Text as Text + +import Hocker.Types +import Hocker.Types.Exceptions + +-- | Convert a 'Base16Digest' to a 'Base32Digest' using the @nix-hash@ +-- utility. +-- +-- NB: Nix implements its own custom base32 encoding function for +-- hashes that is not compatible with other more standard and native +-- implementations in Haskell. I opted to call out to @nix-hash@ +-- instead of re-implementing their algorithm because it's +-- non-standard and may change, creating a maintenance headache and +-- surprise behavior. +toBase32Nix :: (MonadIO m, Except.MonadError HockerException m) + => Prelude.FilePath -- ^ Path to the @nix-hash@ executable, see 'Lib.findExec' + -> Base16Digest -- ^ 'Base16Digest' to @base32@ encode + -> m Base32Digest +toBase32Nix nixhash (Base16Digest d16) = do + let hockerExc m = HockerException m Nothing Nothing + let convertDigest = + inprocWithErr + (Text.pack nixhash) + [ "--type" + , "sha256" + , "--to-base32" + , d16 + ] + Turtle.empty + + Turtle.fold convertDigest Foldl.head >>= \case + Nothing -> + throwError + (HockerException + "nothing was returned by `nix-hash', not even an error" + Nothing + Nothing) + Just result -> + either + (throwError . hockerExc . Text.unpack . lineToText) + (return . Base32Digest . lineToText) + result diff --git a/src/Hocker/Lib.hs b/src/Hocker/Lib.hs new file mode 100644 --- /dev/null +++ b/src/Hocker/Lib.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Hocker.Lib +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Hocker.Lib where + +import Control.Exception (throwIO) +import Control.Lens +import qualified Control.Monad.Except as Except +import Control.Monad.IO.Class (MonadIO (..)) +import qualified Crypto.Hash as Hash +import qualified Data.Aeson +import qualified Data.Aeson.Encode.Pretty as AP +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.Text (Text) +import qualified Data.Text as Text +import Data.Text.Encoding (encodeUtf8) +import qualified Network.Wreq as Wreq +import Nix.Expr (NExpr) +import Nix.Pretty +import System.Directory (findExecutable) +import System.Environment (getProgName) +import System.Exit as Exit +import System.FilePath.Posix as File +import Text.PrettyPrint.ANSI.Leijen as Text.PrettyPrint (SimpleDoc, + displayS, + renderPretty) +import URI.ByteString + +import Data.Docker.Image.Types +import Hocker.Types +import Hocker.Types.Exceptions +import Hocker.Types.ImageName +import Hocker.Types.ImageTag + +-- | Throw a 'userError', exiting the program with the supplied +-- message. +die :: MonadIO io => Text -> io a +die = liftIO . throwIO . userError . Text.unpack + +-- | Print an error message to stderr and return a non-zero exit code, +-- the message is prefixed with the name of the program. +exitProgFail :: String -> IO a +exitProgFail msg = do + name <- getProgName + Exit.die $ name ++ ": " ++ msg + +-- | Print the bytestring to stdout if the first argument is +-- @Nothing@, otherwise write the bytestring to the provided +-- filesystem path and print the path to stdout. +writeOrPrint :: Maybe FilePath -> C8L.ByteString -> IO () +writeOrPrint filepath content = maybe (C8L.putStrLn content) writeContent filepath + where + writeContent p = C8L.writeFile p content >> Prelude.putStrLn p + +-- | Combine an image name and a base path producing an output path. +mkOutImage :: ImageName -- ^ Docker image name + -> FilePath -- ^ Base path to write to + -> FilePath +mkOutImage n o = o (takeBaseName $ coerce n) + +-- | Combine an image name, an image tag, and a base path producing an +-- output path with a @-config.json@ suffix. +mkOutConfig :: ImageName -- ^ Docker image name + -> ImageTag -- ^ Docker image tag + -> FilePath -- ^ Base path to write to + -> FilePath +mkOutConfig n t o = o Prelude.concat + [ (takeBaseName $ coerce n) + , "_", coerce t + , "-config.json" + ] + +-- | Combine an image name, an image tag, and a base path producing an +-- output path with a @-manifest.json@ suffix. +mkOutManifest :: ImageName -- ^ Docker image name + -> ImageTag -- ^ Docker image tag + -> FilePath -- ^ Base path to write to + -> FilePath +mkOutManifest n t o = o Prelude.concat + [ (takeBaseName $ coerce n) + , "_", coerce t + , "-manifest.json" + ] + +-- | Join a list of strings and the path part of a 'RegistryURI' to +-- produce a new 'RegistryURI' with a path root of @/v2@. +joinURIPath :: [String] -- ^ Extra path segments to add + -> RegistryURI -- ^ Base URI to add path segments to + -> RegistryURI +joinURIPath pts uri@URI{..} = uri { uriPath = joinedParts } + where + joinedParts = C8.pack $ File.joinPath ("/":"v2":(C8.unpack uriPath):pts) + +-- | Given a 'Wreq.Auth' produce a 'Wreq.Options'. +opts :: Maybe Wreq.Auth -> Wreq.Options +opts bAuth = Wreq.defaults & Wreq.auth .~ bAuth + +-- | Hash a 'Data.ByteString.Lazy.Char8' using the 'Hash.SHA256' +-- algorithm. +sha256 :: C8L.ByteString -> Hash.Digest Hash.SHA256 +sha256 = Hash.hashlazy + +-- | Strip the @sha256:@ identifier prefix from a hash digest. +stripHashId :: Text -> Text +stripHashId = snd . Text.breakOnEnd ":" + +-- | Encode, following Docker's canonical JSON rules, any 'ToJSON' +-- data type. +-- +-- The canonicalization rules enable consistent hashing of encoded +-- JSON, a process relied upon heavily by docker for content +-- addressability and unique identification of resources within a +-- docker registry. Notably, an image's config JSON file and layers. +-- +-- NB: +-- intentionally *does not* follow the 's +-- Canonical JSON format even though it was inspired by it. +encodeCanonical :: Data.Aeson.ToJSON a => a -> C8L.ByteString +encodeCanonical = AP.encodePretty' conf + where + conf = AP.defConfig { AP.confIndent = AP.Spaces 0, AP.confCompare = compare } + +-- | Throw an error if the first argument is @Nothing@, otherwise +-- return the @FilePath@ unwrapped. +requirePath :: (Except.MonadError HockerException m) + => Maybe FilePath + -> m (FilePath) +requirePath = maybe pathError pure + where + pathError = + Except.throwError + (hockerException "To fetch and assemble a docker image, '--out=' must be supplied") + +-- | Pluck out the digest value for the config JSON given a docker +-- registry image manifest. Attempting to parse and return the digest +-- value as a 'Hash.SHA256', otherwise throw an error. +getConfigDigest :: (Except.MonadError HockerException m) + => C8L.ByteString + -> m (Hash.Digest Hash.SHA256) +getConfigDigest (view (key "config" . key "digest" . _String) -> digest) = + maybe badDigest return parsedDigest + where + parsedDigest = toDigest $ encodeUtf8 digest + badDigest = Except.throwError $ hockerException "Failed parsing the config hash digest" + + + +-- | Split a docker image's name on the forward slash separator so we +-- get the distinct repo name and image name. +splitRepository :: ImageName -> (RepoNamePart, ImageNamePart) +splitRepository (ImageName (Text.pack -> n)) = over _2 Text.tail $ Text.break (=='/') n + +-- | Given a nix expression AST, produce a pretty printer document. +renderNixExpr :: NExpr -> Text.PrettyPrint.SimpleDoc +renderNixExpr = renderPretty 0.4 120 . prettyNix + +-- | Print a nix expression AST using the 'renderNixExpr' pretty +-- printing renderer. +pprintNixExpr :: NExpr -> IO () +pprintNixExpr expr = Prelude.putStrLn (displayS (renderNixExpr expr) "") + +-- | Given an executable's name, try to find it in the PATH. +findExec :: (MonadIO m, Except.MonadError HockerException m) + => String + -> m Prelude.FilePath +findExec execname = (liftIO $ findExecutable execname) >>= \case + Just v -> return v + Nothing -> Except.throwError $ + HockerException + ("cannot find executable `" <> execname <> "'") + Nothing + Nothing diff --git a/src/Hocker/Types.hs b/src/Hocker/Types.hs new file mode 100644 --- /dev/null +++ b/src/Hocker/Types.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS -fno-warn-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Hocker.Types +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Hocker.Types where + +import Control.Applicative +import Control.Monad.Error.Class +import qualified Control.Monad.Except as Except +import Control.Monad.IO.Class +import qualified Control.Monad.Reader as Reader +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.Text (Text) +import qualified Data.Text as Text +import qualified Network.Wreq as Wreq +import Network.Wreq.ErrorHandling +import qualified Options.Applicative as Options +import Options.Generic +import URI.ByteString + +import Hocker.Types.Exceptions +import Hocker.Types.Hash () +import Hocker.Types.ImageName +import Hocker.Types.ImageTag +import Hocker.Types.URI () + +-- | Docker registry URI. +type RegistryURI = (URIRef Absolute) + +-- | Docker registry username. +type Username = Text + +-- | Docker registry user password. +type Password = Text + +-- | Docker image layer sha256 hash digest. +type Layer = Text + +-- | SHA256 hash digest with the hash algorithm identifier prefix, +-- stripped +type StrippedDigest = Text + +-- | Docker image manifest JSON. +type Manifest = Data.ByteString.Lazy.ByteString + +-- | Docker image config JSON. +type ImageConfigJSON = Data.ByteString.Lazy.ByteString + +-- | Wreq response type parameterized by the lazy bytestring type. +type RspBS = Wreq.Response Data.ByteString.Lazy.ByteString + +-- | A file extension. +type Extension = String + +-- | RepoName is the part before the forward slash in a docker image +-- name, e.g: @library@ in @library/debian@ +type RepoNamePart = Text + +-- | ImageName is the part after the forward slash in a docker image +-- name, e.g: @library@ in @library/debian@ +type ImageNamePart = Text + +-- | Docker image config JSON file's sha256 hash digest in Nix's +-- base32 encoding. +-- +-- NB: it's very important to realize there's a significant difference +-- between Nix's base32 encoding and the standard base32 encoding! +-- (i.e, they're not compatible). +type ConfigDigest = Base32Digest + +-- | Generic top-level optparse-generic CLI args data type and +-- specification. +-- +-- NOTE: `hocker-layer` does not use this data type because it +-- requires an additional layer sha256 hash digest argument. +data Options w = Options + { -- | URI for the registry, optional + registry :: w ::: Maybe RegistryURI + "URI of registry, defaults to the Docker Hub registry" + , credentials :: Maybe Credentials + -- | Filesystem path to write output to + , out :: w ::: Maybe FilePath + "Write content to location" + -- | Docker image name (includes the reponame, e.g: library/debian) + , imageName :: ImageName + -- | Docker image tag + , imageTag :: ImageTag + } deriving (Generic) + +instance ParseRecord (Options Wrapped) +deriving instance Show (Options Unwrapped) + +-- | Hocker 'ExceptT' and 'ReaderT' transformer stack threading a +-- 'HockerMeta' data type. +newtype Hocker a = Hocker { unHocker :: Reader.ReaderT HockerMeta (Except.ExceptT HockerException IO) a } + deriving + ( Functor + , Applicative + , Monad + , MonadIO + , MonadReader HockerMeta + , MonadError HockerException + ) + +runHocker :: Hocker a -> HockerMeta -> IO (Either HockerException a) +runHocker (unHocker -> d) = Except.runExceptT . interceptHttpExc . Reader.runReaderT d + +-- | Red wagon record carrying around the environment as we fetch, +-- transform, and assemble docker image artifacts. +data HockerMeta = HockerMeta + { dockerRegistry :: RegistryURI + , auth :: Maybe Wreq.Auth + , imageName :: ImageName + , imageTag :: ImageTag + , out :: Maybe FilePath + , outDir :: Maybe FilePath + , imageLayer :: Maybe (Hash.Digest Hash.SHA256) + } deriving (Show) + +-- | Newtype base32 encoding of a hash digest. +-- +-- Please note, this base32 encoding is unique to Nix and not +-- compatible with other base32 encodings. +newtype Base32Digest = Base32Digest Text + deriving (Show, Read, Eq) + +-- | Newtype base16 encoding of a hash digest. +-- +-- This encoding has no known idiosyncracies specific to Nix, it +-- should be compatible with other tools and library's expectations. +newtype Base16Digest = Base16Digest Text + deriving (Show, Read, Eq) + +data Credentials = Basic Username Password | BearerToken Text + deriving (Show) + +instance ParseField Credentials where + parseField _ _ _ = (Basic <$> parseUsername <*> parsePassword) <|> (BearerToken <$> parseToken) + where + parseUsername = Text.pack <$> + (Options.option Options.str $ + ( Options.metavar "BASIC USERNAME" + <> Options.long "username" + <> Options.short 'u' + <> Options.help "Username part of a basic auth credential" + ) + ) + parsePassword = Text.pack <$> + (Options.option Options.str $ + ( Options.metavar "BASIC PASSWORD" + <> Options.long "password" + <> Options.short 'p' + <> Options.help "Password part of a basic auth credential" + ) + ) + parseToken = Text.pack <$> + (Options.option Options.str $ + ( Options.metavar "BEARER TOKEN" + <> Options.long "token" + <> Options.short 't' + <> Options.help "Bearer token retrieved from a call to `docker login` (mutually exclusive to --username and --password)" + ) + ) + +instance ParseFields Credentials +instance ParseRecord Credentials where + parseRecord = fmap Options.Generic.getOnly parseRecord + +-- | @upperFirst@ uppercases the first letter of the string. +upperFirst :: String -> String +upperFirst [] = [] +upperFirst (h:t) = toUpper h : t diff --git a/src/Hocker/Types/Exceptions.hs b/src/Hocker/Types/Exceptions.hs new file mode 100644 --- /dev/null +++ b/src/Hocker/Types/Exceptions.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Hocker.Types.Exceptions +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Hocker.Types.Exceptions where + +import Control.DeepSeq +import Control.Exception +import Data.Monoid +import GHC.Generics + +data HockerException = HockerException + { baseMsg :: String + , expected :: Maybe String + , received :: Maybe String + } deriving (Read, Generic, NFData) + +instance Exception HockerException +instance Show HockerException where + show (HockerException m e r) = m <> (ext $ e <> r) + where + ext (Just v) = "; " <> v + ext Nothing = mempty + +hockerException :: String -> HockerException +hockerException m = HockerException m Nothing Nothing diff --git a/src/Hocker/Types/Hash.hs b/src/Hocker/Types/Hash.hs new file mode 100644 --- /dev/null +++ b/src/Hocker/Types/Hash.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS -fno-warn-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Hocker.Types.Hash +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Hocker.Types.Hash where + +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 qualified Data.Text +import qualified Options.Applicative as Options +import Options.Generic + +toBytes :: C8.ByteString -> Either String BA.Bytes +toBytes = BA.convertFromBase BA.Base16 + +readSHA256 :: C8.ByteString -> Maybe (Hash.Digest Hash.SHA256) +readSHA256 = either (const Nothing) Hash.digestFromByteString . toBytes + +instance ParseField (Hash.Digest Hash.SHA256) where + parseField h _ _ = + (Options.option (Options.maybeReader (readSHA256 . C8.pack)) $ + ( Options.metavar "SHA256" + <> Options.short 'l' + <> Options.long "layer" + <> maybe mempty (Options.help . Data.Text.unpack) h + ) + ) + +instance ParseFields (Hash.Digest Hash.SHA256) where +instance ParseRecord (Hash.Digest Hash.SHA256) where + parseRecord = fmap getOnly parseRecord diff --git a/src/Hocker/Types/ImageName.hs b/src/Hocker/Types/ImageName.hs new file mode 100644 --- /dev/null +++ b/src/Hocker/Types/ImageName.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS -fno-warn-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Hocker.Types.ImageName +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Hocker.Types.ImageName where + +import Control.DeepSeq +import Data.Monoid +import qualified Options.Applicative as Options +import Options.Generic + +newtype ImageName = ImageName { unImageName :: String } + deriving (Generic, Show) + +instance ParseField ImageName where + parseField _ _ _ = + ImageName <$> + (Options.argument Options.str $ + ( Options.metavar "IMAGE-NAME" + <> Options.help "Docker image name, e.g: 'debian' in debian:jessie" + ) + ) + +instance ParseFields ImageName where +instance ParseRecord ImageName where + parseRecord = fmap getOnly parseRecord + +instance NFData ImageName diff --git a/src/Hocker/Types/ImageTag.hs b/src/Hocker/Types/ImageTag.hs new file mode 100644 --- /dev/null +++ b/src/Hocker/Types/ImageTag.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS -fno-warn-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Hocker.Types.ImageTag +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Hocker.Types.ImageTag where + +import Control.DeepSeq +import Data.Monoid +import qualified Options.Applicative as Options +import Options.Generic + +newtype ImageTag = ImageTag { unImageTag :: String } + deriving (Generic, Show) + +instance ParseField ImageTag where + parseField _ _ _ = + ImageTag <$> + (Options.argument Options.str $ + ( Options.metavar "IMAGE-TAG" + <> Options.help "Docker image tag identifier, e.g: 'jessie' in debian:jessie" + ) + ) + +instance ParseFields ImageTag where +instance ParseRecord ImageTag where + parseRecord = fmap getOnly parseRecord + +instance NFData ImageTag diff --git a/src/Hocker/Types/URI.hs b/src/Hocker/Types/URI.hs new file mode 100644 --- /dev/null +++ b/src/Hocker/Types/URI.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS -fno-warn-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Hocker.Types.URI +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Hocker.Types.URI where + +import Control.Lens +import qualified Data.ByteString.Char8 as C8 +import Data.Monoid +import qualified Data.Text as Text +import qualified Options.Applicative as Options +import Options.Applicative.Builder +import Options.Generic +import URI.ByteString + +-- | Parse a URI value. +uriReader :: ReadM (URIRef Absolute) +uriReader = Options.eitherReader parseURIArg + where + parseURIArg (parseURI strictURIParserOptions . C8.pack -> parsedURI) = + over _Left show parsedURI + +instance ParseField (URIRef Absolute) where + parseField h n s = + (Options.option uriReader $ + ( Options.metavar "URI" + <> foldMap (Options.long . Text.unpack) n + <> foldMap Options.short s + <> foldMap (Options.help . Text.unpack) h + ) + ) + +instance ParseFields (URIRef Absolute) where +instance ParseRecord (URIRef Absolute) where + parseRecord = fmap getOnly parseRecord diff --git a/src/Network/Wreq/Docker/Image.hs b/src/Network/Wreq/Docker/Image.hs new file mode 100644 --- /dev/null +++ b/src/Network/Wreq/Docker/Image.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Network.Wreq.Docker.Image +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Network.Wreq.Docker.Image where + + +import Control.Lens +import Control.Monad +import Control.Monad.Except +import Control.Monad.Reader +import Data.ByteString.Lazy.Char8 as C8L +import Data.Coerce +import Data.Either +import Data.HashSet as Set +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as Text +import NeatInterpolation +import qualified Network.Wreq as Wreq +import System.FilePath.Posix as File +import System.Terminal.Concurrent + +import Data.Docker.Image.Types +import Hocker.Lib + +import Network.Wreq.Docker.Image.Lib as Docker.Image +import Network.Wreq.Docker.Registry as Docker.Registry +import Hocker.Types +import Hocker.Types.Exceptions +import Hocker.Types.ImageName + +-- | Fetch an image from the docker registery, assembling the +-- artifacts into a Docker V1.2 Image. +fetchImage :: HockerMeta -> IO (Either HockerException Text) +fetchImage = + runHocker $ ask >>= \HockerMeta{..} -> do + imageOutDir <- Hocker.Lib.requirePath outDir + manifest <- fetchManifest >>= checkResponseIntegrity' + configDigest <- getConfigDigest $ manifest ^. Wreq.responseBody + + -- TODO: use Managed + + -- Fetch and write the configuration json file for the image + let configFileHash = Hocker.Lib.stripHashId . Text.pack $ showSHA configDigest + imageConfig <- fetchImageConfig configDigest + imageConfigFile <- writeRespBody + (File.joinPath [imageOutDir, Text.unpack configFileHash] `addExtension` "json") + configFileHash + imageConfig + + let refLayers = pluckRefLayersFrom $ imageConfig ^. Wreq.responseBody + refLayers' = fmap Hocker.Lib.stripHashId refLayers + refLayerSet = Set.fromList refLayers' + manifestLayers = pluckLayersFrom $ manifest ^. Wreq.responseBody + (_, strippedReg) = Text.breakOnEnd "//" . Text.pack . show $ dockerRegistry + repoTags = (Text.unpack strippedReg) (coerce imageName) + + -- Concurrently fetch layers and write to disk with a limit of three + -- threads + layers <- mapPool 3 Docker.Image.fetchLayer $ Prelude.zip refLayers' manifestLayers + + let writtenLayerSet = Set.fromList . fmap (Text.pack . takeBaseName) $ rights layers + refLayerSetTxt = Text.pack (show refLayerSet) + wrtLayerSetTxt = Text.pack (show writtenLayerSet) + dffLayerSetTxt = Text.pack (show $ Set.difference refLayerSet writtenLayerSet) + + when (writtenLayerSet /= refLayerSet) $ + throwError . hockerException $ Text.unpack + ([text| +Written layers do not match the reference layers! + +Reference layers: ${refLayerSetTxt} +Written layers: ${wrtLayerSetTxt} + +Difference: ${dffLayerSetTxt} +|]) + + createImageRepository repoTags refLayers' + createImageManifest repoTags imageConfigFile refLayers' + + archivePath <- createImageTar + + return (Text.pack archivePath) + +-- | Fetch a layer using its digest key from the docker registery. +fetchLayer :: HockerMeta -> IO (Either HockerException FilePath) +fetchLayer = + runHocker $ ask >>= \HockerMeta{..} -> do + layerOut <- Hocker.Lib.requirePath out + layerDigest <- Text.pack . show <$> maybe + (throwError $ hockerException + "a layer digest is expected!") + return + imageLayer + + let shortRef = Text.take 7 layerDigest + + writeC <- liftIO $ getConcurrentOutputter + liftIO . writeC . Text.unpack $ "Downloading layer: " <> shortRef + + fetchedImageLayer <- checkResponseIntegrity' =<< Docker.Registry.fetchLayer ("sha256:" <> layerDigest) + layerPath <- writeRespBody layerOut layerDigest fetchedImageLayer + + liftIO . writeC $ Text.unpack ("=> wrote " <> shortRef) + + return layerPath + +-- | Fetch the configuration JSON file of the specified image from the +-- docker registry. +fetchConfig :: HockerMeta -> IO (Either HockerException C8L.ByteString) +fetchConfig = + runHocker $ ask >>= \HockerMeta{..} -> do + configDigest <- + fetchManifest + >>= checkResponseIntegrity' + >>= getConfigDigest . view Wreq.responseBody + + fetchImageConfig configDigest + >>= return . view Wreq.responseBody + +-- | Fetch the docker registry manifest JSON file for the specified +-- image from the docker registry.. +fetchImageManifest :: HockerMeta -> IO (Either HockerException C8L.ByteString) +fetchImageManifest = runHocker (fetchManifest >>= return . view Wreq.responseBody) diff --git a/src/Network/Wreq/Docker/Image/Lib.hs b/src/Network/Wreq/Docker/Image/Lib.hs new file mode 100644 --- /dev/null +++ b/src/Network/Wreq/Docker/Image/Lib.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Network.Wreq.Docker.Image.Lib +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Network.Wreq.Docker.Image.Lib where + +import qualified Codec.Archive.Tar as Tar +import qualified Codec.Compression.GZip as GZip +import qualified Control.Concurrent.PooledIO.Final as Pool +import Control.Lens +import Control.Monad.Except +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 qualified Data.Text as Text +import qualified Network.Wreq as Wreq +import qualified System.Directory as Directory +import System.FilePath.Posix as File +import System.Terminal.Concurrent + +import Data.Docker.Image.Types +import Hocker.Lib +import Network.Wreq.Docker.Registry as Docker.Registry +import Hocker.Types +import Hocker.Types.Exceptions +import Hocker.Types.ImageTag + +-- | Like @mapM@ but concurrently apply a function to the elements of +-- the @Traversable@, limiting the maximum number of worker threads by +-- _n_. +mapPool :: Traversable t + => Int -- ^ Number of pooled worker threads + -> ((String -> IO ()) -> a -> Hocker FilePath) -- ^ Processing function + -> t a -- ^ A Traversable container + -> Hocker (t (Either HockerException FilePath)) +mapPool n f l = do + env <- ask + writeC <- liftIO getConcurrentOutputter + let f' v = (runHocker (f writeC v) env) + + -- TODO: because I'm re-wrapping the function traversing the + -- traversable, I need to extract the Left's from the result and + -- propagate an error up with @throwError@ from this function. + -- + -- TODO: refactor this such that the previous TODO is unnecessary. + liftIO . Pool.runLimited n $ traverse (Pool.fork . f') l + +-- | Like @mapPool@ but with the arguments flipped. +forPool :: Traversable t + => Int -- ^ Number of pooled worker threads + -> t a -- ^ A Traversable container + -> ((String -> IO ()) -> a -> Hocker FilePath) -- ^ Processing function + -> Hocker (t (Either HockerException FilePath)) +forPool n = flip $ mapPool n + +-- | Download, verify, decompress, and write a docker container image +-- layer to the filesystem. +fetchLayer :: (String -> IO ()) -- ^ Concurrent terminal output function + -> (RefLayer, Layer) -- ^ A tuple of the reference layer hash digest from the image's config JSON and hash digest from the image's manifest JSON + -> Hocker FilePath +fetchLayer writeC layer@(refl, (stripHashId -> layer')) = ask >>= \HockerMeta{..} -> do + liftIO . writeC . Text.unpack $ "Downloading layer: " <> (Text.take 7 layer') + + fetchedImageLayer <- checkResponseIntegrity' =<< (Docker.Registry.fetchLayer $ snd layer) + + let decompressed = fetchedImageLayer & Wreq.responseBody %~ GZip.decompress + shortRef = Text.take 7 refl + + imageOutDir <- Hocker.Lib.requirePath outDir + + liftIO $ writeC " => decompressed " + + let layerOutPath = File.joinPath [imageOutDir, Text.unpack refl] `addExtension` "tar" + layerPath <- writeRespBody layerOutPath refl decompressed + + liftIO . writeC $ Text.unpack ("=> wrote " <> shortRef) + + return layerPath + +-- | Generate a @manifest.json@ file. +createImageManifest :: RepoTag -- ^ e.g: registry.mydomain.net:5001/reponame/imagename + -> FilePath -- ^ Path of image config file for manifest + -> [RefLayer] -- ^ Layer hash digests sourced from the image's config JSON + -> Hocker () +createImageManifest repoTag imageConfigFile refls = ask >>= \HockerMeta{..} -> do + let imageManifest = [ + ImageManifest + (takeBaseName imageConfigFile `addExtension` "json") + [Text.pack (repoTag ++ ":" ++ coerce imageTag)] + (fmap ((`addExtension` "tar") . Text.unpack) refls) ] + imageOutDir <- Hocker.Lib.requirePath outDir + liftIO $ C8L.writeFile + (imageOutDir "manifest" `addExtension` "json") + (Hocker.Lib.encodeCanonical imageManifest) + +-- | Generate a @repositories@ json file. +-- +-- NB: it is JSON but Docker doesn't want it a @.json@ extension +-- unlike its sibling the @manifest.json@ file. +createImageRepository :: RepoTag -- ^ e.g: registry.mydomain.net:5001/reponame/imagename + -> [RefLayer] -- ^ Layer hash digests sourced from the image's configuration JSON + -> Hocker () +createImageRepository repoTag refls = ask >>= \HockerMeta{..} -> do + let repositories = + ImageRepo + (Text.pack repoTag) + + -- Create a singleton map from a tag and the "latest" layer; + -- Aeson will correctly encode this as an object with a key + -- (the tag) and value (the layer within the archive named + -- by its hash digest) + (HashMap.singleton + (Text.pack $ coerce imageTag) + ((Prelude.last refls) <> ".tar")) + imageOutDir <- Hocker.Lib.requirePath outDir + liftIO $ C8L.writeFile + (imageOutDir "repositories") + (Hocker.Lib.encodeCanonical repositories) + +-- | Tar and gzip the output dir into the final docker image archive +-- and remove the output dir. +createImageTar :: Hocker FilePath +createImageTar = ask >>= \HockerMeta{..} -> do + imageOutDir <- Hocker.Lib.requirePath outDir + archivePath <- Hocker.Lib.requirePath out + + entries <- liftIO $ Directory.getDirectoryContents imageOutDir + + -- TODO: remove once we have a newer `directory` + let entriesToPack = [e | e <- entries, e /= ".", e /= ".."] + + liftIO $ Tar.create archivePath imageOutDir entriesToPack + + -- Cleanup after ourselves + liftIO $ Directory.removeDirectoryRecursive imageOutDir + + return $ archivePath diff --git a/src/Network/Wreq/Docker/Registry.hs b/src/Network/Wreq/Docker/Registry.hs new file mode 100644 --- /dev/null +++ b/src/Network/Wreq/Docker/Registry.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE FlexibleContexts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Network.Wreq.Docker.Registry +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +-- +-- Convenience functions for interacting with an instance of Docker +-- Distribution (Docker Registry V2). I've kept the module naming +-- consistent with the docker registry terms since that appears to be +-- what everyone uses colloquially even though the formal name for the +-- software is "docker distribution". +---------------------------------------------------------------------------- + +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 +import qualified Data.ByteString.Char8 as C8 +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import URI.ByteString +import NeatInterpolation +import qualified Data.Text as Text +import qualified Network.Wreq as Wreq +import System.Directory + +import Data.Docker.Image.Types +import Hocker.Lib +import Hocker.Types +import Hocker.Types.Exceptions +import Hocker.Types.ImageName +import Hocker.Types.ImageTag + +-- | Default docker hub registry (@https://registry-1.docker.io/v2/@). +defaultRegistry :: URIRef Absolute +defaultRegistry = URI + { uriScheme = Scheme "https" + , uriAuthority = Just $ Authority + { authorityUserInfo = Nothing + , authorityHost = Host "registry-1.docker.io" + , authorityPort = Nothing + } + , uriPath = "/v2/" + , uriQuery = Query [] + , uriFragment = Nothing + } + +-- | Given 'Credentials', produce a 'Wreq.Auth'. +-- +-- 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 +-- token, assuming the request we want to make is to the public docker +-- hub and without any other credentials. +-- +-- Otherwise, return 'Nothing' so that an unauthenticated request can +-- be made. +mkAuth :: RegistryURI -- ^ Docker registry + -> ImageName -- ^ Docker image name + -> Maybe Credentials -- ^ Docker registry authentication credentials + -> IO (Maybe Wreq.Auth) +mkAuth reg (ImageName img) credentials = + case credentials of + Just (BearerToken token) + -> pure (Just $ Wreq.oauth2Bearer (encodeUtf8 token)) + Just (Basic username password) + -> pure (Just $ Wreq.basicAuth (encodeUtf8 username) (encodeUtf8 password)) + Nothing | reg /= defaultRegistry + -> pure Nothing + | otherwise + -> getHubToken >>= pure . mkHubBearer + where + getHubToken = Wreq.get ("https://auth.docker.io/token?service=registry.docker.io&scope=repository:"<>img<>":pull") + mkHubBearer rsp = (Wreq.oauth2Bearer . encodeUtf8) <$> (rsp ^? Wreq.responseBody . key "token" . _String) + +-- | Retrieve a list of layer hash digests from a docker registry +-- image manifest JSON. +-- +-- TODO: pluck out the layer's size and digest into a tuple. +pluckLayersFrom :: Manifest -> [Layer] +pluckLayersFrom = toListOf (key "layers" . values . key "digest" . _String) + +-- | Retrieve a list of layer hash digests from an image's +-- configuration JSON. +-- +-- This is subtly different from 'pluckLayersFrom' because both list +-- hash digests for the image's layers but the manifest's layer hash +-- digests are keys into the registry's blob storage referencing +-- _compressed_ layer archives. The configuration JSON's layer hash +-- digests reference the uncompressed layer tar archives within the +-- image. +pluckRefLayersFrom :: ImageConfigJSON -> [Layer] +pluckRefLayersFrom = toListOf (key "rootfs" . key "diff_ids" . values . _String) + +----------------------------------------------------------------------------- +-- Top-level docker-registry V2 REST interface functions + +-- | Request a V2 registry manifest for the specified docker image. +fetchManifest :: Hocker RspBS +fetchManifest = ask >>= \HockerMeta{..} -> + liftIO $ Wreq.getWith (opts auth & accept) (mkURL imageName imageTag dockerRegistry) + where + mkURL (ImageName n) (ImageTag t) r = C8.unpack (serializeURIRef' $ Hocker.Lib.joinURIPath [n, "manifests", t] r) + accept = Wreq.header "Accept" .~ + [ "application/vnd.docker.distribution.manifest.v2+json" + , "application/vnd.docker.distribution.manifest.list.v2+json" + ] + +-- | Retrieve the configuratino JSON of an image by its hash digest +-- (found in the V2 manifest for an image given by a name and a tag). +fetchImageConfig :: (Hash.Digest Hash.SHA256) -> Hocker RspBS +fetchImageConfig (showSHA -> digest) = ask >>= \HockerMeta{..} -> + liftIO $ Wreq.getWith (opts auth) (mkURL imageName dockerRegistry) + where + 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 +fetchLayer layer = ask >>= \HockerMeta{..} -> + liftIO $ Wreq.getWith (opts auth) (mkURL layer imageName dockerRegistry) + where + mkURL + (Text.unpack -> digest) + (ImageName name) + registry + = C8.unpack (serializeURIRef' $ joinURIPath [name, "blobs", digest] registry) + +-- | Write a 'Wreq.responseBody' to the specified 'FilePath', checking +-- the integrity of the file with its sha256 hash digest. +-- +-- The second argument, the 'StrippedDigest', must be a hash digest +-- stripped of the @sha256:@ algorithm identifier prefix. +writeRespBody :: FilePath -- ^ Filesystem path to write the content to + -> StrippedDigest -- ^ Hash digest, stripped of its algorithm identifier prefix + -> RspBS -- ^ Wreq lazy bytestring response object + -> Hocker FilePath +writeRespBody out digest resp = do + liftIO . C8L.writeFile out $ resp ^. Wreq.responseBody + verified <- liftIO (checkFileIntegrity out digest) + either (Except.throwError . hockerException) return verified + +-- | Write a response to the filesystem without a request hash +-- digest. Attempt to fetch the value of the @ETag@ header to verify +-- the integrity of the content received. +-- +-- The Docker docs do _not_ recommended this method for verification +-- because the @ETag@ and @Docker-Content-Digest@ headers may change +-- between the time you issue a request with a digest and when you +-- receive a response back! +-- +-- We do it anyway and leave this warning. +writeRespBody' :: FilePath -- ^ Filesystem path to write the content to + -> RspBS -- ^ Wreq lazy bytestring response object + -> Hocker FilePath +writeRespBody' out r = writeRespBody out etagHash r + where + etagHash = decodeUtf8 $ r ^. Wreq.responseHeader "ETag" + +-- | Compute a sha256 hash digest of the response body and compare it +-- against the supplied hash digest. +checkResponseIntegrity :: (Except.MonadError HockerException m) + => RspBS -- ^ Wreq lazy bytestring response object + -> StrippedDigest -- ^ Hash digest, stripped of its hash algorithm identifier prefix + -> m RspBS +checkResponseIntegrity r d = do + let contentHash = show . Hocker.Lib.sha256 $ r ^. Wreq.responseBody + digestHash = Text.unpack d + if | contentHash == digestHash -> pure r + | otherwise -> + let chTxt = Text.pack contentHash + dgTxt = Text.pack digestHash + in Except.throwError + (hockerException + (Text.unpack [text| + Response content hash is $chTxt + and it does not match the addressable content hash + $dgTxt + |])) + +-- | Compute a sha256 hash digest of the response body and compare it +-- against the @Docker-Content-Digest@ header from the response. +-- +-- The Docker docs do *not* recommended this method for verification +-- because the Docker-Content-Digest header may change between the +-- time you issue a request with a digest and when you receive a +-- response back! +-- +-- NB: some registries do not send a @Docker-Content-Digest@ header, +-- I'm not sure yet what the cause for this is but this function's +-- behavior lacking that information is to ignore the hash check. +checkResponseIntegrity' :: (Except.MonadError HockerException m) + => RspBS -- ^ Wreq lazy bytestring response object + -> m RspBS +checkResponseIntegrity' rsp = + case decodeUtf8 (rsp ^. Wreq.responseHeader "Docker-Content-Digest") of + -- Since some registries may send back no Docker-Content-Digest + -- header, or an empty one, if it is empty then ignore it + "" -> pure rsp + digest -> checkResponseIntegrity rsp (Hocker.Lib.stripHashId digest) + +-- | Compute a sha256 hash digest for a file and compare that hash to +-- the supplied hash digest. +checkFileIntegrity :: FilePath -- ^ Filesystem path of file to verify + -> StrippedDigest -- ^ Hash digest, stripped of its hash algorithm identifier prefix + -> IO (Either String FilePath) +checkFileIntegrity fp digest = + Except.runExceptT $ do + exists <- liftIO (doesFileExist fp) + when (not exists) $ + fail (fp <> " does not exist") + + fileHash <- liftIO (return . show . Hocker.Lib.sha256 =<< C8L.readFile fp) + + when (Text.unpack digest /= fileHash) $ + let fhTxt = Text.pack fileHash + fpTxt = Text.pack fp + in fail $ Text.unpack + ([text| +The sha256 hash for $fpTxt: $fhTxt +Does not match the expected digest: $digest +|]) + return fp diff --git a/src/Network/Wreq/ErrorHandling.hs b/src/Network/Wreq/ErrorHandling.hs new file mode 100644 --- /dev/null +++ b/src/Network/Wreq/ErrorHandling.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Network.Wreq.ErrorHandling +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Network.Wreq.ErrorHandling where + +import Control.Exception.Lifted as Lifted +import Control.Lens +import Control.Monad.Except +import Data.ByteString.Char8 as C8 +import Data.Monoid +import Network.HTTP.Client +import Network.HTTP.Types.Status + +#if !MIN_VERSION_http_client(0,5,0) +import Data.HashMap.Lazy as H +#endif + +import Hocker.Types.Exceptions + +interceptHttpExc :: ExceptT HockerException IO a + -> ExceptT HockerException IO a +interceptHttpExc a = Lifted.try a >>= except . over _Left prettify + where + except (Left e) = throwError e + except (Right v) = return v + +prettify :: HttpException -> HockerException +#if MIN_VERSION_http_client(0,5,0) +prettify + (HttpExceptionRequest _ + (StatusCodeException + (responseStatus -> (Status code msg)) body)) + = HockerException + (show code <> " " <> C8.unpack msg) + (Just $ C8.unpack body) + Nothing +#else +prettify + (StatusCodeException (Status code msg) (H.fromList -> e) _) + = HockerException + ((show code) <> " " <> C8.unpack msg) + (C8.unpack <$> H.lookup "X-Response-Body-Start" e) + Nothing +#endif + +prettify e = HockerException (show e) Nothing Nothing diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,17 @@ + +module Main where + +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Tests.Data.Docker.Image as Docker.Image +import qualified Tests.Data.Docker.Nix.FetchDocker as FetchDockerTests + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Tests" + [ Docker.Image.unitTests + , FetchDockerTests.tests + ] diff --git a/test/Tests/Data/Docker/Image.hs b/test/Tests/Data/Docker/Image.hs new file mode 100644 --- /dev/null +++ b/test/Tests/Data/Docker/Image.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Docker.Image +-- Copyright : (C) 2016 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Tests.Data.Docker.Image where + +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as C8L +import Data.Docker.Image.Types +import Data.HashMap.Strict as H +import Test.Tasty +import Test.Tasty.HUnit + +import Hocker.Lib + +----------------------------------------------------------------------------- +-- +unitTests = testGroup "V1.2 Image Tests" + [ testCase "ImageManifest golden encoding" testImageManifestGoldenEncoding + , testCase "ImageManifest two-way encoding" testImageManifestTwoWayEncoding + , testCase "ImageRepositories golden encoding" testImageRepositoriesGoldenEncoding + , testCase "ImageRepositories two-way encoding" testImageRepositoriesTwoWayEncoding + ] + +----------------------------------------------------------------------------- +-- TESTS + +testImageManifestGoldenEncoding = + let goldenStr = "[{\"Config\":\"3e83c23dba6a16cd936a3dc044df71b26706c5a4c28181bc3ca4a4af9f5f38ee.json\",\"Layers\":[\"10a267c67f423630f3afe5e04bbbc93d578861ddcc54283526222f3ad5e895b9/layer.tar\"],\"RepoTags\":[\"library/debian:jessie\"]}]" + imgManifest = [ImageManifest + "3e83c23dba6a16cd936a3dc044df71b26706c5a4c28181bc3ca4a4af9f5f38ee.json" + [ "library/debian:jessie" ] + [ "10a267c67f423630f3afe5e04bbbc93d578861ddcc54283526222f3ad5e895b9/layer.tar" ] + ] + in (Hocker.Lib.encodeCanonical imgManifest) @?= (C8L.pack goldenStr) + +testImageManifestTwoWayEncoding = + let imgManifest = [ImageManifest + "3e83c23dba6a16cd936a3dc044df71b26706c5a4c28181bc3ca4a4af9f5f38ee.json" + [ "library/debian:jessie" ] + [ "10a267c67f423630f3afe5e04bbbc93d578861ddcc54283526222f3ad5e895b9/layer.tar" ] + ] + encoded = Hocker.Lib.encodeCanonical imgManifest + in decode encoded @?= (Just imgManifest) + +testImageRepositoriesGoldenEncoding = + let goldenStr = "{\"library/debian\":{\"jessie\":\"10a267c67f423630f3afe5e04bbbc93d578861ddcc54283526222f3ad5e895b9\"}}" + imgRepos = ImageRepositories + [ImageRepo + "library/debian" + (H.singleton + "jessie" + "10a267c67f423630f3afe5e04bbbc93d578861ddcc54283526222f3ad5e895b9")] + + in (Hocker.Lib.encodeCanonical imgRepos) @?= (C8L.pack goldenStr) + +testImageRepositoriesTwoWayEncoding = + let imgRepos = ImageRepositories + [ImageRepo + "library/debian" + (H.singleton + "jessie" + "10a267c67f423630f3afe5e04bbbc93d578861ddcc54283526222f3ad5e895b9")] + encoded = Hocker.Lib.encodeCanonical imgRepos + in decode encoded @?= (Just imgRepos) diff --git a/test/Tests/Data/Docker/Nix/FetchDocker.hs b/test/Tests/Data/Docker/Nix/FetchDocker.hs new file mode 100644 --- /dev/null +++ b/test/Tests/Data/Docker/Nix/FetchDocker.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Docker.Nix.FetchDocker +-- Copyright : (C) 2017 Awake Networks +-- License : Apache-2.0 +-- Maintainer : Awake Networks +-- Stability : stable +---------------------------------------------------------------------------- + +module Tests.Data.Docker.Nix.FetchDocker where + +import Control.Exception as CE +import Control.Monad.Except as Except +import Data.ByteString.Lazy.Char8 as C8L +import Data.Either (either) +import qualified Data.Text as Text +import Network.URI +import Test.Tasty +import Test.Tasty.Golden +import Test.Tasty.HUnit +import Text.PrettyPrint.ANSI.Leijen as Text.PrettyPrint (displayS) + +import Data.Docker.Image.Types +import Data.Docker.Nix.FetchDocker as Nix.FetchDocker +import Data.Docker.Nix.Lib as Nix.Lib +import Hocker.Lib +import Network.Wreq.Docker.Registry as Docker.Registry +import Hocker.Types +import Hocker.Types.ImageTag + +tests = testGroup "FetchDocker Nix Generation Tests" + [ goldenVsString + "Golden vs. Generated `fetchDocker' Nix Expression" + "test/data/golden-debian:jessie.nix" + generateFetchDockerNix + , testCase "Base16 Digest to Base32 Digest" testBase16toBase32 + ] + +testBase16toBase32 :: Assertion +testBase16toBase32 = do + let b16 = Base16Digest "5c90d4a2d1a8dfffd05ff2dd659923f0ca2d843b5e45d030e17abbcd06a11b5b" + b32 = Base32Digest "0nqvl43cvfvsw4qd0iay7f22vjph4fcnbpgjbz8gzpx8s6id942w" + + res <- Except.runExceptT $ do + nixhash <- Hocker.Lib.findExec "nix-hash" + Nix.Lib.toBase32Nix nixhash b16 + + either + (assertFailure . show) + (assertEqual "" b32) + res + +generateFetchDockerNix :: IO C8L.ByteString +generateFetchDockerNix = do + manifest <- C8L.readFile "test/data/manifest-debian:jessie.json" + nixExpression <- Nix.FetchDocker.generate + HockerImageMeta + { imageRepo = "library" + , imageName = "debian" + , imageTag = ImageTag "jessie" + , manifestJSON = manifest + , dockerRegistry = defaultRegistry + , altImageName = Nothing + } + + either + (Hocker.Lib.die . Text.pack . show) + (return . C8L.pack . (flip displayS "") . Hocker.Lib.renderNixExpr) + nixExpression