diff --git a/README.md b/README.md index 590855237..1c3a9bf4c 100644 --- a/README.md +++ b/README.md @@ -10,6 +10,9 @@ Seamlessly deploy websites and store secure user data This project can build multiple binaries. Please refer to the README for the specific package (e.g. fission-cli, fission-core). Here is how the projects are related to each other: ``` + ipfs + ^ + | fission-core ^ | diff --git a/fission-core/library/Fission/Internal/Orphanage/BaseUrl.hs b/fission-core/library/Fission/Internal/Orphanage/BaseUrl.hs index d076cf703..2ddd5f729 100644 --- a/fission-core/library/Fission/Internal/Orphanage/BaseUrl.hs +++ b/fission-core/library/Fission/Internal/Orphanage/BaseUrl.hs @@ -10,7 +10,7 @@ import Servant.Client.Core as Client import Fission.Prelude instance Display BaseUrl where - textDisplay = Text.pack . show + textDisplay = Text.pack . showBaseUrl instance Arbitrary BaseUrl where arbitrary = do diff --git a/fission-core/library/Fission/Internal/Orphanage/ByteString.hs b/fission-core/library/Fission/Internal/Orphanage/ByteString.hs index 73e841d15..61a12d847 100644 --- a/fission-core/library/Fission/Internal/Orphanage/ByteString.hs +++ b/fission-core/library/Fission/Internal/Orphanage/ByteString.hs @@ -2,12 +2,7 @@ module Fission.Internal.Orphanage.ByteString () where --- import Servant.API - import Fission.Prelude --- instance MimeRender PlainText ByteString where - -- mimeRender _proxy = identity - instance FromJSON ByteString where parseJSON = withText "ByteString" (pure . encodeUtf8) diff --git a/fission-core/package.yaml b/fission-core/package.yaml index 6c81148d2..e23e84c7b 100644 --- a/fission-core/package.yaml +++ b/fission-core/package.yaml @@ -1,5 +1,5 @@ name: fission-core -version: '3.4.0.0' +version: '3.4.1.0' category: API author: - Brooklyn Zelenka diff --git a/fission-web-server/library/Fission/Web/Server/Error/Class.hs b/fission-web-server/library/Fission/Web/Server/Error/Class.hs index 6c7748bf2..6731aba42 100644 --- a/fission-web-server/library/Fission/Web/Server/Error/Class.hs +++ b/fission-web-server/library/Fission/Web/Server/Error/Class.hs @@ -91,15 +91,21 @@ instance ToServerError Get.Error where Get.InvalidCID txt -> err422 { errBody = displayLazyBS txt } + Get.TimedOut (CID hash) txt -> + err504 { errBody = "IPFS timed out looking for " <> displayLazyBS hash <> " / Detail: " <> displayLazyBS txt} + + Get.WebError clientErr -> + err504 { errBody = "Remote IPFS error: " <> displayLazyBS clientErr } + + Get.SizeError clientErr -> + err504 { errBody = "IPFS Size Error" <> displayLazyBS clientErr } + Get.UnexpectedOutput txt -> err502 { errBody = "Unexpected IPFS result: " <> displayLazyBS txt } Get.UnknownErr txt -> err502 { errBody = "Unknown IPFS error" <> displayLazyBS txt} - Get.TimedOut (CID hash) txt -> - err504 { errBody = "IPFS timed out looking for " <> displayLazyBS hash <> " / Detail: " <> displayLazyBS txt} - instance ToServerError Add.Error where toServerError = \case Add.InvalidFile -> err422 { errBody = "File not processable by IPFS" } @@ -110,9 +116,10 @@ instance ToServerError Add.Error where instance ToServerError Peer.Error where toServerError = \case - Peer.DecodeFailure _ -> err500 { errBody = "Peer list decode error" } - Peer.CannotConnect _ -> err503 { errBody = "Unable to connect to peer" } - Peer.UnknownErr _ -> err500 { errBody = "Unknown peer list error" } + Peer.DecodeFailure _ -> err500 { errBody = "Peer list decode error" } + Peer.CannotConnect _ -> err503 { errBody = "Unable to connect to peer" } + Peer.CannotDisconnect _ -> err502 { errBody = "Unable to disconnect from peer" } + Peer.UnknownErr _ -> err500 { errBody = "Unknown peer list error" } instance ToServerError IPFS.Linearization where toServerError _ = err500 { errBody = "Unable to linearize IPFS result" } diff --git a/fission-web-server/library/Fission/Web/Server/Internal/Orphanage/ServerError.hs b/fission-web-server/library/Fission/Web/Server/Internal/Orphanage/ServerError.hs index 19baa56ef..a3b3906c0 100644 --- a/fission-web-server/library/Fission/Web/Server/Internal/Orphanage/ServerError.hs +++ b/fission-web-server/library/Fission/Web/Server/Internal/Orphanage/ServerError.hs @@ -3,7 +3,12 @@ module Fission.Web.Server.Internal.Orphanage.ServerError () where import RIO +import qualified RIO.Text as Text + import Servant.Server instance Display ServerError where display = displayShow + +instance Display [ServerError] where + textDisplay errs = Text.intercalate ", " $ fmap textDisplay errs diff --git a/fission-web-server/library/Fission/Web/Server/Mock/Effect/Types.hs b/fission-web-server/library/Fission/Web/Server/Mock/Effect/Types.hs index 4496afb18..3f1700603 100644 --- a/fission-web-server/library/Fission/Web/Server/Mock/Effect/Types.hs +++ b/fission-web-server/library/Fission/Web/Server/Mock/Effect/Types.hs @@ -16,11 +16,8 @@ module Fission.Web.Server.Mock.Effect.Types , DestroyLoosePin (..) ) where -import qualified Network.IPFS.Types as IPFS -import qualified RIO.ByteString.Lazy as Lazy - -import Control.Monad.Logger import Data.UUID as UUID +import qualified Network.IPFS.Types as IPFS import Fission.Prelude diff --git a/fission-web-server/package.yaml b/fission-web-server/package.yaml index 939a428e5..053b5b578 100644 --- a/fission-web-server/package.yaml +++ b/fission-web-server/package.yaml @@ -1,5 +1,5 @@ name: fission-web-server -version: '2.16.1.0' +version: '2.17.0.0' category: API author: - Brooklyn Zelenka diff --git a/ipfs/LICENSE b/ipfs/LICENSE new file mode 100644 index 000000000..261eeb9e9 --- /dev/null +++ b/ipfs/LICENSE @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/ipfs/README.md b/ipfs/README.md new file mode 100644 index 000000000..d99a3ffd7 --- /dev/null +++ b/ipfs/README.md @@ -0,0 +1,86 @@ +# ipfs-haskell + +[![Build Status](https://travis-ci.org/fission-suite/PROJECTNAME.svg?branch=master)](https://travis-ci.org/fission-suite/ipfs-haskell) +[![License](https://img.shields.io/badge/License-Apache%202.0-blue.svg)](https://github.com/fission-suite/blob/master/LICENSE) +[![Maintainability](https://api.codeclimate.com/v1/badges/44fb6a8a0cfd88bc41ef/maintainability)](https://codeclimate.com/github/fission-suite/ipfs-haskell/maintainability) +[![Built by FISSION](https://img.shields.io/badge/⌘-Built_by_FISSION-purple.svg)](https://fission.codes) +[![Discord](https://img.shields.io/discord/478735028319158273.svg)](https://discord.gg/zAQBDEq) +[![Discourse](https://img.shields.io/discourse/https/talk.fission.codes/topics)](https://talk.fission.codes) + +Documentation: [ipfs on hackage](http://hackage.haskell.org/package/ipfs) + +A library for integrating IPFS into your haskell applications. Interact with the IPFS network by shelling out to a local IPFS node or communicating via the HTTP interface of a remote node. + +# QuickStart + +Define instances for `MonadLocalIPFS` and/or `MonadRemoteIPFS`. Each requires only one function: + +```haskell +class Monad m => MonadRemoteIPFS m where + runRemote :: Servant.ClientM a -> m (Either Servant.ClientError a) + +class Monad m => MonadLocalIPFS m where + runLocal :: + [IPFS.Opt] + -> Lazy.ByteString + -> m (Either Process.Error Process.RawMessage) +``` + +We use RIO processes to shell out to a local IPFS node and Servant for HTTP requests to a remote node. + +After that, simply add `MonadLocalIPFS m` as a constraint to a function and you'll be able to call IPFS within it. +For instance: +```haskell +import Network.IPFS +import qualified Network.IPFS.Add as IPFS +import Network.IPFS.File.Types as File + +add :: + MonadLocalIPFS m + => File.Serialzed + -> m () +add (Serialized rawData) = IPFS.addRaw rawData >>= \case + Right newCID -> + -- ... + Left err -> + -- ... + +``` + +You can see example instances below: +```haskell +instance + ( HasProcessContext cfg + , HasLogFunc cfg + , Has IPFS.BinPath cfg + , Has IPFS.Timeout cfg + ) + => MonadLocalIPFS (RIO cfg) where + runLocal opts arg = do + IPFS.BinPath ipfs <- view hasLens + IPFS.Timeout secs <- view hasLens + let opts' = ("--timeout=" <> show secs <> "s") : opts + + runProc readProcess ipfs (byteStringInput arg) byteStringOutput opts' >>= \case + (ExitSuccess, contents, _) -> + return $ Right contents + (ExitFailure _, _, stdErr) + | Lazy.isSuffixOf "context deadline exceeded" stdErr -> + return . Left $ Process.Timeout secs + | otherwise -> + return . Left $ Process.UnknownErr stdErr + +instance + ( Has IPFS.URL cfg + , Has HTTP.Manager cfg + ) + => MonadRemoteIPFS (RIO cfg) where + runRemote query = do + IPFS.URL url <- view hasLens + manager <- view hasLens + + url + & mkClientEnv manager + & runClientM query + & liftIO +``` diff --git a/ipfs/Setup.hs b/ipfs/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/ipfs/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ipfs/library/Network/IPFS.hs b/ipfs/library/Network/IPFS.hs new file mode 100644 index 000000000..328826c7f --- /dev/null +++ b/ipfs/library/Network/IPFS.hs @@ -0,0 +1,13 @@ +module Network.IPFS + ( MonadLocalIPFS + , runLocal + , MonadRemoteIPFS + , runRemote + , ipfsAdd + , ipfsCat + , ipfsPin + , ipfsUnpin + ) where + +import Network.IPFS.Local.Class +import Network.IPFS.Remote.Class diff --git a/ipfs/library/Network/IPFS/Add.hs b/ipfs/library/Network/IPFS/Add.hs new file mode 100644 index 000000000..5c79a5774 --- /dev/null +++ b/ipfs/library/Network/IPFS/Add.hs @@ -0,0 +1,148 @@ +module Network.IPFS.Add + ( addRaw + , addFile + , addPath + , addDir + ) where + +import Network.IPFS.Local.Class as IPFS +import Network.IPFS.Prelude hiding (link) + +import Data.ByteString.Lazy.Char8 as CL + +import qualified System.FilePath.Glob as Glob + +import qualified RIO.ByteString.Lazy as Lazy +import RIO.Directory +import RIO.FilePath +import qualified RIO.List as List + +import qualified Network.IPFS.Internal.UTF8 as UTF8 + +import Network.IPFS.Add.Error as IPFS.Add +import Network.IPFS.DAG.Link as DAG.Link +import Network.IPFS.DAG.Node.Types as DAG +import Network.IPFS.Types as IPFS + +import Network.IPFS.DAG as DAG + +addRaw :: + MonadLocalIPFS m + => Lazy.ByteString + -> m (Either IPFS.Add.Error IPFS.CID) +addRaw raw = + IPFS.runLocal ["add", "-HQ"] raw >>= \case + Right result -> + case CL.lines result of + [cid] -> + return . Right . mkCID . UTF8.stripN 1 . decodeUtf8Lenient $ Lazy.toStrict cid + + bad -> + return . Left . UnexpectedOutput $ UTF8.textShow bad + + Left err -> + return . Left . UnknownAddErr $ UTF8.textShow err + +addFile :: + MonadLocalIPFS m + => Lazy.ByteString + -> IPFS.Name + -> m (Either IPFS.Add.Error (IPFS.SparseTree, IPFS.CID)) +addFile raw name = + IPFS.runLocal opts raw >>= \case + Right result -> + case CL.lines result of + [inner, outer] -> + let + sparseTree = Directory [(Hash rootCID, fileWrapper)] + fileWrapper = Directory [(fileName, Content fileCID)] + rootCID = CID . decodeUtf8Lenient $ Lazy.toStrict outer + fileCID = CID . UTF8.stripN 1 . decodeUtf8Lenient $ Lazy.toStrict inner + fileName = Key name + in + return $ Right (sparseTree, rootCID) + + bad -> + return . Left . UnexpectedOutput $ UTF8.textShow bad + + + Left err -> + return . Left . UnknownAddErr $ UTF8.textShow err + + where + opts = [ "add" + , "-wq" + , "--stdin-name" + , unName name + ] + +addPath :: + MonadLocalIPFS m + => FilePath + -> m (Either IPFS.Add.Error CID) +addPath path = IPFS.runLocal ["add", "-HQ", path] "" >>= pure . \case + Right result -> + case CL.lines result of + [cid] -> Right . mkCID . UTF8.stripN 1 $ UTF8.textShow cid + bad -> Left . UnexpectedOutput $ UTF8.textShow bad + + Left err -> + Left . UnknownAddErr $ UTF8.textShow err + +addDir :: + ( MonadIO m + , MonadLocalIPFS m + ) + => IPFS.Ignored + -> FilePath + -> m (Either IPFS.Add.Error IPFS.CID) +addDir ignored path = doesFileExist path >>= \case + True -> addPath path + False -> walkDir ignored path + +walkDir :: + ( MonadIO m + , MonadLocalIPFS m + ) + => IPFS.Ignored + -> FilePath + -> m (Either IPFS.Add.Error IPFS.CID) +walkDir ignored path = do + files <- listDirectory path + + let + toAdd = removeIgnored ignored files + reducer = foldResults path ignored + seed = Right $ Node + { dataBlock = "CAE=" + , links = [] + } + + foldM reducer seed toAdd >>= \case + Left err -> return $ Left err + Right node -> DAG.putNode node + +foldResults :: + ( MonadIO m + , MonadLocalIPFS m + ) + => FilePath + -> IPFS.Ignored + -> Either IPFS.Add.Error Node + -> FilePath + -> m (Either IPFS.Add.Error Node) +foldResults _ _ (Left err) _ = return $ Left err +foldResults path ignored (Right node) filename = do + addDir ignored (path filename) >>= \case + Left err -> return $ Left err + Right cid -> + DAG.Link.create cid (IPFS.Name filename) >>= \case + Left err -> return . Left $ RecursiveAddErr err + Right link -> + return $ Right node { links = link: links node } + +removeIgnored :: IPFS.Ignored -> [FilePath] -> [FilePath] +removeIgnored ignored files = List.filter (not . matchesAny ignored) files + +matchesAny :: IPFS.Ignored -> FilePath -> Bool +matchesAny globs path = List.any (\x -> Glob.match x path) globs diff --git a/ipfs/library/Network/IPFS/Add/Error.hs b/ipfs/library/Network/IPFS/Add/Error.hs new file mode 100644 index 000000000..b2933a010 --- /dev/null +++ b/ipfs/library/Network/IPFS/Add/Error.hs @@ -0,0 +1,24 @@ +module Network.IPFS.Add.Error (Error (..)) where + +import qualified Network.IPFS.Get.Error as Get +import Network.IPFS.Prelude + +data Error + = InvalidFile + | UnexpectedOutput Text + | RecursiveAddErr Get.Error + | IPFSDaemonErr Text + | UnknownAddErr Text + deriving ( Exception + , Eq + , Generic + , Show + ) + +instance Display Error where + display = \case + InvalidFile -> "Invalid file" + UnexpectedOutput txt -> "Unexpected IPFS output: " <> display txt + RecursiveAddErr err -> "Error while adding directory" <> display err + IPFSDaemonErr txt -> "IPFS Daemon error: " <> display txt + UnknownAddErr txt -> "Unknown IPFS add error: " <> display txt diff --git a/ipfs/library/Network/IPFS/BinPath/Types.hs b/ipfs/library/Network/IPFS/BinPath/Types.hs new file mode 100644 index 000000000..9b49a9d08 --- /dev/null +++ b/ipfs/library/Network/IPFS/BinPath/Types.hs @@ -0,0 +1,26 @@ +module Network.IPFS.BinPath.Types (BinPath (..)) where + +import qualified RIO.Text as Text + +import System.Envy + +import Network.IPFS.Internal.Orphanage.Natural () +import Network.IPFS.Prelude + +-- | Path to the IPFS binary +newtype BinPath = BinPath { getBinPath :: FilePath } + deriving ( Show + , Eq + , Generic + ) + deriving newtype ( IsString ) + +instance FromEnv BinPath where + fromEnv _ = BinPath <$> env "IPFS_PATH" + +instance FromJSON BinPath where + parseJSON = withText "IPFS.BinPath" \txt -> + BinPath <$> parseJSON (String txt) + +instance Display BinPath where + textDisplay (BinPath path) = Text.pack path diff --git a/ipfs/library/Network/IPFS/Bytes/Types.hs b/ipfs/library/Network/IPFS/Bytes/Types.hs new file mode 100644 index 000000000..0db930550 --- /dev/null +++ b/ipfs/library/Network/IPFS/Bytes/Types.hs @@ -0,0 +1,13 @@ +module Network.IPFS.Bytes.Types (Bytes(..)) where + +import Network.IPFS.Prelude + +newtype Bytes = Bytes { unBytes :: Natural } + deriving newtype ( Eq + , Show + ) + +instance FromJSON Bytes where + parseJSON val = do + nat <- parseJSON val + return <| Bytes nat diff --git a/ipfs/library/Network/IPFS/CID/Types.hs b/ipfs/library/Network/IPFS/CID/Types.hs new file mode 100644 index 000000000..558af05f1 --- /dev/null +++ b/ipfs/library/Network/IPFS/CID/Types.hs @@ -0,0 +1,71 @@ +module Network.IPFS.CID.Types + ( CID (..) + , mkCID + ) where + +import qualified RIO.ByteString.Lazy as Lazy +import RIO.Char +import qualified RIO.Text as Text + +import Data.Swagger +import Servant.API + +import qualified Network.IPFS.Internal.UTF8 as UTF8 +import Network.IPFS.Prelude + +newtype CID = CID { unaddress :: Text } + deriving ( Eq + , Generic + , Ord + , Read + , Show + ) + deriving anyclass ( ToParamSchema ) + deriving newtype ( IsString + , ToHttpApiData + ) + +instance ToJSON CID where + toJSON (CID cid) = cid |> normalize |> toJSON + where + normalize (Text.take 1 -> "\"") = UTF8.stripN 1 cid + normalize cid' = cid' + +instance FromJSON CID where + parseJSON = withText "ContentAddress" (pure . CID) + +instance ToSchema CID where + declareNamedSchema _ = + mempty + |> type_ ?~ SwaggerString + |> example ?~ "QmW2WQi7j6c7UgJTarActp7tDNikE4B2qXtFCfLPdsgaTQ" + |> NamedSchema (Just "IPFSAddress") + |> pure + +instance Display CID where + textDisplay = unaddress + +instance MimeRender PlainText CID where + mimeRender _ = UTF8.textToLazyBS . unaddress + +instance MimeRender OctetStream CID where + mimeRender _ = UTF8.textToLazyBS . unaddress + +instance MimeUnrender PlainText CID where + mimeUnrender _proxy bs = + case decodeUtf8' $ Lazy.toStrict bs of + Left err -> Left $ show err + Right txt -> Right $ CID txt + +instance MimeUnrender PlainText [CID] where + mimeUnrender proxy bs = sequence cids + where + cids :: [Either String CID] + cids = mimeUnrender proxy <$> Lazy.split (fromIntegral $ ord ',') bs + +instance FromHttpApiData CID where + parseUrlPiece = Right . CID + +-- | Smart constructor for @CID@ +mkCID :: Text -> CID +mkCID = CID . Text.strip diff --git a/ipfs/library/Network/IPFS/Client.hs b/ipfs/library/Network/IPFS/Client.hs new file mode 100644 index 000000000..7e1e50412 --- /dev/null +++ b/ipfs/library/Network/IPFS/Client.hs @@ -0,0 +1,54 @@ +module Network.IPFS.Client + ( API + , add + , cat + , stat + , pin + , unpin + , dagPut + ) where + +import qualified RIO.ByteString.Lazy as Lazy + +import Servant.API +import Servant.Client +import Servant.Multipart.Client () + +import Network.IPFS.Internal.Orphanage.ByteString.Lazy () +import Network.IPFS.Prelude hiding (object) + +import Network.IPFS.CID.Types +import qualified Network.IPFS.File.Form.Types as File +import qualified Network.IPFS.File.Types as File +import Network.IPFS.Stat.Types + +import qualified Network.IPFS.Client.Add as Add +import qualified Network.IPFS.Client.Cat as Cat +import qualified Network.IPFS.Client.DAG.Put.Types as DAG.Put +import qualified Network.IPFS.Client.DAG.Types as DAG +import qualified Network.IPFS.Client.Pin as Pin +import qualified Network.IPFS.Client.Stat as Stat + +type API + = "api" + :> "v0" + :> V0API + +type V0API = "add" :> Add.API + :<|> "cat" :> Cat.API + :<|> "object" :> Stat.API + :<|> "dag" :> DAG.API + :<|> "pin" :> Pin.API + +cat :: CID -> ClientM File.Serialized +stat :: CID -> ClientM Stat +pin :: CID -> ClientM Pin.Response +unpin :: CID -> Bool -> ClientM Pin.Response +dagPut :: Bool -> (Lazy.ByteString, File.Form) -> ClientM DAG.Put.Response +add :: Lazy.ByteString -> ClientM CID + +add :<|> cat + :<|> stat + :<|> dagPut + :<|> pin + :<|> unpin = client $ Proxy @API diff --git a/ipfs/library/Network/IPFS/Client/Add.hs b/ipfs/library/Network/IPFS/Client/Add.hs new file mode 100644 index 000000000..48bd0e72d --- /dev/null +++ b/ipfs/library/Network/IPFS/Client/Add.hs @@ -0,0 +1,10 @@ +module Network.IPFS.Client.Add (API) where + +import qualified RIO.ByteString.Lazy as Lazy + +import Servant.API + +import Network.IPFS.CID.Types (CID) + +type API = ReqBody '[PlainText] Lazy.ByteString + :> Post '[PlainText] CID diff --git a/ipfs/library/Network/IPFS/Client/Cat.hs b/ipfs/library/Network/IPFS/Client/Cat.hs new file mode 100644 index 000000000..8d85fd96a --- /dev/null +++ b/ipfs/library/Network/IPFS/Client/Cat.hs @@ -0,0 +1,10 @@ +module Network.IPFS.Client.Cat (API) where + +import Servant.API + +import qualified Network.IPFS.Client.Param as Param +import qualified Network.IPFS.File.Types as File +import Network.IPFS.MIME.RawPlainText.Types + +type API = Param.CID' + :> Post '[RawPlainText] File.Serialized diff --git a/ipfs/library/Network/IPFS/Client/DAG/Put/Types.hs b/ipfs/library/Network/IPFS/Client/DAG/Put/Types.hs new file mode 100644 index 000000000..f2c1de9df --- /dev/null +++ b/ipfs/library/Network/IPFS/Client/DAG/Put/Types.hs @@ -0,0 +1,22 @@ +module Network.IPFS.Client.DAG.Put.Types (API, Response (..)) where + +import Servant.API +import Servant.Multipart + +import Network.IPFS.Prelude + +import Network.IPFS.CID.Types +import qualified Network.IPFS.File.Form.Types as File + +type API + = QueryParam' '[Required, Strict] "pin" Bool + :> MultipartForm Tmp File.Form + :> Post '[JSON] Response + +newtype Response = Response CID + +instance FromJSON Response where + parseJSON = withObject "IPFS.DAG.Response" \obj -> do + cidField <- obj .: "Cid" + cid <- cidField .: "/" + return $ Response cid diff --git a/ipfs/library/Network/IPFS/Client/DAG/Types.hs b/ipfs/library/Network/IPFS/Client/DAG/Types.hs new file mode 100644 index 000000000..e71dfb2e1 --- /dev/null +++ b/ipfs/library/Network/IPFS/Client/DAG/Types.hs @@ -0,0 +1,9 @@ +module Network.IPFS.Client.DAG.Types (API) where + +import Servant.API + +import qualified Network.IPFS.Client.DAG.Put.Types as Put + +type API + = "put" + :> Put.API diff --git a/ipfs/library/Network/IPFS/Client/Error/Types.hs b/ipfs/library/Network/IPFS/Client/Error/Types.hs new file mode 100644 index 000000000..98953c456 --- /dev/null +++ b/ipfs/library/Network/IPFS/Client/Error/Types.hs @@ -0,0 +1,10 @@ +module Network.IPFS.Client.Error.Types (ErrorBody (..)) where + +import Network.IPFS.Prelude + +data ErrorBody = ErrorBody {message :: String} + +instance FromJSON ErrorBody where + parseJSON = withObject "ErrorBody" \obj -> do + message <- obj .: "Message" + return ErrorBody {..} diff --git a/ipfs/library/Network/IPFS/Client/Param.hs b/ipfs/library/Network/IPFS/Client/Param.hs new file mode 100644 index 000000000..1eec35028 --- /dev/null +++ b/ipfs/library/Network/IPFS/Client/Param.hs @@ -0,0 +1,11 @@ +module Network.IPFS.Client.Param + ( CID' + , IsRecursive + ) where + +import Servant.API + +import Network.IPFS.CID.Types + +type CID' = QueryParam' '[Required, Strict] "arg" CID +type IsRecursive = QueryFlag "recursive" diff --git a/ipfs/library/Network/IPFS/Client/Pin.hs b/ipfs/library/Network/IPFS/Client/Pin.hs new file mode 100644 index 000000000..8ca89ec66 --- /dev/null +++ b/ipfs/library/Network/IPFS/Client/Pin.hs @@ -0,0 +1,42 @@ +module Network.IPFS.Client.Pin + ( API + , AddAPI + , RemoveAPI + , Response (..) + ) where + +import qualified RIO.Text as Text + +import Servant.API + +import Network.IPFS.Prelude + +import Network.IPFS.CID.Types +import qualified Network.IPFS.Client.Param as Param + +type API = AddAPI :<|> RemoveAPI + +type AddAPI + = "add" + :> Param.CID' + :> Post '[JSON] Response + +-- IPFS v0.5 disallows GET requests +-- https://docs.ipfs.io/recent-releases/go-ipfs-0-5/#breaking-changes-upgrade-notes +type RemoveAPI + = "rm" + :> Param.CID' + :> Param.IsRecursive + :> Post '[JSON] Response + +newtype Response = Response { cids :: [CID] } + deriving (Eq, Show) + +instance Display Response where + textDisplay Response {cids} = "[" <> inner <> "]" + where + inner = Text.intercalate ", " $ fmap textDisplay cids + +instance FromJSON Response where + parseJSON = withObject "Pin Response" \obj -> + Response <$> obj .: "Pins" diff --git a/ipfs/library/Network/IPFS/Client/Stat.hs b/ipfs/library/Network/IPFS/Client/Stat.hs new file mode 100644 index 000000000..972894074 --- /dev/null +++ b/ipfs/library/Network/IPFS/Client/Stat.hs @@ -0,0 +1,12 @@ +module Network.IPFS.Client.Stat (API) where + +import Servant.API + +import qualified Network.IPFS.Client.Param as Param +import Network.IPFS.Stat.Types + +-- IPFS v0.5 disallows GET requests +-- https://docs.ipfs.io/recent-releases/go-ipfs-0-5/#breaking-changes-upgrade-notes +type API = "stat" + :> Param.CID' + :> Post '[JSON] Stat diff --git a/ipfs/library/Network/IPFS/Client/Streaming/Pin.hs b/ipfs/library/Network/IPFS/Client/Streaming/Pin.hs new file mode 100644 index 000000000..59970d0c8 --- /dev/null +++ b/ipfs/library/Network/IPFS/Client/Streaming/Pin.hs @@ -0,0 +1,35 @@ +module Network.IPFS.Client.Streaming.Pin + ( PinComplete + , PinStatus (..) + ) where + +import Servant.API + +import Network.IPFS.Prelude + +import Network.IPFS.CID.Types +import qualified Network.IPFS.Client.Param as Param + +type PinComplete + = "api" + :> "v0" + :> "pin" + :> "add" + :> Param.CID' + :> QueryParam "progress" Bool + :> StreamPost NewlineFraming JSON (SourceIO PinStatus) + +data PinStatus = PinStatus + { pins :: [CID] + , progress :: Maybe Natural + } + deriving (Eq, Show) + +instance Display PinStatus where + display status = displayShow status + +instance FromJSON PinStatus where + parseJSON = withObject "IPFS.PinStatus" \obj -> do + pins <- obj .:? "Pins" .!= [] + progress <- obj .:? "Progress" + return PinStatus {..} diff --git a/ipfs/library/Network/IPFS/DAG.hs b/ipfs/library/Network/IPFS/DAG.hs new file mode 100644 index 000000000..24b0231de --- /dev/null +++ b/ipfs/library/Network/IPFS/DAG.hs @@ -0,0 +1,50 @@ +module Network.IPFS.DAG + ( put + , putNode + , putRemote + ) where + +import Data.ByteString.Lazy.Char8 as CL +import qualified Network.IPFS.Internal.UTF8 as UTF8 +import qualified RIO.ByteString.Lazy as Lazy + +import Servant.Client +import qualified Servant.Multipart.Client as Multipart.Client + +import Network.IPFS.Prelude + +import Network.IPFS.Add.Error as IPFS.Add +import qualified Network.IPFS.Client as IPFS.Client +import Network.IPFS.Client.DAG.Put.Types as DAG.Put +import Network.IPFS.DAG.Node.Types as DAG +import Network.IPFS.File.Form.Types as File +import Network.IPFS.File.Types as File +import Network.IPFS.Local.Class as IPFS +import Network.IPFS.Remote.Class as IPFS +import Network.IPFS.Types as IPFS + +put :: MonadLocalIPFS m => Lazy.ByteString -> m (Either IPFS.Add.Error IPFS.CID) +put raw = IPFS.runLocal ["dag", "put", "-f", "dag-pb"] raw >>= \case + Right result -> + case CL.lines result of + [cid] -> + cid + |> UTF8.textShow + |> UTF8.stripN 1 + |> mkCID + |> Right + |> return + + bad -> + pure . Left . UnexpectedOutput $ UTF8.textShow bad + + Left err -> + pure . Left . UnknownAddErr $ UTF8.textShow err + +putNode :: MonadLocalIPFS m => DAG.Node -> m (Either IPFS.Add.Error IPFS.CID) +putNode node = put $ encode node + +putRemote :: MonadRemoteIPFS m => File.Serialized -> m (Either ClientError DAG.Put.Response) +putRemote file = do + boundary <- liftIO Multipart.Client.genBoundary + runRemote (IPFS.Client.dagPut True (boundary, File.Form "file" file)) diff --git a/ipfs/library/Network/IPFS/DAG/Link.hs b/ipfs/library/Network/IPFS/DAG/Link.hs new file mode 100644 index 000000000..9c1e732bc --- /dev/null +++ b/ipfs/library/Network/IPFS/DAG/Link.hs @@ -0,0 +1,22 @@ +module Network.IPFS.DAG.Link (create) where + +import Network.IPFS.Prelude +import Network.IPFS.Local.Class + +import Network.IPFS.Get.Error as IPFS.Get +import Network.IPFS.Types as IPFS +import Network.IPFS.DAG.Link.Types as DAG +import qualified Network.IPFS.Stat as Stat + +create :: + MonadLocalIPFS m + => IPFS.CID + -> IPFS.Name + -> m (Either IPFS.Get.Error Link) +create cid name = Stat.getSize cid >>= \case + Left err -> return <| Left err + Right size -> return . Right <| Link + { cid = cid + , name = name + , size = size + } diff --git a/ipfs/library/Network/IPFS/DAG/Link/Types.hs b/ipfs/library/Network/IPFS/DAG/Link/Types.hs new file mode 100644 index 000000000..374ba676f --- /dev/null +++ b/ipfs/library/Network/IPFS/DAG/Link/Types.hs @@ -0,0 +1,21 @@ +module Network.IPFS.DAG.Link.Types (Link (..)) where + +import Network.IPFS.Prelude +import Network.IPFS.Types as IPFS +import Data.Text as T + + +data Link = Link + { cid :: IPFS.CID + , name :: IPFS.Name + , size :: Integer + } deriving (Show, Eq, Generic) + + +instance ToJSON Link where + toJSON (Link cid name size) = + Object [ ("Name", String . T.pack <| unName name) + , ("Size", Number <| fromIntegral size) + , ("Cid", Object [("/", String <| unaddress cid)]) + ] + diff --git a/ipfs/library/Network/IPFS/DAG/Node/Types.hs b/ipfs/library/Network/IPFS/DAG/Node/Types.hs new file mode 100644 index 000000000..1ceddd2c6 --- /dev/null +++ b/ipfs/library/Network/IPFS/DAG/Node/Types.hs @@ -0,0 +1,19 @@ +module Network.IPFS.DAG.Node.Types (Node (..)) where + +import Network.IPFS.Prelude + +import Data.Vector +import Network.IPFS.DAG.Link.Types as DAG + + +data Node = Node + { dataBlock :: Text + , links :: [DAG.Link] + } deriving (Show, Eq) + +instance ToJSON Node where + toJSON (Node dataBlock links) = + Object [ ("data", String dataBlock) + , ("links", Array . fromList $ fmap toJSON links) + ] + diff --git a/ipfs/library/Network/IPFS/Error.hs b/ipfs/library/Network/IPFS/Error.hs new file mode 100644 index 000000000..41d7abe38 --- /dev/null +++ b/ipfs/library/Network/IPFS/Error.hs @@ -0,0 +1,33 @@ +module Network.IPFS.Error + ( Error (..) + , Linearization (..) + ) where + +import Network.IPFS.Prelude +import Network.IPFS.Types + +import qualified Network.IPFS.Add.Error as Add +import qualified Network.IPFS.Get.Error as Get + +data Error + = AddErr Add.Error + | GetErr Get.Error + | LinearizationErr Linearization + deriving ( Exception + , Eq + , Generic + , Show + ) + +-- NOTE Will not stay as a newtype in the long term +newtype Linearization = NonLinear SparseTree + deriving ( Eq + , Generic + , Show + ) + deriving anyclass ( Exception + , ToJSON + ) + +instance Display Linearization where + display (NonLinear sparseTree) = "Unable to linearize IPFS result: " <> display sparseTree diff --git a/ipfs/library/Network/IPFS/File/Form/Types.hs b/ipfs/library/Network/IPFS/File/Form/Types.hs new file mode 100644 index 000000000..22edc83ab --- /dev/null +++ b/ipfs/library/Network/IPFS/File/Form/Types.hs @@ -0,0 +1,24 @@ +module Network.IPFS.File.Form.Types (Form (..)) where + +import RIO +import qualified RIO.ByteString.Lazy as Lazy + +import Servant.Multipart +import Servant.Multipart.API + +import qualified Network.IPFS.File.Types as File + +data Form = Form + { name :: Text + , serialized :: File.Serialized + } + +instance ToMultipart Tmp Form where + toMultipart Form { name = name, serialized = File.Serialized fileLBS } = + MultipartData + [ Input + { iName = name + , iValue = decodeUtf8Lenient $ Lazy.toStrict fileLBS + } + ] + [] diff --git a/ipfs/library/Network/IPFS/File/Types.hs b/ipfs/library/Network/IPFS/File/Types.hs new file mode 100644 index 000000000..8af990ca9 --- /dev/null +++ b/ipfs/library/Network/IPFS/File/Types.hs @@ -0,0 +1,52 @@ +-- | File types +module Network.IPFS.File.Types (Serialized (..)) where + +import qualified Data.ByteString.Builder as Builder +import Data.Swagger +import qualified RIO.ByteString.Lazy as Lazy + +import Servant.API + +import Network.IPFS.MIME.RawPlainText.Types +import Network.IPFS.Prelude + +-- | A file serialized as a lazy bytestring +newtype Serialized = Serialized { unserialize :: Lazy.ByteString } + deriving ( Eq + , Show + ) + deriving newtype ( IsString ) + +instance ToSchema Serialized where + declareNamedSchema _ = + mempty + |> example ?~ "hello world" + |> description ?~ "A typical file's contents" + |> type_ ?~ SwaggerString + |> NamedSchema (Just "SerializedFile") + |> pure + +instance Display Serialized where + display = Utf8Builder . Builder.lazyByteString . unserialize + +----- + +instance MimeRender PlainText Serialized where + mimeRender _proxy = unserialize + +instance MimeRender RawPlainText Serialized where + mimeRender _proxy = unserialize + +instance MimeRender OctetStream Serialized where + mimeRender _proxy = unserialize + +----- + +instance MimeUnrender PlainText Serialized where + mimeUnrender _proxy = Right . Serialized + +instance MimeUnrender RawPlainText Serialized where + mimeUnrender _proxy = Right . Serialized + +instance MimeUnrender OctetStream Serialized where + mimeUnrender _proxy = Right . Serialized diff --git a/ipfs/library/Network/IPFS/Gateway/Types.hs b/ipfs/library/Network/IPFS/Gateway/Types.hs new file mode 100644 index 000000000..f0f64cea3 --- /dev/null +++ b/ipfs/library/Network/IPFS/Gateway/Types.hs @@ -0,0 +1,18 @@ +module Network.IPFS.Gateway.Types (Gateway (..)) where + +import Network.IPFS.Prelude +import Data.Swagger (ToSchema (..)) + +-- | Type safety wrapper for IPFS Gateway +-- Used as cname value for DNS updates +newtype Gateway = Gateway { getGateway :: Text } + deriving ( Eq + , Generic + , Show + ) + deriving anyclass ( ToSchema ) + deriving newtype ( IsString ) + +instance FromJSON Gateway where + parseJSON = withText "AWS.Gateway" \txt -> + Gateway <$> parseJSON (String txt) diff --git a/ipfs/library/Network/IPFS/Get.hs b/ipfs/library/Network/IPFS/Get.hs new file mode 100644 index 000000000..6f36d35e1 --- /dev/null +++ b/ipfs/library/Network/IPFS/Get.hs @@ -0,0 +1,34 @@ +module Network.IPFS.Get + ( getFile + , getFileOrDirectory + ) where + +import qualified Network.IPFS.Internal.UTF8 as UTF8 +import Network.IPFS.Local.Class as IPFS +import Network.IPFS.Prelude + +import Data.ByteString.Lazy.Char8 as CL +import qualified RIO.ByteString.Lazy as Lazy +import qualified RIO.Text as Text + +import qualified Network.IPFS.File.Types as File +import Network.IPFS.Get.Error as IPFS.Get +import qualified Network.IPFS.Process.Error as Process +import Network.IPFS.Types as IPFS + +getFileOrDirectory :: MonadLocalIPFS m => IPFS.CID -> m (Either IPFS.Get.Error CL.ByteString) +getFileOrDirectory cid@(IPFS.CID hash) = IPFS.runLocal ["get", Text.unpack hash] "" >>= \case + Right contents -> return $ Right contents + Left err -> case err of + Process.Timeout secs -> return . Left $ TimedOut cid secs + Process.UnknownErr raw -> return . Left . UnknownErr $ UTF8.textShow raw + +getFile :: MonadLocalIPFS m => IPFS.CID -> m (Either IPFS.Get.Error File.Serialized) +getFile cid@(IPFS.CID hash) = IPFS.runLocal ["cat"] (UTF8.textToLazyBS hash) >>= \case + Right contents -> return . Right $ File.Serialized contents + Left err -> case err of + Process.Timeout secs -> return . Left $ TimedOut cid secs + Process.UnknownErr raw -> + if Lazy.isPrefixOf "Error: invalid 'ipfs ref' path" raw + then return . Left $ InvalidCID hash + else return . Left . UnknownErr $ UTF8.textShow raw diff --git a/ipfs/library/Network/IPFS/Get/Error.hs b/ipfs/library/Network/IPFS/Get/Error.hs new file mode 100644 index 000000000..f2023767d --- /dev/null +++ b/ipfs/library/Network/IPFS/Get/Error.hs @@ -0,0 +1,47 @@ +module Network.IPFS.Get.Error (Error (..)) where + +import Servant.Client + +import Network.IPFS.Prelude + +import Network.IPFS.Stat.Error +import Network.IPFS.Types + +data Error + = InvalidCID Text + | TimedOut CID Natural + | WebError ClientError + | SizeError OverflowDetected + | UnexpectedOutput Text + | UnknownErr Text + deriving ( Exception + , Eq + , Generic + , Show + ) + +instance Display Error where + display = \case + InvalidCID hash -> + "Invalid CID: " <> display hash + + TimedOut (CID hash) sec -> + mconcat + [ "Unable to find CID " + , display hash + , " before the timeout of " + , display sec + , " seconds." + ] + + WebError err -> + "WebError: " <> displayShow err + + SizeError err -> + "SizeError: " <> display err + + UnexpectedOutput raw -> + "Unexpected IPFS output: " <> display raw + + UnknownErr raw -> + "Unknown IPFS get error: " <> display raw diff --git a/ipfs/library/Network/IPFS/Ignored/Types.hs b/ipfs/library/Network/IPFS/Ignored/Types.hs new file mode 100644 index 000000000..f5400ae65 --- /dev/null +++ b/ipfs/library/Network/IPFS/Ignored/Types.hs @@ -0,0 +1,5 @@ +module Network.IPFS.Ignored.Types (Ignored) where + +import qualified System.FilePath.Glob as Glob + +type Ignored = [Glob.Pattern] diff --git a/ipfs/library/Network/IPFS/Info/Types.hs b/ipfs/library/Network/IPFS/Info/Types.hs new file mode 100644 index 000000000..5fae10e95 --- /dev/null +++ b/ipfs/library/Network/IPFS/Info/Types.hs @@ -0,0 +1,22 @@ +module Network.IPFS.Info.Types (Info (..)) where + +import Network.IPFS.Prelude +import Network.IPFS.Peer.Types + +data Info = Info + { id :: Text + , publicKey :: Text + , addresses :: [Peer] + , agentVersion :: Text + , protocolVersion :: Text + } deriving (Show, Eq) + +instance FromJSON Info where + parseJSON = withObject "IPFS.Info" \obj -> do + id <- obj .: "ID" + publicKey <- obj .: "PublicKey" + addresses <- obj .: "Addresses" + agentVersion <- obj .: "AgentVersion" + protocolVersion <- obj .: "ProtocolVersion" + + return Info {..} diff --git a/ipfs/library/Network/IPFS/Internal/Orphanage/ByteString/Lazy.hs b/ipfs/library/Network/IPFS/Internal/Orphanage/ByteString/Lazy.hs new file mode 100644 index 000000000..e7fef1c9a --- /dev/null +++ b/ipfs/library/Network/IPFS/Internal/Orphanage/ByteString/Lazy.hs @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Network.IPFS.Internal.Orphanage.ByteString.Lazy () where + +import qualified RIO.ByteString.Lazy as Lazy +import Servant.API + +import Network.IPFS.Prelude + +instance MimeRender PlainText Lazy.ByteString where + mimeRender _proxy = identity + +instance FromJSON Lazy.ByteString where + parseJSON = withText "ByteString" (pure . Lazy.fromStrict . encodeUtf8) diff --git a/ipfs/library/Network/IPFS/Internal/Orphanage/Natural.hs b/ipfs/library/Network/IPFS/Internal/Orphanage/Natural.hs new file mode 100644 index 000000000..03697f971 --- /dev/null +++ b/ipfs/library/Network/IPFS/Internal/Orphanage/Natural.hs @@ -0,0 +1,14 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-missing-methods #-} + +module Network.IPFS.Internal.Orphanage.Natural () where + +import System.Envy + +import Network.IPFS.Prelude + +instance Display Natural where + display nat = display (fromIntegral nat :: Integer) + +instance Var Natural where + fromVar = readMaybe diff --git a/ipfs/library/Network/IPFS/Internal/Orphanage/Utf8Builder.hs b/ipfs/library/Network/IPFS/Internal/Orphanage/Utf8Builder.hs new file mode 100644 index 000000000..40baca665 --- /dev/null +++ b/ipfs/library/Network/IPFS/Internal/Orphanage/Utf8Builder.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Network.IPFS.Internal.Orphanage.Utf8Builder () where + +import RIO + +import Control.Monad.Logger + +instance ToLogStr Utf8Builder where + toLogStr (Utf8Builder builder) = toLogStr builder diff --git a/ipfs/library/Network/IPFS/Internal/UTF8.hs b/ipfs/library/Network/IPFS/Internal/UTF8.hs new file mode 100644 index 000000000..0a71ea509 --- /dev/null +++ b/ipfs/library/Network/IPFS/Internal/UTF8.hs @@ -0,0 +1,32 @@ +-- | UTF8 text helpers +module Network.IPFS.Internal.UTF8 + ( Textable (..) + , stripN + , textToLazyBS + , textShow + ) where + +import RIO +import qualified RIO.ByteString.Lazy as Lazy +import qualified RIO.Text as Text + +class Textable a where + encode :: a -> Either UnicodeException Text + +instance Textable ByteString where + encode = decodeUtf8' + +instance Textable Lazy.ByteString where + encode = encode . Lazy.toStrict + +textToLazyBS :: Text -> Lazy.ByteString +textToLazyBS = Lazy.fromStrict . Text.encodeUtf8 + +textShow :: Show a => a -> Text +textShow = textDisplay . displayShow + +stripN :: Natural -> Text -> Text +stripN n = Text.dropEnd i . Text.drop i + where + i :: Int + i = fromIntegral n diff --git a/ipfs/library/Network/IPFS/Local/Class.hs b/ipfs/library/Network/IPFS/Local/Class.hs new file mode 100644 index 000000000..ebe105551 --- /dev/null +++ b/ipfs/library/Network/IPFS/Local/Class.hs @@ -0,0 +1,17 @@ +module Network.IPFS.Local.Class + ( MonadLocalIPFS + , runLocal + ) where + +import Network.IPFS.Prelude + +import qualified RIO.ByteString.Lazy as Lazy + +import Network.IPFS.Types as IPFS +import qualified Network.IPFS.Process.Error as Process + +class Monad m => MonadLocalIPFS m where + runLocal :: + [Opt] + -> Lazy.ByteString + -> m (Either Process.Error Process.RawMessage) diff --git a/ipfs/library/Network/IPFS/MIME/RawPlainText/Types.hs b/ipfs/library/Network/IPFS/MIME/RawPlainText/Types.hs new file mode 100644 index 000000000..fd84f589a --- /dev/null +++ b/ipfs/library/Network/IPFS/MIME/RawPlainText/Types.hs @@ -0,0 +1,35 @@ +module Network.IPFS.MIME.RawPlainText.Types (RawPlainText) where + +import Network.HTTP.Media +import qualified Servant.API as API + +import RIO +import qualified RIO.ByteString.Lazy as Lazy + +-- Built-in version includes charset +-- https://github.com/haskell-servant/servant/issues/1002 +data RawPlainText + +instance API.Accept RawPlainText where + contentType _ = "text" // "plain" + +instance API.MimeRender RawPlainText Text where + mimeRender _ = Lazy.fromStrict . encodeUtf8 + +instance API.MimeRender RawPlainText ByteString where + mimeRender _ = Lazy.fromStrict + +instance API.MimeRender RawPlainText Lazy.ByteString where + mimeRender _ = id + +instance API.MimeUnrender RawPlainText Text where + mimeUnrender _ bs = + case decodeUtf8' $ Lazy.toStrict bs of + Left err -> Left $ show err + Right txt -> Right txt + +instance API.MimeUnrender RawPlainText ByteString where + mimeUnrender _ = Right . Lazy.toStrict + +instance API.MimeUnrender RawPlainText Lazy.ByteString where + mimeUnrender _ = Right diff --git a/ipfs/library/Network/IPFS/Name/Types.hs b/ipfs/library/Network/IPFS/Name/Types.hs new file mode 100644 index 000000000..3be60c13d --- /dev/null +++ b/ipfs/library/Network/IPFS/Name/Types.hs @@ -0,0 +1,33 @@ +module Network.IPFS.Name.Types (Name (..)) where + +import qualified RIO.Text as Text + +import Data.Swagger (ToParamSchema, ToSchema (..)) +import Servant.API + +import Network.IPFS.Prelude + +newtype Name = Name { unName :: String } + deriving ( Eq + , Generic + , Show + , Ord + ) + deriving newtype ( IsString + , ToSchema + , ToParamSchema + ) + +instance Display Name where + display = displayShow + +instance ToJSON Name where + toJSON (Name n) = toJSON n + +instance FromJSON Name where + parseJSON = withText "IPFSName" (pure . Name . Text.unpack) + +instance FromHttpApiData Name where + parseUrlPiece = \case + "" -> Left "Empty Name field" + txt -> Right . Name <| Text.unpack txt diff --git a/ipfs/library/Network/IPFS/Path/Types.hs b/ipfs/library/Network/IPFS/Path/Types.hs new file mode 100644 index 000000000..7e6792155 --- /dev/null +++ b/ipfs/library/Network/IPFS/Path/Types.hs @@ -0,0 +1,29 @@ +module Network.IPFS.Path.Types (Path (..)) where + +import Data.Swagger (ToSchema (..)) +import Servant.API + +import qualified Network.IPFS.Internal.UTF8 as UTF8 +import Network.IPFS.Prelude + +-- | CID path +-- +-- Exmaple +-- +-- > "QmcaHAFzUPRCRaUK12dC6YyhcqEEtdfg94XrPwgCxZ1ihD/myfile.txt" +newtype Path = Path { unpath :: Text } + deriving ( Eq + , Generic + , Show + , Ord + ) + deriving newtype ( IsString + , ToHttpApiData + , ToSchema + ) + +instance MimeRender PlainText Path where + mimeRender _ = UTF8.textToLazyBS . unpath + +instance MimeRender OctetStream Path where + mimeRender _ = UTF8.textToLazyBS . unpath diff --git a/ipfs/library/Network/IPFS/Peer.hs b/ipfs/library/Network/IPFS/Peer.hs new file mode 100644 index 000000000..f830ab0b4 --- /dev/null +++ b/ipfs/library/Network/IPFS/Peer.hs @@ -0,0 +1,87 @@ +module Network.IPFS.Peer + ( all + , rawList + , connect + , connectRetry + , disconnect + , getExternalAddress + ) where + +import qualified RIO.List as List +import qualified RIO.Text as Text + +import qualified Network.IP.Addr as Addr + +import Text.Regex + +import qualified Network.IPFS.Internal.UTF8 as UTF8 +import Network.IPFS.Prelude hiding (all) + +import Network.IPFS.Info.Types +import Network.IPFS.Local.Class as IPFS +import Network.IPFS.Peer.Error as IPFS.Peer +import Network.IPFS.Peer.Types +import qualified Network.IPFS.Process.Error as Process +import qualified Network.IPFS.Types as IPFS + +all :: MonadLocalIPFS m => m (Either IPFS.Peer.Error [IPFS.Peer]) +all = rawList <&> \case + Right raw -> case UTF8.encode raw of + Left _ -> Left . DecodeFailure $ show raw + Right text -> Right $ IPFS.Peer <$> Text.lines text + Left err -> Left . UnknownErr $ UTF8.textShow err + +rawList :: MonadLocalIPFS m => m (Either Process.Error Process.RawMessage) +rawList = IPFS.runLocal ["bootstrap", "list"] "" + +connect :: MonadLocalIPFS m => Peer -> m (Either IPFS.Peer.Error ()) +connect peer@(Peer peerID) = IPFS.runLocal ["swarm", "connect"] (UTF8.textToLazyBS peerID) >>= pure . \case + Left _ -> Left $ CannotConnect peer + Right _ -> Right () + +disconnect :: MonadLocalIPFS m => Peer -> m (Either IPFS.Peer.Error ()) +disconnect peer@(Peer peerID) = + IPFS.runLocal ["swarm", "disconnect"] (UTF8.textToLazyBS peerID) >>= pure . \case + Left _ -> Left $ CannotDisconnect peer + Right _ -> Right () + +connectRetry :: MonadLocalIPFS m => Peer -> Natural -> m (Either IPFS.Peer.Error ()) +connectRetry peer 0 = return . Left $ CannotConnect peer +connectRetry peer tries = connect peer >>= \case + Right _ -> return $ Right () + Left _err -> connectRetry peer (tries - 1) + +peerAddressRe :: Regex +peerAddressRe = mkRegex "^/ip[46]/([a-zA-Z0-9.:]*)/" + +-- | Retrieve just the ip address from a peer address +extractIPfromPeerAddress :: String -> Maybe String +extractIPfromPeerAddress peer = matchRegex peerAddressRe peer >>= List.headMaybe + +-- | True if a given peer address is externally accessable +isExternalIPv4 :: Text -> Bool +isExternalIPv4 ip = maybe False not isReserved + where + isReserved :: Maybe Bool + isReserved = do + ipAddress <- extractIPfromPeerAddress $ Text.unpack ip + normalized <- readMaybe ipAddress + return (Addr.ip4Range normalized == Addr.ReservedIP4) + +-- | Filter a list of peers to include only the externally accessable addresses +filterExternalPeers :: [Peer] -> [Peer] +filterExternalPeers = filter (isExternalIPv4 . peer) + +-- | Get all external ipfs peer addresses +getExternalAddress :: MonadLocalIPFS m => m (Either IPFS.Peer.Error [Peer]) +getExternalAddress = + IPFS.runLocal ["id"] "" >>= \case + Left err -> + return . Left . UnknownErr $ UTF8.textShow err + + Right raw -> + raw + |> decode + |> maybe [] addresses + |> Right . filterExternalPeers + |> pure diff --git a/ipfs/library/Network/IPFS/Peer/Error.hs b/ipfs/library/Network/IPFS/Peer/Error.hs new file mode 100644 index 000000000..bfddfb4a5 --- /dev/null +++ b/ipfs/library/Network/IPFS/Peer/Error.hs @@ -0,0 +1,22 @@ +module Network.IPFS.Peer.Error (Error (..)) where + +import Network.IPFS.Peer.Types +import Network.IPFS.Prelude + +data Error + = DecodeFailure String + | CannotConnect Peer + | CannotDisconnect Peer + | UnknownErr Text + deriving ( Exception + , Eq + , Generic + , Show + ) + +instance Display Error where + display = \case + DecodeFailure err -> "Unable to decode: " <> displayShow err + CannotConnect peer -> "Unable to connect to " <> display peer + CannotDisconnect peer -> "Unable to disconnect from " <> display peer + UnknownErr msg -> "Unknown IPFS peer list error: " <> display msg diff --git a/ipfs/library/Network/IPFS/Peer/Types.hs b/ipfs/library/Network/IPFS/Peer/Types.hs new file mode 100644 index 000000000..86a27bd54 --- /dev/null +++ b/ipfs/library/Network/IPFS/Peer/Types.hs @@ -0,0 +1,35 @@ +module Network.IPFS.Peer.Types (Peer (..)) where + +import RIO + +import Control.Lens +import Data.Aeson +import Data.Swagger +import Servant.API + +import qualified Network.IPFS.Internal.UTF8 as UTF8 + +newtype Peer = Peer { peer :: Text } + deriving ( Eq + , Show + ) + deriving newtype ( Display + , IsString + , FromJSON + ) + +instance ToJSON Peer where + toJSON = String . peer + +instance ToSchema Peer where + declareNamedSchema _ = + return $ NamedSchema (Just "IPFSPeer") $ mempty + & type_ ?~ SwaggerString + & example ?~ "/ip4/178.62.158.247/tcp/4001/ipfs/QmSoLer265NRgSp2LA3dPaeykiS1J6DifTC88f5uVQKNAd" + & description ?~ "An IPFS peer address" + +instance MimeRender PlainText Peer where + mimeRender _ = UTF8.textToLazyBS . peer + +instance MimeRender OctetStream Peer where + mimeRender _ = UTF8.textToLazyBS . peer diff --git a/ipfs/library/Network/IPFS/Pin.hs b/ipfs/library/Network/IPFS/Pin.hs new file mode 100644 index 000000000..4eaf9c3b9 --- /dev/null +++ b/ipfs/library/Network/IPFS/Pin.hs @@ -0,0 +1,76 @@ +module Network.IPFS.Pin + ( add + , rm + ) where + +import Network.IPFS.Prelude +import Network.IPFS.Remote.Class +import qualified Network.IPFS.Internal.UTF8 as UTF8 + +import qualified Network.IPFS.Client.Pin as Pin +import Network.IPFS.Add.Error as IPFS.Add +import Network.IPFS.Types as IPFS +import Servant.Client + +-- | Pin a CID +add :: (MonadRemoteIPFS m, MonadLogger m) => IPFS.CID -> m (Either IPFS.Add.Error CID) +add cid = ipfsPin cid >>= \case + Right Pin.Response { cids } -> + case cids of + [cid'] -> do + logDebug <| "Pinned CID " <> display cid' + return <| Right cid' + + _ -> do + formattedErr <- parseUnexpectedOutput <| UTF8.textShow cids + return <| Left formattedErr + + Left err -> do + formattedError <- parseClientError err + return <| Left formattedError + +-- | Unpin a CID +rm :: (MonadRemoteIPFS m, MonadLogger m) => IPFS.CID -> m (Either IPFS.Add.Error CID) +rm cid = ipfsUnpin cid False >>= \case + Right Pin.Response { cids } -> + case cids of + [cid'] -> do + logDebug <| "Unpinned CID " <> display cid' + return <| Right cid' + + _ -> do + formattedErr <- parseUnexpectedOutput <| UTF8.textShow cids + return <| Left formattedErr + + Left _ -> do + logDebug <| "Cannot unpin CID " <> display cid <> " because it was not pinned" + return <| Right cid + +-- | Parse and Log the Servant Client Error returned from the IPFS Daemon +parseClientError :: MonadLogger m => ClientError -> m Error +parseClientError err = do + logError <| displayShow err + return <| case err of + FailureResponse _ response -> + response + |> responseBody + |> decode + |> \case + Just IPFS.ErrorBody {message} -> + IPFSDaemonErr <| UTF8.textShow message + + _ -> + UnexpectedOutput <| UTF8.textShow err + + unknownClientError -> + UnknownAddErr <| UTF8.textShow unknownClientError + +-- | Parse and Log unexpected output when attempting to pin +parseUnexpectedOutput :: MonadLogger m => Text -> m IPFS.Add.Error +parseUnexpectedOutput errStr = do + let + baseError = UnexpectedOutput errStr + err = UnknownAddErr <| UTF8.textShow baseError + + logError <| display baseError + return err diff --git a/ipfs/library/Network/IPFS/Prelude.hs b/ipfs/library/Network/IPFS/Prelude.hs new file mode 100644 index 000000000..fadf366b9 --- /dev/null +++ b/ipfs/library/Network/IPFS/Prelude.hs @@ -0,0 +1,58 @@ +-- | A custom @Prelude@-like module for this project +module Network.IPFS.Prelude + ( module Control.Lens + , module Control.Monad.Logger + , module Data.Aeson + , module Flow + , module RIO + , module RIO.Process + , identity + , logInfo + , logDebug + , logWarn + , logError + , logOther + ) where + +import Control.Lens ((?~)) +import Control.Monad.Logger (LogLevel (..), + MonadLogger (..), + ToLogStr (..), + logWithoutLoc) +import Data.Aeson + +import Network.IPFS.Internal.Orphanage.Utf8Builder () + +import Flow + +import RIO hiding (Handler, + LogLevel (..), + LogSource, id, + logDebug, + logDebugS, + logError, + logErrorS, + logInfo, logInfoS, + logOther, + logOtherS, + logWarn, logWarnS, + timeout, (&)) +import RIO.Process + +identity :: a -> a +identity a = a + +logInfo :: (ToLogStr msg, MonadLogger m) => msg -> m () +logInfo = logWithoutLoc "" LevelInfo + +logDebug :: (ToLogStr msg, MonadLogger m) => msg -> m () +logDebug = logWithoutLoc "" LevelDebug + +logWarn :: (ToLogStr msg, MonadLogger m) => msg -> m () +logWarn = logWithoutLoc "" LevelWarn + +logError :: (ToLogStr msg, MonadLogger m) => msg -> m () +logError = logWithoutLoc "" LevelError + +logOther :: (ToLogStr msg, MonadLogger m) => LogLevel -> msg -> m () +logOther = logWithoutLoc "" diff --git a/ipfs/library/Network/IPFS/Process.hs b/ipfs/library/Network/IPFS/Process.hs new file mode 100644 index 000000000..a7178c1bb --- /dev/null +++ b/ipfs/library/Network/IPFS/Process.hs @@ -0,0 +1,21 @@ +module Network.IPFS.Process (runProc) where + +import Network.IPFS.Prelude +import Network.IPFS.Process.Types + +runProc :: + ( MonadIO m + , MonadReader cfg m + , HasProcessContext cfg + , HasLogFunc cfg + ) + => (ProcessConfig stdin stdout () -> m a) + -> FilePath + -> StreamIn stdin + -> StreamOut stdout + -> [Opt] + -> m a +runProc processor binPath inStream outStream opts = + proc binPath opts <| processor + . setStdin inStream + . setStdout outStream diff --git a/ipfs/library/Network/IPFS/Process/Error.hs b/ipfs/library/Network/IPFS/Process/Error.hs new file mode 100644 index 000000000..1446ba4a7 --- /dev/null +++ b/ipfs/library/Network/IPFS/Process/Error.hs @@ -0,0 +1,21 @@ +module Network.IPFS.Process.Error + ( Error (..) + , RawMessage + ) where + +import Network.IPFS.Prelude +import Network.IPFS.Process.Types + +data Error + = Timeout Natural + | UnknownErr RawMessage + deriving ( Exception + , Eq + , Generic + , Show + ) + +instance Display Error where + display = \case + Timeout _ -> "IPFS timed out" + UnknownErr raw -> displayShow raw diff --git a/ipfs/library/Network/IPFS/Process/Types.hs b/ipfs/library/Network/IPFS/Process/Types.hs new file mode 100644 index 000000000..d85f453df --- /dev/null +++ b/ipfs/library/Network/IPFS/Process/Types.hs @@ -0,0 +1,16 @@ +module Network.IPFS.Process.Types + ( Opt + , Command + , StreamIn + , StreamOut + , RawMessage + ) where + +import Network.IPFS.Prelude +import Data.ByteString.Lazy.Char8 as CL + +type Opt = String +type Command = String +type StreamIn stdin = StreamSpec 'STInput stdin +type StreamOut stdout = StreamSpec 'STOutput stdout +type RawMessage = CL.ByteString diff --git a/ipfs/library/Network/IPFS/Remote/Class.hs b/ipfs/library/Network/IPFS/Remote/Class.hs new file mode 100644 index 000000000..710897dba --- /dev/null +++ b/ipfs/library/Network/IPFS/Remote/Class.hs @@ -0,0 +1,35 @@ +module Network.IPFS.Remote.Class + ( MonadRemoteIPFS + , runRemote + , ipfsAdd + , ipfsCat + , ipfsStat + , ipfsPin + , ipfsUnpin + ) where + +import Network.IPFS.Prelude + +import qualified RIO.ByteString.Lazy as Lazy +import Servant.Client + +import Network.IPFS.Types as IPFS + +import qualified Network.IPFS.Client as IPFS.Client +import qualified Network.IPFS.Client.Pin as Pin +import qualified Network.IPFS.File.Types as File + +class MonadIO m => MonadRemoteIPFS m where + runRemote :: ClientM a -> m (Either ClientError a) + ipfsAdd :: Lazy.ByteString -> m (Either ClientError CID) + ipfsCat :: CID -> m (Either ClientError File.Serialized) + ipfsStat :: CID -> m (Either ClientError Stat) + ipfsPin :: CID -> m (Either ClientError Pin.Response) + ipfsUnpin :: CID -> Bool -> m (Either ClientError Pin.Response) + + -- defaults + ipfsAdd raw = runRemote $ IPFS.Client.add raw + ipfsCat cid = runRemote $ IPFS.Client.cat cid + ipfsPin cid = runRemote $ IPFS.Client.pin cid + ipfsUnpin cid recursive = runRemote $ IPFS.Client.unpin cid recursive + ipfsStat cid = runRemote $ IPFS.Client.stat cid diff --git a/ipfs/library/Network/IPFS/SparseTree.hs b/ipfs/library/Network/IPFS/SparseTree.hs new file mode 100644 index 000000000..115a9d582 --- /dev/null +++ b/ipfs/library/Network/IPFS/SparseTree.hs @@ -0,0 +1,39 @@ +module Network.IPFS.SparseTree + ( SparseTree (..) + , Error.Linearization (..) + , linearize + , cIDs + ) where + +import Network.IPFS.Prelude +import qualified Network.IPFS.Internal.UTF8 as UTF8 +import qualified Network.IPFS.Error as Error + +import Network.IPFS.CID.Types +import Network.IPFS.Name.Types +import Network.IPFS.Path.Types +import Network.IPFS.SparseTree.Types + +linearize :: SparseTree -> Either Error.Linearization Path +linearize = fmap Path . go + where + go :: SparseTree -> Either Error.Linearization Text + go = \case + Stub (Name name) -> Right <| UTF8.textShow name + Content (CID _) -> Right "" + Directory [(tag, value)] -> fromPath tag <$> go value + badDir -> Left <| Error.NonLinear badDir + where + fromPath tag "" = fromKey tag + fromPath tag text = fromKey tag <> "/" <> text + + fromKey :: Tag -> Text + fromKey = UTF8.stripN 1 . \case + Hash (CID cid) -> cid + Key (Name name) -> UTF8.textShow name + +-- | Get all CIDs from a 'SparseTree' (all levels) +cIDs :: (Monoid (f CID), Applicative f) => SparseTree -> f CID +cIDs (Stub _) = mempty +cIDs (Content cid) = pure cid +cIDs (Directory kv) = foldMap cIDs kv diff --git a/ipfs/library/Network/IPFS/SparseTree/Types.hs b/ipfs/library/Network/IPFS/SparseTree/Types.hs new file mode 100644 index 000000000..0b7f2541f --- /dev/null +++ b/ipfs/library/Network/IPFS/SparseTree/Types.hs @@ -0,0 +1,91 @@ +module Network.IPFS.SparseTree.Types + ( SparseTree (..) + , Tag (..) + ) where + +import qualified RIO.HashMap as HashMap +import qualified RIO.Map as Map +import qualified RIO.Text as Text + +import Data.Swagger hiding (Tag, name) +import Servant.API + +import Network.IPFS.CID.Types +import qualified Network.IPFS.Internal.UTF8 as UTF8 +import Network.IPFS.Name.Types +import Network.IPFS.Prelude + +-- | Directory structure for CIDs and other identifiers +-- +-- Examples: +-- +-- > Content "abcdef" +-- +-- > show $ Directory [(Key "abcdef", Stub "myfile.txt")])] +-- "abcdef/myfile.txt" +data SparseTree + = Stub Name + | Content CID + | Directory (Map Tag SparseTree) + deriving ( Eq + , Generic + , Show + ) + +instance ToSchema SparseTree where + declareNamedSchema _ = + mempty + |> type_ ?~ SwaggerString + |> description ?~ "A tree of IPFS paths" + |> example ?~ toJSON (Directory [(Key "abcdef", Stub "myfile.txt")]) + |> NamedSchema (Just "IPFSTree") + |> pure + +instance Display (Map Tag SparseTree) where + display sparseMap = + "{" <> foldr (\e acc -> e <> ", " <> acc) "}" (prettyKV <$> Map.toList sparseMap) + where + prettyKV (k, v) = display k <> " => " <> display v + +instance Display SparseTree where + display = \case + Stub name -> display name + Content cid -> display cid + Directory dir -> display dir + +instance ToJSON SparseTree where + toJSON = \case + Stub (Name name) -> String <| Text.pack name + Content (CID cid) -> String <| UTF8.stripN 1 cid + Directory dirMap -> Object <| HashMap.fromList (jsonKV <$> Map.toList dirMap) + where + jsonKV :: (Tag, SparseTree) -> (Text, Value) + jsonKV (tag, subtree) = (jsonTag tag, toJSON subtree) + + jsonTag (Key (Name n)) = Text.pack n + jsonTag (Hash (CID cid)) = UTF8.stripN 1 cid + +data Tag + = Key Name + | Hash CID + deriving ( Eq + , Generic + , Ord + , Show + ) + +instance Display Tag where + display (Key name) = display name + display (Hash cid) = display cid + +instance FromJSON Tag +instance ToJSON Tag where + toJSON (Key k) = toJSON k + toJSON (Hash h) = toJSON h + +instance FromJSONKey Tag +instance ToJSONKey Tag +instance ToSchema Tag + +instance FromHttpApiData Tag where + parseUrlPiece txt = Key <$> parseUrlPiece txt diff --git a/ipfs/library/Network/IPFS/Stat.hs b/ipfs/library/Network/IPFS/Stat.hs new file mode 100644 index 000000000..917def9c9 --- /dev/null +++ b/ipfs/library/Network/IPFS/Stat.hs @@ -0,0 +1,57 @@ +module Network.IPFS.Stat + ( getStatRemote + , getSizeRemote + , getSize + , module Network.IPFS.Stat.Types + ) where + +import Data.ByteString.Lazy.Char8 as CL + +import qualified RIO.ByteString.Lazy as Lazy +import qualified RIO.List as List + +import qualified Network.IPFS.Internal.UTF8 as UTF8 +import Network.IPFS.Local.Class as IPFS +import Network.IPFS.Prelude +import Network.IPFS.Remote.Class as Remote + +import Network.IPFS.Get.Error as IPFS.Get +import qualified Network.IPFS.Process.Error as Process + +import Network.IPFS.Bytes.Types +import Network.IPFS.Stat.Types +import Network.IPFS.Types as IPFS + +getStatRemote :: MonadRemoteIPFS m => IPFS.CID -> m (Either IPFS.Get.Error Stat) +getStatRemote cid = + Remote.ipfsStat cid >>= \case + Right statPayload -> return $ Right statPayload + Left err -> return . Left $ IPFS.Get.WebError err + +getSizeRemote :: MonadRemoteIPFS m => IPFS.CID -> m (Either IPFS.Get.Error Bytes) +getSizeRemote cid = + getStatRemote cid >>= \case + Left err -> + return $ Left err + + Right Stat {cumulativeSize} -> + case cumulativeSize of + Left err -> return $ Left $ IPFS.Get.SizeError err + Right size -> return $ Right size + +getSize :: MonadLocalIPFS m => IPFS.CID -> m (Either IPFS.Get.Error Integer) +getSize cid@(CID hash) = IPFS.runLocal ["object", "stat"] (Lazy.fromStrict <| encodeUtf8 hash) >>= \case + Left err -> case err of + Process.Timeout secs -> return . Left $ TimedOut cid secs + Process.UnknownErr raw -> return . Left . UnknownErr $ UTF8.textShow raw + + Right contents -> + case parseSize contents of + Nothing -> return . Left . UnexpectedOutput $ "Could not parse CumulativeSize" + Just (size, _) -> return $ Right size + +parseSize :: Lazy.ByteString -> Maybe (Integer, Lazy.ByteString) +parseSize lbs = do + finalLine <- List.lastMaybe $ CL.lines lbs + finalWord <- List.lastMaybe $ CL.words finalLine + CL.readInteger finalWord diff --git a/ipfs/library/Network/IPFS/Stat/Error.hs b/ipfs/library/Network/IPFS/Stat/Error.hs new file mode 100644 index 000000000..a63c1ecfc --- /dev/null +++ b/ipfs/library/Network/IPFS/Stat/Error.hs @@ -0,0 +1,19 @@ +module Network.IPFS.Stat.Error (OverflowDetected (..)) where + +import Network.IPFS.Prelude + +data OverflowDetected = OverflowDetected + deriving (Eq, Show) + +instance Display OverflowDetected where + display OverflowDetected = "OverflowDetected" + +instance ToJSON OverflowDetected where + toJSON OverflowDetected = String "OverflowDetected" + +instance FromJSON OverflowDetected where + parseJSON = + withScientific "OverflowDetected" \num -> + if num < 0 + then return OverflowDetected + else fail "Not an overflow" diff --git a/ipfs/library/Network/IPFS/Stat/Types.hs b/ipfs/library/Network/IPFS/Stat/Types.hs new file mode 100644 index 000000000..8ce01d8ab --- /dev/null +++ b/ipfs/library/Network/IPFS/Stat/Types.hs @@ -0,0 +1,39 @@ +module Network.IPFS.Stat.Types + ( Stat (..) + , module Network.IPFS.Stat.Error + ) where + +import qualified Data.Aeson.Types as JSON +import Data.Scientific + +import Network.IPFS.Bytes.Types +import Network.IPFS.Stat.Error + +import Network.IPFS.Prelude + +data Stat = Stat + { blockSize :: Either OverflowDetected Bytes + , cumulativeSize :: Either OverflowDetected Bytes + , dataSize :: Either OverflowDetected Bytes + , hash :: Text + , linksSize :: Bytes + , numLinks :: Natural + } + +instance FromJSON Stat where + parseJSON = withObject "Stat" \obj -> do + blockSize <- detectOverflow =<< obj .: "BlockSize" + cumulativeSize <- detectOverflow =<< obj .: "CumulativeSize" + dataSize <- detectOverflow =<< obj .: "DataSize" + + hash <- obj .: "Hash" + linksSize <- obj .: "LinksSize" + numLinks <- obj .: "NumLinks" + + return Stat {..} + +detectOverflow :: Scientific -> JSON.Parser (Either OverflowDetected Bytes) +detectOverflow num = checkOverflow <|> checkBytes + where + checkOverflow = Left <$> parseJSON (JSON.Number num) + checkBytes = Right <$> parseJSON (JSON.Number num) diff --git a/ipfs/library/Network/IPFS/Timeout/Types.hs b/ipfs/library/Network/IPFS/Timeout/Types.hs new file mode 100644 index 000000000..5a676d846 --- /dev/null +++ b/ipfs/library/Network/IPFS/Timeout/Types.hs @@ -0,0 +1,20 @@ +module Network.IPFS.Timeout.Types (Timeout (..)) where + +import System.Envy + +import Network.IPFS.Prelude +import Network.IPFS.Internal.Orphanage.Natural () + +newtype Timeout = Timeout { getSeconds :: Natural } + deriving ( Eq + , Show + , Generic + ) + deriving newtype ( Num ) + +instance FromEnv Timeout where + fromEnv _ = Timeout <$> env "IPFS_TIMEOUT" + +instance FromJSON Timeout where + parseJSON = withScientific "IPFS.Timeout" \num -> + Timeout <$> parseJSON (Number num) diff --git a/ipfs/library/Network/IPFS/Types.hs b/ipfs/library/Network/IPFS/Types.hs new file mode 100644 index 000000000..26fb14623 --- /dev/null +++ b/ipfs/library/Network/IPFS/Types.hs @@ -0,0 +1,36 @@ +-- | Types related to IPFS +module Network.IPFS.Types + ( BinPath (..) + , CID (..) + , mkCID + , Name (..) + , Opt + , Command + , RawMessage + , Peer (..) + , Path (..) + , SparseTree (..) + , Tag (..) + , Timeout (..) + , URL (..) + , Ignored + , Gateway (..) + , ErrorBody (..) + , Stat (..) + , Bytes (..) + ) where + +import Network.IPFS.BinPath.Types +import Network.IPFS.CID.Types +import Network.IPFS.Name.Types +import Network.IPFS.Path.Types +import Network.IPFS.Peer.Types +import Network.IPFS.Process.Types +import Network.IPFS.SparseTree.Types +import Network.IPFS.Timeout.Types +import Network.IPFS.URL.Types +import Network.IPFS.Ignored.Types +import Network.IPFS.Gateway.Types +import Network.IPFS.Client.Error.Types +import Network.IPFS.Stat.Types +import Network.IPFS.Bytes.Types diff --git a/ipfs/library/Network/IPFS/URL/Types.hs b/ipfs/library/Network/IPFS/URL/Types.hs new file mode 100644 index 000000000..5e7c0d033 --- /dev/null +++ b/ipfs/library/Network/IPFS/URL/Types.hs @@ -0,0 +1,13 @@ +module Network.IPFS.URL.Types (URL (..)) where + +import qualified Servant.Client as Client + +import Network.IPFS.Prelude + +-- | IPFS client URL +newtype URL = URL { getURL :: Client.BaseUrl } + deriving ( Eq + , Generic + , Show + ) + deriving newtype ( FromJSON ) diff --git a/ipfs/package.yaml b/ipfs/package.yaml new file mode 100644 index 000000000..4af674cc5 --- /dev/null +++ b/ipfs/package.yaml @@ -0,0 +1,122 @@ +name: ipfs +version: '1.4.2' +synopsis: Access IPFS locally and remotely +description: Interact with the IPFS network by shelling out to a local IPFS node or communicating via the HTTP interface of a remote IPFS node. +category: Network +author: + - Brooklyn Zelenka + - Daniel Holmgren + - Steven Vandevelde + - James Walker +maintainer: + - brooklyn@fission.codes + - daniel@fission.codes + - steven@fission.codes + - james@fission.codes +copyright: © 2021 Fission Internet Software Services for Open Networks Inc. +license: Apache-2.0 +license-file: LICENSE +github: fission-suite/ipfs-haskell +tested-with: GHC==8.10.7 +extra-source-files: + - README.md + +ghc-options: + - -Wall + - -Wcompat + - -Widentities + # Warn about too little + - -Wincomplete-record-updates + - -Wincomplete-uni-patterns + - -Wmissing-export-lists + - -Wpartial-fields + # Warn about too much + - -Wredundant-constraints + # Prettier Development + - -fhide-source-paths + +default-extensions: + - ApplicativeDo + - BangPatterns + - BinaryLiterals + - BlockArguments + - ConstraintKinds + - DataKinds + - DeriveAnyClass + - DeriveFoldable + - DeriveFunctor + - DeriveGeneric + - DeriveLift + - DeriveTraversable + - DerivingStrategies + - DuplicateRecordFields + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GADTs + - GeneralizedNewtypeDeriving + - KindSignatures + - LambdaCase + - LiberalTypeSynonyms + - MultiParamTypeClasses + - MultiWayIf + - NamedFieldPuns + - NoImplicitPrelude + - NoMonomorphismRestriction + - OverloadedStrings + - OverloadedLabels + - OverloadedLists + - PostfixOperators + - RankNTypes + - RecordWildCards + - ScopedTypeVariables + - StandaloneDeriving + - TupleSections + - TypeApplications + - TypeFamilies + - TypeSynonymInstances + - TemplateHaskell + - TypeOperators + - ViewPatterns + +dependencies: + - aeson + - base < 5 + - bytestring + - envy + - flow + - Glob + - http-media + - lens + - monad-logger + - network-ip + - regex-compat + - rio + - scientific + - servant + - servant-client + - servant-multipart + - servant-multipart-api + - servant-multipart-client + - swagger2 + - text + - vector + +library: + source-dirs: library + + generated-exposed-modules: + - Paths_ipfs + +tests: + ipfs-doctest: + main: Main.hs + source-dirs: test/doctest + dependencies: + - directory + - directory-tree + - doctest + - Glob + - lens-aeson + - QuickCheck + - yaml diff --git a/ipfs/test/coverage-code/Main.hs b/ipfs/test/coverage-code/Main.hs new file mode 100644 index 000000000..5719c546c --- /dev/null +++ b/ipfs/test/coverage-code/Main.hs @@ -0,0 +1,33 @@ +{-# OPTIONS_GHC -fno-warn-type-defaults #-} + +module Main (main) where + +import RIO +import qualified RIO.Partial as Part +import RIO.Process + +import Data.List (genericLength) +import Data.Maybe (catMaybes) +import System.Exit (exitFailure, exitSuccess) +import Text.Regex (matchRegex, mkRegex) + +main :: IO () +main = runSimpleApp do + output <- proc "hpc" ["report", "dist/hpc/tix/hspec/hspec.tix"] readProcessStdout_ + + if average (match $ show output) >= expected + then liftIO exitSuccess + else do + logWarn $ displayShow output + liftIO exitFailure + +match :: String -> [Int] +match = fmap Part.read . concat . catMaybes . fmap (matchRegex pattern) . lines + where + pattern = mkRegex "^ *([0-9]*)% " + +average :: (Fractional a, Real b) => [b] -> a +average xs = realToFrac (sum xs) / genericLength xs + +expected :: Fractional a => a +expected = 90 diff --git a/ipfs/test/coverage-docs/Main.hs b/ipfs/test/coverage-docs/Main.hs new file mode 100644 index 000000000..ae3801429 --- /dev/null +++ b/ipfs/test/coverage-docs/Main.hs @@ -0,0 +1,35 @@ +{-# OPTIONS_GHC -fno-warn-type-defaults #-} + +module Main (main) where + +import RIO +import qualified RIO.Partial as Part +import RIO.Process + +import Data.List (genericLength) +import Data.Maybe (catMaybes) +import System.Exit (exitFailure, exitSuccess) +import Text.Regex (matchRegex, mkRegex) + +main :: IO () +main = runSimpleApp do + output <- proc "cabal" ["new-haddock"] readProcessStdout_ + + if average (match $ show output) >= expected + then liftIO exitSuccess + else do + logWarn $ displayShow output + liftIO exitFailure + +match :: String -> [Int] +match = fmap Part.read + . concat + . catMaybes + . fmap (matchRegex $ mkRegex "^ *([0-9]*)% ") + . lines + +average :: (Fractional a, Real b) => [b] -> a +average xs = realToFrac (sum xs) / genericLength xs + +expected :: Fractional a => a +expected = 0 diff --git a/ipfs/test/doctest/Main.hs b/ipfs/test/doctest/Main.hs new file mode 100644 index 000000000..2805551eb --- /dev/null +++ b/ipfs/test/doctest/Main.hs @@ -0,0 +1,66 @@ +module Main (main) where + +import RIO +import qualified RIO.List as List + +import Data.Aeson.Lens +import Data.Yaml + +import System.Directory +import System.Directory.Tree +import System.FilePath.Glob (glob) + +import Test.DocTest (doctest) + +main :: IO () +main = do + let tmp = ".doctest-tmp" + setup tmp "library" + + source <- glob tmp + doctest source + + removeDirectoryRecursive tmp + +setup :: FilePath -> FilePath -> IO () +setup tmp src = do + pwd <- getCurrentDirectory + hasTmp <- doesDirectoryExist tmp + if hasTmp + then removeDirectoryRecursive tmp + else return () + + createDirectory tmp + exts <- getExts + + (_ :/ files) <- readDirectoryWithL readFileBinary src + go (pwd <> "/" <> tmp) (header exts) files + where + go :: FilePath -> ByteString -> DirTree ByteString -> IO () + go dirPath exts' = \case + Failed { err } -> + error $ show err + + Dir { name, contents } -> do + let path = dirPath <> "/" <> name + createDirectory path + contents `forM_` go path exts' + + File { name, file } -> + writeFileBinary (dirPath <> "/" <> name) (exts' <> file) + +header :: [ByteString] -> ByteString +header raw = mconcat + [ "{-# LANGUAGE " + , mconcat $ List.intersperse ", " raw + , " #-}\n" + ] + +getExts :: IO [ByteString] +getExts = do + pkg <- decodeFileThrow "package.yaml" :: IO Value + let exts = pkg ^. key "default-extensions" . _Array + return $ extract <$> toList exts + where + extract (String txt) = encodeUtf8 txt + extract _ = error "Malformed package.yaml" diff --git a/ipfs/test/lint/Main.hs b/ipfs/test/lint/Main.hs new file mode 100644 index 000000000..ba4e204ca --- /dev/null +++ b/ipfs/test/lint/Main.hs @@ -0,0 +1,22 @@ +module Main (main) where + +import RIO + +import Language.Haskell.HLint (hlint) + +arguments :: [String] +arguments = + [ "benchmark" + , "app" + , "library" + , "test/testsuite" + ] + +main :: IO () +main = hlint arguments >> exitSuccess + +-- main = do + -- hints <- hlint arguments + -- if null hints + -- then exitSuccess + -- else exitFailure diff --git a/ipfs/test/testsuite/Main.hs b/ipfs/test/testsuite/Main.hs new file mode 100644 index 000000000..733f1e9ba --- /dev/null +++ b/ipfs/test/testsuite/Main.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- {-# LANGUAGE QuasiQuotes #-} + +module Main (main) where + +import RIO + +import Test.Tasty (TestTree, defaultMainWithIngredients, testGroup) +import Test.Tasty.HUnit (Assertion, testCase, (@?=)) +import Test.Tasty.Ingredients.Rerun (rerunningTests) +import Test.Tasty.Runners (consoleTestReporter, listingTests) +import Test.Tasty.SmallCheck (testProperty) + +-- import Test.Hspec +-- import Test.Hspec.Wai +-- import Test.Hspec.Wai.JSON + +-- import Network.Wai.Handler.Warp (run) + +-- main :: IO () +-- main = return () + +-- main = do +-- -- port <- lookupSetting "PORT" 8081 +-- -- pool <- makePool Test + +-- -- runSqlPool doMigrate pool + +-- -- let logger = setLogger Test +-- -- config = Config { getPool = pool +-- -- , getEnv = Test +-- -- } + +-- putStrLn "Testing..." +-- hspec . spec . run port . logger $ app config + +-- spec :: IO () -> Spec +-- spec server = with server do +-- describe "GET /ping" $ do +-- it "responds with 200" do +-- 1 `shouldBe` 1 +-- -- get "/users" `shouldRespondWith` 200 + +-- -- it "responds with 'Simple'" do +-- -- get "/" `shouldRespondWith` "Simple" + +-- config = Config { getPool = , getEnv = Test } + +-- main :: IO () +-- main = return () + +main :: IO () +main = + defaultMainWithIngredients + [ rerunningTests [listingTests, consoleTestReporter] ] + (testGroup "all-tests" tests) + +tests :: [TestTree] +tests = + [ testGroup "SmallCheck" scTests + -- , testGroup "Unit tests" huTests + ] + +scTests :: [TestTree] +scTests = + [ testProperty "inc == succ" prop_succ + , testProperty "inc . negate == negate . pred" prop_pred + ] + +-- huTests :: [TestTree] +-- huTests = +-- [ testCase "Increment below TheAnswer" case_inc_below +-- , testCase "Decrement above TheAnswer" case_dec_above +-- ] + +prop_succ :: Int -> Bool +prop_succ n = 1 + n == 1 + n + +prop_pred :: Int -> Bool +prop_pred n = 1 + (negate n) == negate (n - 1) + +-- case_inc_below :: Assertion +-- case_inc_below = inc 41 @?= (42 :: Int) + +-- case_dec_above :: Assertion +-- case_dec_above = negate (inc (negate 43)) @?= (42 :: Int) diff --git a/stack.yaml b/stack.yaml index 1681f51af..2e737d51b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,5 +1,5 @@ -resolver: lts-18.13 -allow-newer: true +resolver: lts-18.14 +allow-newer: true # Needed for servant-ekg packages: - fission-cli @@ -7,6 +7,7 @@ packages: - fission-web-api - fission-web-client - fission-web-server + - ipfs extra-deps: - amazonka-1.6.1 @@ -14,20 +15,17 @@ extra-deps: - cryptostore-0.2.1.0 - dimensions-2.1.1.0 - hfsevents-0.1.6 - - ipfs-1.4.0 - lzma-clib-5.2.2 - raven-haskell-0.1.4.0 - rescue-0.4.2.1 - - servant-ekg-0.3.1 # Needs the allow-newer + - servant-ekg-0.3.1 - servant-multipart-client-0.12.1 - servant-swagger-ui-redoc-0.3.4.1.22.3 - servant-websockets-2.0.0 - unliftio-core-0.1.2.0 # Waiting for github to make it back into Stackage LTS 18 - - github-0.26 - - base16-bytestring-0.1.1.7 - - http-link-header-1.0.3.1 + - github-0.27 ghc-options: "$everything": -haddock diff --git a/stack.yaml.lock b/stack.yaml.lock index b548fda10..2898cf37d 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -39,13 +39,6 @@ packages: sha256: 14370510ec9a045fdc5b7e614279a84e3540a968f8b5ad12b8796916c4d6d1ee original: hackage: hfsevents-0.1.6 -- completed: - hackage: ipfs-1.4.0@sha256:1a6f8b8ec4d8cf1e1bd8f5ed7a2a1a0758855c1304d3dc60101ec1ca16dacf69,6207 - pantry-tree: - size: 4350 - sha256: 114e26db47980b29a3ce3635e0e36fe1d866e8c77fb854063cf872abe638135b - original: - hackage: ipfs-1.4.0 - completed: hackage: lzma-clib-5.2.2@sha256:25eb43d5fd8a8ab58380f475b91fb1fa907381f8a81c8d8ba63ba428d97ae0cc,4900 pantry-tree: @@ -103,29 +96,15 @@ packages: original: hackage: unliftio-core-0.1.2.0 - completed: - hackage: github-0.26@sha256:a9d4046325c3eb28cdc7bef2c3f5bb213328caeae0b7dce6f51de655f0bffaa1,7162 - pantry-tree: - size: 7511 - sha256: b71aab2984b268030c9e2617043575681134c1fe60dffbd5596e659c0a3e9aec - original: - hackage: github-0.26 -- completed: - hackage: base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231 - pantry-tree: - size: 454 - sha256: 2dc99cd67293b09204098202d0bdcdcf89d2b8c69ce6c8f4e31deadbdab2a7f9 - original: - hackage: base16-bytestring-0.1.1.7 -- completed: - hackage: http-link-header-1.0.3.1@sha256:9917c26635a46eff5d36c5344a4ae42fad2b5de79c0e300363bddd5eec66facd,1937 + hackage: github-0.27@sha256:074e69ad24b94b1199331b156e5373e9d4fa4a4452e02217f3539fe94a21a838,6995 pantry-tree: - size: 990 - sha256: 155feaf856daf5b55491048c8c4726ba765a8fe79263ebdbfc82f6c385a15715 + size: 7838 + sha256: b1c7b80c48aa78664cbf787ca3752d7e0389e32ad12c7912680ed10fd5c513ec original: - hackage: http-link-header-1.0.3.1 + hackage: github-0.27 snapshots: - completed: - size: 586268 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/13.yaml - sha256: d9e658a22cfe8d87a64fdf219885f942fef5fe2bcb156a9800174911c5da2443 - original: lts-18.13 + size: 586069 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/14.yaml + sha256: 87842ecbaa8ca9cee59a7e6be52369dbed82ed075cb4e0d152614a627e8fd488 + original: lts-18.14