hocker (empty) → 1.0.0
raw patch · 29 files changed
+2665/−0 lines, 29 filesdep +aesondep +aeson-prettydep +ansi-wl-pprintsetup-changed
Dependencies added: aeson, aeson-pretty, ansi-wl-pprint, async, base, bytestring, concurrentoutput, containers, cryptonite, data-fix, deepseq, directory, exceptions, filepath, foldl, hnix, hocker, http-client, http-types, lens, lens-aeson, lifted-base, memory, mtl, neat-interpolation, network, network-uri, optional-args, optparse-applicative, optparse-generic, pooled-io, pureMD5, scientific, tar, tasty, tasty-golden, tasty-hunit, tasty-quickcheck, tasty-smallcheck, temporary, text, time, transformers, turtle, unordered-containers, uri-bytestring, vector, wreq, zlib
Files
- CHANGELOG.md +3/−0
- LICENSE +201/−0
- README.md +133/−0
- Setup.hs +2/−0
- docker2nix/Main.hs +79/−0
- hocker-config/Main.hs +41/−0
- hocker-image/Main.hs +44/−0
- hocker-layer/Main.hs +72/−0
- hocker-manifest/Main.hs +41/−0
- hocker.cabal +241/−0
- src/Data/Docker/Image/AesonHelpers.hs +18/−0
- src/Data/Docker/Image/Types.hs +148/−0
- src/Data/Docker/Nix.hs +22/−0
- src/Data/Docker/Nix/FetchDocker.hs +217/−0
- src/Data/Docker/Nix/Lib.hs +62/−0
- src/Hocker/Lib.hs +190/−0
- src/Hocker/Types.hs +194/−0
- src/Hocker/Types/Exceptions.hs +39/−0
- src/Hocker/Types/Hash.hs +43/−0
- src/Hocker/Types/ImageName.hs +38/−0
- src/Hocker/Types/ImageTag.hs +38/−0
- src/Hocker/Types/URI.hs +45/−0
- src/Network/Wreq/Docker/Image.hs +137/−0
- src/Network/Wreq/Docker/Image/Lib.hs +150/−0
- src/Network/Wreq/Docker/Registry.hs +243/−0
- src/Network/Wreq/ErrorHandling.hs +60/−0
- test/Main.hs +17/−0
- test/Tests/Data/Docker/Image.hs +74/−0
- test/Tests/Data/Docker/Nix/FetchDocker.hs +73/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# Changelog+## 1.0.0+- Initial release
+ LICENSE view
@@ -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.
+ README.md view
@@ -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’+...+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ docker2nix/Main.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ hocker-config/Main.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ hocker-image/Main.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ hocker-layer/Main.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ hocker-manifest/Main.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ hocker.cabal view
@@ -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 <https://github.com/awakesecurity/hocker#readme README.md>.++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
+ src/Data/Docker/Image/AesonHelpers.hs view
@@ -0,0 +1,18 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Docker.Image.AesonHelpers+-- Copyright : (C) 2016 Awake Networks+-- License : Apache-2.0+-- Maintainer : Awake Networks <opensource@awakenetworks.com>+-- 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 }
+ src/Data/Docker/Image/Types.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Data/Docker/Nix.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Data/Docker/Nix/FetchDocker.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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+ ])
+ src/Data/Docker/Nix/Lib.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Hocker/Lib.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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: <http://54.71.194.30:4016/registry/spec/json Docker's canonical JSON spec>+-- intentionally *does not* follow the <http://wiki.laptop.org/go/Canonical_JSON OLPC>'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=<path>' 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
+ src/Hocker/Types.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Hocker/Types/Exceptions.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Hocker/Types/Hash.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Hocker/Types/ImageName.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Hocker/Types/ImageTag.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Hocker/Types/URI.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Network/Wreq/Docker/Image.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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)
+ src/Network/Wreq/Docker/Image/Lib.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Network/Wreq/Docker/Registry.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ src/Network/Wreq/ErrorHandling.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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
+ test/Main.hs view
@@ -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+ ]
+ test/Tests/Data/Docker/Image.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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)
+ test/Tests/Data/Docker/Nix/FetchDocker.hs view
@@ -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 <opensource@awakenetworks.com>+-- 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