diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,211 @@ + 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-2021 Aleksandr Krupenkin + +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. + + NOTE + +Individual files contain the following tag instead of the full license +text. + + SPDX-License-Identifier: Apache-2.0 + +This enables machine processing of license information based on the SPDX +License Identifiers that are here available: http://spdx.org/licenses/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Network/Ipfs/Api/Bitswap.hs b/src/Network/Ipfs/Api/Bitswap.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Bitswap.hs @@ -0,0 +1,41 @@ +-- | +-- Module : Network.Ipfs.Api.Bitswap +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `bitswap` prefix. +-- + +module Network.Ipfs.Api.Bitswap where + +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Text (Text) + +import Network.Ipfs.Api.Internal (_bitswapLedger, + _bitswapReprovide, + _bitswapStat, _bitswapWL) +import Network.Ipfs.Api.Internal.Call (call) +import Network.Ipfs.Api.Types (BitswapLedgerObj, + BitswapStatObj, BitswapWLObj, + ReprovideReturnType) +import Network.Ipfs.Client (IpfsT) + +-- | 'Show some diagnostic information on the bitswap agent. +stat :: MonadIO m => IpfsT m BitswapStatObj +stat = call _bitswapStat + +-- | Show blocks currently on the wantlist. +wl :: MonadIO m => IpfsT m BitswapWLObj +wl = call _bitswapWL + +-- | Show the current ledger for a peer. +ledger :: MonadIO m => Text -> IpfsT m BitswapLedgerObj +ledger = call . _bitswapLedger + +-- | Trigger reprovider. +reprovide :: MonadIO m => IpfsT m ReprovideReturnType +reprovide = call _bitswapReprovide diff --git a/src/Network/Ipfs/Api/Block.hs b/src/Network/Ipfs/Api/Block.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Block.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Ipfs.Api.Block +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `block` prefix. +-- + +module Network.Ipfs.Api.Block where + +import Control.Monad.IO.Class (MonadIO) +import Data.Aeson (decode) +import Data.Text (Text) +import Network.HTTP.Client (responseBody) + +import Network.Ipfs.Api.Internal (_blockGet, _blockStat) +import Network.Ipfs.Api.Internal.Call (call, multipartCall) +import Network.Ipfs.Api.Types (BlockObj, BlockReturnType) +import Network.Ipfs.Client (IpfsT) + +-- | Get a raw IPFS block. +get :: MonadIO m => Text -> IpfsT m BlockReturnType +get = call . _blockGet + +-- | Store input as an IPFS block. +put :: MonadIO m => Text -> IpfsT m (Maybe BlockObj) +put = fmap decodeResponse . multipartCall "block/put" + where + decodeResponse = decode . responseBody + +-- | Print information of a raw IPFS block. +stat :: MonadIO m => Text -> IpfsT m BlockObj +stat = call . _blockStat diff --git a/src/Network/Ipfs/Api/Bootstrap.hs b/src/Network/Ipfs/Api/Bootstrap.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Bootstrap.hs @@ -0,0 +1,34 @@ +-- | +-- Module : Network.Ipfs.Api.Bootstrap +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `bootstrap` prefix. +-- + +module Network.Ipfs.Api.Bootstrap where + +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text) + +import Network.Ipfs.Api.Internal (_bootstrapAdd, _bootstrapList, + _bootstrapRM) +import Network.Ipfs.Api.Internal.Call (call) +import Network.Ipfs.Api.Types (BootstrapObj) +import Network.Ipfs.Client (IpfsT) + +-- | Add peers to the bootstrap list. +add :: MonadIO m => Text -> IpfsT m BootstrapObj +add = call . _bootstrapAdd . Just + +-- | Show peers in the bootstrap list. +list :: MonadIO m => IpfsT m BootstrapObj +list = call _bootstrapList + +-- | Remove peers from the bootstrap list. +rm :: MonadIO m => Text -> IpfsT m BootstrapObj +rm = call . _bootstrapRM . Just diff --git a/src/Network/Ipfs/Api/Cid.hs b/src/Network/Ipfs/Api/Cid.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Cid.hs @@ -0,0 +1,44 @@ +-- | +-- Module : Network.Ipfs.Api.Cid +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `cid` prefix. +-- + +module Network.Ipfs.Api.Cid where + +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text) + +import Network.Ipfs.Api.Internal (_cidBase32, _cidBases, + _cidCodecs, _cidFormat, + _cidHashes) +import Network.Ipfs.Api.Internal.Call (call) +import Network.Ipfs.Api.Types (CidBasesObj, CidCodecsObj, + CidHashesObj, CidObj) +import Network.Ipfs.Client (IpfsT) + +-- | List available multibase encodings. +bases :: MonadIO m => IpfsT m [CidBasesObj] +bases = call _cidBases + +-- | List available CID codecs. +codecs :: MonadIO m => IpfsT m [CidCodecsObj] +codecs = call _cidCodecs + +-- | List available multihashes. +hashes :: MonadIO m => IpfsT m [CidHashesObj] +hashes = call _cidHashes + +-- | Convert CIDs to Base32 CID version 1. +base32 :: MonadIO m => Text -> IpfsT m CidObj +base32 = call . _cidBase32 + +-- | Format and convert a CID in various useful ways. +format :: MonadIO m => Text -> IpfsT m CidObj +format = call . _cidFormat diff --git a/src/Network/Ipfs/Api/Config.hs b/src/Network/Ipfs/Api/Config.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Config.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Ipfs.Api.Config +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `config` prefix. +-- + +module Network.Ipfs.Api.Config where + +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text) +import Network.HTTP.Client (responseStatus) +import Network.HTTP.Types (Status (..)) + +import Network.Ipfs.Api.Internal (_configGet, _configSet) +import Network.Ipfs.Api.Internal.Call (call, multipartCall) +import Network.Ipfs.Api.Types (ConfigObj) +import Network.Ipfs.Client (IpfsT) + + +-- | Get ipfs config values. +get :: MonadIO m => Text -> IpfsT m ConfigObj +get = call . _configGet + +-- | Set ipfs config values. +set :: MonadIO m => Text -> Maybe Text -> IpfsT m ConfigObj +set key = call . _configSet key + +-- | Replace the config with the file at . +replace :: MonadIO m => Text -> IpfsT m Bool +replace = fmap isSuccess . multipartCall "config/replace" + where + isSuccess = (== 200) . statusCode . responseStatus diff --git a/src/Network/Ipfs/Api/Core.hs b/src/Network/Ipfs/Api/Core.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Core.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Ipfs.Api.Core +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Core IPFS API calls. +-- + +module Network.Ipfs.Api.Core where + +import qualified Codec.Archive.Tar as Tar +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Aeson (decode) +import Data.ByteString.Lazy (fromStrict) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Network.HTTP.Client (responseBody) +import Servant.API.ContentTypes (NoContent) + +import Network.Ipfs.Api.Internal (_cat, _dns, _get, _id, + _idPeer, _ls, _shutdown, + _version) +import Network.Ipfs.Api.Internal.Call (call, multipartCall, + streamCall) +import Network.Ipfs.Api.Internal.Stream (_ping, _refs, _refsLocal) +import Network.Ipfs.Api.Types (AddObj, CatReturnType, + DnsObj, IdObj, LsObj, + VersionObj) +import Network.Ipfs.Client (IpfsT) + +-- | Show IPFS object data. +cat :: MonadIO m => Text -> IpfsT m CatReturnType +cat = call . _cat + +-- | Add a file or directory to ipfs. +add :: MonadIO m => Text -> IpfsT m (Maybe AddObj) +add = fmap decodeResponse . multipartCall "add" + where + decodeResponse = decode . responseBody + +-- | List directory contents for Unix filesystem objects. +ls :: MonadIO m => Text -> IpfsT m LsObj +ls = call . _ls + +-- | Download IPFS objects. +get :: MonadIO m => Text -> IpfsT m Text +get hash = do + ret <- call $ _get hash + do liftIO $ Tar.unpack "getResponseDirectory" . Tar.read . fromStrict $ encodeUtf8 ret + pure "The content has been stored in getResponseDirectory." + +-- | Show ipfs version information. +version :: MonadIO m => IpfsT m VersionObj +version = call _version + +-- | Show ipfs node id info. +id :: MonadIO m => IpfsT m IdObj +id = call _id + +-- | Show ipfs node id info of the given peerId. +idPeer :: MonadIO m => Text -> IpfsT m IdObj +idPeer = call . _idPeer + +-- | Resolve DNS links. +dns :: MonadIO m => Text -> IpfsT m DnsObj +dns = call . _dns + +-- | List links (references) from an object. +refs :: MonadIO m => Text -> m () +refs = streamCall . _refs + +-- | List all local references. +refsLocal :: MonadIO m => m () +refsLocal = streamCall _refsLocal + +-- | Send echo request packets to IPFS hosts. +ping :: MonadIO m => Text -> m () +ping = streamCall . _ping + +-- | Shut down the ipfs daemon. +shutdown :: MonadIO m => IpfsT m NoContent +shutdown = call _shutdown diff --git a/src/Network/Ipfs/Api/Dag.hs b/src/Network/Ipfs/Api/Dag.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Dag.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Ipfs.Api.Dag +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `dag` prefix. +-- + +module Network.Ipfs.Api.Dag where + +import Control.Monad.IO.Class (MonadIO) +import Data.Aeson (decode) +import Data.Text (Text) +import Network.HTTP.Client (responseBody) + +import Network.Ipfs.Api.Internal (_dagGet, _dagResolve) +import Network.Ipfs.Api.Internal.Call (call, multipartCall) +import Network.Ipfs.Api.Types (DagPutObj, DagResolveObj, + DagReturnType) +import Network.Ipfs.Client (IpfsT) + +-- | Get a dag node from ipfs. +get :: MonadIO m => Text -> IpfsT m DagReturnType +get = call . _dagGet + +-- | Resolve ipld block. +resolve :: MonadIO m => Text -> IpfsT m DagResolveObj +resolve = call . _dagResolve + +-- | Add a dag node to ipfs. +put :: MonadIO m => Text -> IpfsT m (Maybe DagPutObj) +put = fmap decodeResponse . multipartCall "dag/put" + where + decodeResponse = decode . responseBody diff --git a/src/Network/Ipfs/Api/Dht.hs b/src/Network/Ipfs/Api/Dht.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Dht.hs @@ -0,0 +1,41 @@ +-- | +-- Module : Network.Ipfs.Api.Dht +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `dht` prefix. +-- + +module Network.Ipfs.Api.Dht where + +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text) + +import Network.Ipfs.Api.Internal.Call (streamCall) +import Network.Ipfs.Api.Internal.Stream (_dhtFindPeer, _dhtFindProvs, + _dhtGet, _dhtProvide, + _dhtQuery) + +-- | Find the multiaddresses associated with the given peerId. +findPeer :: MonadIO m => Text -> m () +findPeer = streamCall . _dhtFindPeer + +-- | Find peers that can provide a specific value, given a key. +findProvs :: MonadIO m => Text -> m () +findProvs = streamCall . _dhtFindProvs + +-- | Given a key, query the routing system for its best value. +get :: MonadIO m => Text -> m () +get cid = streamCall $ _dhtGet cid + +-- | Announce to the network that you are providing given values. +provide :: MonadIO m => Text -> m () +provide = streamCall . _dhtProvide + +-- | Find the closest Peer IDs to a given peerID by querying the DHT. +query :: MonadIO m => Text -> m () +query = streamCall . _dhtQuery diff --git a/src/Network/Ipfs/Api/Files.hs b/src/Network/Ipfs/Api/Files.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Files.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Ipfs.Api.Files +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `files` prefix. +-- + +module Network.Ipfs.Api.Files where + +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text, pack) +import Network.HTTP.Client (responseStatus) +import Network.HTTP.Types (Status (..)) +import Servant.API.ContentTypes (NoContent) + +import Network.Ipfs.Api.Internal (_filesChcid, _filesCp, + _filesFlush, _filesLs, + _filesMkdir, _filesMv, + _filesRead, _filesRm, + _filesStat) +import Network.Ipfs.Api.Internal.Call (call, multipartCall) +import Network.Ipfs.Api.Types (FilesFlushObj, FilesLsObj, + FilesReadType, FilesStatObj) +import Network.Ipfs.Client (IpfsT) + +-- | Change the cid version or hash function of the root node of a given mfsPath. +chcidVer :: MonadIO m => Text -> Int -> IpfsT m NoContent +chcidVer mfsPath = call . _filesChcid (Just mfsPath) . Just + +-- | Copy files into mfs. +cp :: MonadIO m => Text -> Text -> IpfsT m NoContent +cp src = call . _filesCp (Just src) . Just + +-- | Flush a given path's data to disk. +flush :: MonadIO m => Text -> IpfsT m FilesFlushObj +flush = call . _filesFlush . Just + +-- | List directories in the local mutable namespace. +ls :: MonadIO m => Text -> IpfsT m FilesLsObj +ls = call . _filesLs . Just + +-- | Make directories. +mkdir :: MonadIO m => Text -> IpfsT m NoContent +mkdir = call . _filesMkdir . Just + +-- | Move files. +mv :: MonadIO m => Text -> Text -> IpfsT m NoContent +mv src = call . _filesMv (Just src) . Just + +-- | Read a file in a given mfs. +read :: MonadIO m => Text -> IpfsT m FilesReadType +read = call . _filesRead . Just + +-- | Display file status. +stat :: MonadIO m => Text -> IpfsT m FilesStatObj +stat = call . _filesStat . Just + +-- | Remove a file. +filesRm :: MonadIO m => Text -> IpfsT m NoContent +filesRm = call . flip _filesRm (Just True) . Just + +-- | Write to a mutable file in a given filesystem. +write :: MonadIO m => Text -> Text -> Bool -> IpfsT m Bool +write mfsPath filePath toTruncate = isSuccess <$> multipartCall uri filePath + where + uri = "files/write?arg=" <> mfsPath <> "&create=true" <> "&truncate=" <> (pack $ show toTruncate) + isSuccess = (200 ==) . statusCode . responseStatus diff --git a/src/Network/Ipfs/Api/Internal.hs b/src/Network/Ipfs/Api/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Internal.hs @@ -0,0 +1,100 @@ +-- | +-- Module : Network.Ipfs.Api.Internal +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- IPFS API internals. +-- + +module Network.Ipfs.Api.Internal where + +import Data.Proxy (Proxy (..)) +import Data.Text (Text) +import Servant.API +import Servant.Client (ClientM, client) + +import Network.Ipfs.Api.Types + +_ipfsApi :: Proxy IpfsApi +_ipfsApi = Proxy + +_cat :: Text -> ClientM CatReturnType +_ls :: Text -> ClientM LsObj +_get :: Text -> ClientM GetReturnType +_swarmPeers :: ClientM SwarmPeersObj +_swarmConnect :: Maybe Text -> ClientM SwarmObj +_swarmDisconnect :: Maybe Text -> ClientM SwarmObj +_swarmFilters :: ClientM SwarmObj +_swarmFilterAdd :: Maybe Text -> ClientM SwarmObj +_swarmFilterRm :: Maybe Text -> ClientM SwarmObj +_bitswapStat :: ClientM BitswapStatObj +_bitswapWL :: ClientM BitswapWLObj +_bitswapLedger :: Text -> ClientM BitswapLedgerObj +_bitswapReprovide :: ClientM ReprovideReturnType +_cidBases :: ClientM [CidBasesObj] +_cidCodecs :: ClientM [CidCodecsObj] +_cidHashes :: ClientM [CidHashesObj] +_cidBase32 :: Text -> ClientM CidObj +_cidFormat :: Text -> ClientM CidObj +_blockGet :: Text -> ClientM BlockReturnType +_blockStat :: Text -> ClientM BlockObj +_dagGet :: Text -> ClientM DagReturnType +_dagResolve :: Text -> ClientM DagResolveObj +_configGet :: Text -> ClientM ConfigObj +_configSet :: Text -> Maybe Text -> ClientM ConfigObj +_objectData :: Text -> ClientM ObjectReturnType +_objectNew :: ClientM ObjectObj +_objectGetLinks :: Text -> ClientM ObjectLinksObj +_objectAddLink :: Text -> Maybe Text -> Maybe Text -> ClientM ObjectLinksObj +_objectRmLink :: Text -> Maybe Text -> ClientM ObjectLinksObj +_objectGet :: Text -> ClientM ObjectGetObj +_objectDiff :: Text -> Maybe Text -> ClientM ObjectDiffObj +_objectStat :: Text -> ClientM ObjectStatObj +_pinAdd :: Text -> ClientM PinObj +_pinRemove :: Text -> ClientM PinObj +_bootstrapAdd :: Maybe Text -> ClientM BootstrapObj +_bootstrapList :: ClientM BootstrapObj +_bootstrapRM :: Maybe Text -> ClientM BootstrapObj +_statsBw :: ClientM StatsBwObj +_statsRepo :: ClientM StatsRepoObj +_version :: ClientM VersionObj +_id :: ClientM IdObj +_idPeer :: Text -> ClientM IdObj +_dns :: Text -> ClientM DnsObj +_pubsubLs :: ClientM PubsubObj +_pubsubPeers :: ClientM PubsubObj +_pubsubPublish :: Text -> Maybe Text -> ClientM NoContent +_logLs :: ClientM LogLsObj +_logLevel :: Text -> Maybe Text -> ClientM LogLevelObj +_repoVersion :: ClientM RepoVersionObj +_repoFsck :: ClientM RepoFsckObj +_keyGen :: Text -> (Maybe Text) -> ClientM KeyDetailsObj +_keyList :: ClientM KeyObj +_keyRename :: Text -> (Maybe Text) -> ClientM KeyRenameObj +_keyRm :: Text -> ClientM KeyObj +_filesChcid :: Maybe Text -> Maybe Int -> ClientM NoContent +_filesCp :: Maybe Text -> Maybe Text -> ClientM NoContent +_filesFlush :: Maybe Text -> ClientM FilesFlushObj +_filesLs :: Maybe Text -> ClientM FilesLsObj +_filesMkdir :: Maybe Text -> ClientM NoContent +_filesMv :: Maybe Text -> Maybe Text -> ClientM NoContent +_filesRead :: Maybe Text -> ClientM FilesReadType +_filesRm :: Maybe Text -> Maybe Bool -> ClientM NoContent +_filesStat :: Maybe Text -> ClientM FilesStatObj +_shutdown :: ClientM NoContent + +_cat :<|> _ls :<|> _get :<|> _swarmPeers :<|> _swarmConnect :<|> _swarmDisconnect :<|> + _swarmFilters :<|> _swarmFilterAdd :<|> _swarmFilterRm :<|> _bitswapStat :<|> _bitswapWL :<|> _bitswapLedger :<|> + _bitswapReprovide :<|> _cidBases :<|> _cidCodecs :<|> _cidHashes :<|> _cidBase32 :<|> _cidFormat :<|> + _blockGet :<|> _blockStat :<|> _dagGet :<|> _dagResolve :<|> _configGet :<|> + _configSet :<|> _objectData :<|> _objectNew :<|> _objectGetLinks :<|> _objectAddLink :<|> _objectRmLink :<|> + _objectGet :<|> _objectDiff :<|> _objectStat :<|> _pinAdd :<|> _pinRemove :<|> _bootstrapAdd :<|> + _bootstrapList :<|> _bootstrapRM :<|> _statsBw :<|> _statsRepo :<|> _version :<|> _id :<|> _idPeer :<|> + _dns :<|> _pubsubLs :<|> _pubsubPeers :<|> _pubsubPublish :<|> _logLs :<|> _logLevel :<|> _repoVersion :<|> + _repoFsck :<|> _keyGen :<|> _keyList :<|> _keyRename :<|> _keyRm :<|> _filesChcid :<|> _filesCp :<|> + _filesFlush :<|> _filesLs :<|> _filesMkdir :<|> _filesMv :<|> _filesRead :<|> _filesRm :<|> _filesStat :<|> + _shutdown = client _ipfsApi diff --git a/src/Network/Ipfs/Api/Internal/Call.hs b/src/Network/Ipfs/Api/Internal/Call.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Internal/Call.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +-- | +-- Module : Network.Ipfs.Api.Internal.Call +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Module containing IPFS API call functions. +-- + +module Network.Ipfs.Api.Internal.Call where + +import Control.Monad.Except +import Control.Monad.Reader +import Data.ByteString.Lazy (ByteString) +import Data.Text (Text, pack, unpack) +import Network.HTTP.Client as Net hiding (Proxy) +import Network.HTTP.Client.MultipartFormData +import Servant.Client +import qualified Servant.Client.Streaming as S +import Servant.Types.SourceT (SourceT (..), foreach) + +import Network.Ipfs.Client (IpfsT) + +-- | Regular Call function. +call :: MonadIO m => ClientM a -> IpfsT m a +call func = do + (manager', url, _) <- ask + resp <- liftIO (runClientM func (mkClientEnv manager' url)) + case resp of + Left l -> throwError l + Right r -> return r + +-- | Call function for ‘multipart/form-data’. +multipartCall :: MonadIO m => Text -> Text -> IpfsT m (Net.Response ByteString) +multipartCall funcUri filePath = do + (reqManager, _, url) <- ask + req <- liftIO $ parseRequest $ unpack (pack url <> "/" <> funcUri ) + liftIO $ flip httpLbs reqManager =<< formDataBody form req + where + form = [ partFileSource "file" $ unpack filePath ] + +-- | Call function for Streams. +streamCall :: (MonadIO m, Show a) => S.ClientM (SourceT IO a) -> m () +streamCall func = liftIO $ do + manager' <- newManager defaultManagerSettings + S.withClientM func (S.mkClientEnv manager' (BaseUrl Http "localhost" 5001 "/api/v0")) $ \e -> case e of + Left err -> putStrLn $ "Error: " ++ show err + Right rs -> foreach fail print rs diff --git a/src/Network/Ipfs/Api/Internal/Stream.hs b/src/Network/Ipfs/Api/Internal/Stream.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Internal/Stream.hs @@ -0,0 +1,41 @@ +-- | +-- Module : Network.Ipfs.Api.Internal.Stream +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Ipfs Stream API provider. +-- + +module Network.Ipfs.Api.Internal.Stream where + +import qualified Data.ByteString.Lazy.Char8 () +import Data.Proxy +import Data.Text +import Network.HTTP.Client () +import Servant.API +import Servant.Client.Streaming as S + +import Network.Ipfs.Api.Types.Stream + +_ipfsStreamApi :: Proxy IpfsStreamApi +_ipfsStreamApi = Proxy + +_ping :: Text -> ClientM (SourceIO PingObj) +_dhtFindPeer :: Text -> ClientM (SourceIO DhtObj) +_dhtFindProvs :: Text -> ClientM (SourceIO DhtObj) +_dhtGet :: Text -> ClientM (SourceIO DhtObj) +_dhtProvide :: Text -> ClientM (SourceIO DhtObj) +_dhtQuery :: Text -> ClientM (SourceIO DhtObj) +_logTail :: ClientM (SourceIO LogReturnType) +_repoGc :: ClientM (SourceIO RepoGcObj) +_repoVerify :: ClientM (SourceIO RepoVerifyObj) +_refs :: Text -> ClientM (SourceIO RefsObj) +_refsLocal :: ClientM (SourceIO RefsObj) +_pubsubSubscribe :: Text -> ClientM (SourceIO PubsubSubObj) + +_ping :<|> _dhtFindPeer :<|> _dhtFindProvs :<|> _dhtGet :<|> _dhtProvide :<|> _dhtQuery :<|> + _logTail :<|> _repoGc :<|> _repoVerify :<|> _refs :<|> _refsLocal :<|> _pubsubSubscribe = client _ipfsStreamApi diff --git a/src/Network/Ipfs/Api/Key.hs b/src/Network/Ipfs/Api/Key.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Key.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +-- | +-- Module : Network.Ipfs.Api.Key +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `key` prefix. +-- + +module Network.Ipfs.Api.Key where + +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text) + +import Network.Ipfs.Api.Internal (_keyGen, _keyList, _keyRename, + _keyRm) +import Network.Ipfs.Api.Internal.Call (call) +import Network.Ipfs.Api.Types (KeyDetailsObj, KeyObj, + KeyRenameObj) +import Network.Ipfs.Client (IpfsT) + + +-- | 'List all local keypairs. +list :: MonadIO m => IpfsT m KeyObj +list = call _keyList + +-- | Create a new keypair. +gen :: MonadIO m => Text -> Text -> IpfsT m KeyDetailsObj +gen name = call . _keyGen name . Just + +-- | Rename a keypair. +rename :: MonadIO m => Text -> Text -> IpfsT m KeyRenameObj +rename was = call . _keyRename was . Just + +-- | Remove a keypair. +rm :: MonadIO m => Text -> IpfsT m KeyObj +rm = call . _keyRm + diff --git a/src/Network/Ipfs/Api/Log.hs b/src/Network/Ipfs/Api/Log.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Log.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +-- | +-- Module : Network.Ipfs.Api.Log +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `log` prefix. +-- + +module Network.Ipfs.Api.Log where + +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text) + +import Network.Ipfs.Api.Internal (_logLevel, _logLs) +import Network.Ipfs.Api.Internal.Call (call, streamCall) +import Network.Ipfs.Api.Internal.Stream (_logTail) +import Network.Ipfs.Api.Types (LogLevelObj, LogLsObj) +import Network.Ipfs.Client (IpfsT) + + +-- | Change the logging level. +level :: MonadIO m => Text -> Text -> IpfsT m LogLevelObj +level subsystem = call . _logLevel subsystem . Just + +-- | Read the event log. +tail :: MonadIO m => m () +tail = streamCall _logTail + +-- | List the logging subsystems. +ls :: MonadIO m => IpfsT m LogLsObj +ls = call _logLs diff --git a/src/Network/Ipfs/Api/Object.hs b/src/Network/Ipfs/Api/Object.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Object.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Ipfs.Api.Object +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `object` prefix. +-- + +module Network.Ipfs.Api.Object where + +import Control.Monad.IO.Class (MonadIO) +import Data.Aeson (decode) +import Data.Text (Text) +import Network.HTTP.Client (responseBody) + +import Network.Ipfs.Api.Internal (_objectAddLink, _objectData, + _objectDiff, _objectGet, + _objectGetLinks, _objectNew, + _objectRmLink, _objectStat) +import Network.Ipfs.Api.Internal.Call (call, multipartCall) +import Network.Ipfs.Api.Types (ObjectDiffObj, ObjectGetObj, + ObjectLinksObj, ObjectObj, + ObjectReturnType, + ObjectStatObj) +import Network.Ipfs.Client (IpfsT) + +-- | Output the raw bytes of an IPFS object. +object :: MonadIO m => Text -> IpfsT m ObjectReturnType +object = call . _objectData + +-- | Create a new object from an ipfs template. +new :: MonadIO m => IpfsT m ObjectObj +new = call _objectNew + +-- | Output the links pointed to by the specified object. +getLinks :: MonadIO m => Text -> IpfsT m ObjectLinksObj +getLinks = call . _objectGetLinks + +-- | Add a Merkle-link to the given object and return the hash of the result. +addLink :: MonadIO m => Text -> Text -> Text -> IpfsT m ObjectLinksObj +addLink hash name = call . _objectAddLink hash (Just name) . Just + +-- | Remove a Merkle-link from the given object and return the hash of the result. +rmLink :: MonadIO m => Text -> Text -> IpfsT m ObjectLinksObj +rmLink key = call . _objectRmLink key . Just + +-- | Append data to what already exists in the data segment in the given object. +appendData :: MonadIO m => Text -> Text -> IpfsT m (Maybe ObjectLinksObj) +appendData key = fmap decodeResponse . multipartCall ("object/patch/append-data?arg=" <> key) + where + decodeResponse = decode . responseBody + +-- | Set the data field of an IPFS object. +setData :: MonadIO m => Text -> Text -> IpfsT m (Maybe ObjectLinksObj) +setData key = fmap decodeResponse . multipartCall ("object/patch/set-data?arg=" <> key) + where + decodeResponse = decode . responseBody + +-- | Get and serialize the DAG node named by key. +get :: MonadIO m => Text -> IpfsT m ObjectGetObj +get = call . _objectGet + +-- | 'Display the diff between two ipfs objects. +diff :: MonadIO m => Text -> Text -> IpfsT m ObjectDiffObj +diff firstKey = call . _objectDiff firstKey . Just + +-- | Store input as a DAG object, print its key. +put :: MonadIO m => Text -> IpfsT m (Maybe ObjectObj) +put = fmap decodeResponse . multipartCall "object/put" + where + decodeResponse = decode . responseBody + +-- | Get stats for the DAG node named by key. +objectStat :: MonadIO m => Text -> IpfsT m ObjectStatObj +objectStat = call . _objectStat diff --git a/src/Network/Ipfs/Api/Pin.hs b/src/Network/Ipfs/Api/Pin.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Pin.hs @@ -0,0 +1,29 @@ +-- | +-- Module : Network.Ipfs.Api.Pin +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `pin` prefix. +-- + +module Network.Ipfs.Api.Pin where + +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text) + +import Network.Ipfs.Api.Internal (_pinAdd, _pinRemove) +import Network.Ipfs.Api.Internal.Call (call) +import Network.Ipfs.Api.Types (PinObj) +import Network.Ipfs.Client (IpfsT) + +-- | Pin objects to local storage. +add :: MonadIO m => Text -> IpfsT m PinObj +add = call . _pinAdd + +-- | Remove pinned objects from local storage. +remove :: MonadIO m => Text -> IpfsT m PinObj +remove = call . _pinRemove diff --git a/src/Network/Ipfs/Api/Pubsub.hs b/src/Network/Ipfs/Api/Pubsub.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Pubsub.hs @@ -0,0 +1,39 @@ +-- | +-- Module : Network.Ipfs.Api.Pubsub +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `pubsub` prefix. +-- + +module Network.Ipfs.Api.Pubsub where + +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text) +import Servant.API.ContentTypes (NoContent) + +import Network.Ipfs.Api.Internal (_pubsubLs, _pubsubPeers, + _pubsubPublish) +import Network.Ipfs.Api.Internal.Call (call) +import Network.Ipfs.Api.Types (PubsubObj) +import Network.Ipfs.Client (IpfsT) + +-- | List subscribed topics by name. +ls :: MonadIO m => IpfsT m PubsubObj +ls = call _pubsubLs + +-- | List peers we are currently pubsubbing with. +peers :: MonadIO m => IpfsT m PubsubObj +peers = call _pubsubPeers + +-- | Publish a message to a given pubsub topic. +publish :: MonadIO m => Text -> Text -> IpfsT m NoContent +publish topic = call . _pubsubPublish topic . Just + +-- | Subscribe to messages on a given topic. +--subscribe :: Text -> m () +--subscribe = pubsubCall . _pubsubSubscribe diff --git a/src/Network/Ipfs/Api/Repo.hs b/src/Network/Ipfs/Api/Repo.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Repo.hs @@ -0,0 +1,37 @@ +-- | +-- Module : Network.Ipfs.Api.Repo +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `repo` prefix. +-- + +module Network.Ipfs.Api.Repo where + +import Control.Monad.IO.Class (MonadIO) + +import Network.Ipfs.Api.Internal (_repoFsck, _repoVersion) +import Network.Ipfs.Api.Internal.Call (call, streamCall) +import Network.Ipfs.Api.Internal.Stream (_repoGc, _repoVerify) +import Network.Ipfs.Api.Types (RepoFsckObj, RepoVersionObj) +import Network.Ipfs.Client (IpfsT) + +-- | Show the repo version. +version :: MonadIO m => IpfsT m RepoVersionObj +version = call _repoVersion + +-- | Remove repo lockfiles. +fsck :: MonadIO m => IpfsT m RepoFsckObj +fsck = call _repoFsck + +-- | Perform a garbage collection sweep on the repo. +gc :: MonadIO m => m () +gc = streamCall _repoGc + +-- | Verify all blocks in repo are not corrupted. +repoVerify :: MonadIO m => m () +repoVerify = streamCall _repoVerify diff --git a/src/Network/Ipfs/Api/Stats.hs b/src/Network/Ipfs/Api/Stats.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Stats.hs @@ -0,0 +1,28 @@ +-- | +-- Module : Network.Ipfs.Api.Stats +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `stats` prefix. +-- + +module Network.Ipfs.Api.Stats where + +import Control.Monad.IO.Class (MonadIO) + +import Network.Ipfs.Api.Internal (_statsBw, _statsRepo) +import Network.Ipfs.Api.Internal.Call (call) +import Network.Ipfs.Api.Types (StatsBwObj, StatsRepoObj) +import Network.Ipfs.Client (IpfsT) + +-- | IPFS bandwidth information. +bw :: MonadIO m => IpfsT m StatsBwObj +bw = call _statsBw + +-- | Get stats for the currently used repo. +repo :: MonadIO m => IpfsT m StatsRepoObj +repo = call _statsRepo diff --git a/src/Network/Ipfs/Api/Swarm.hs b/src/Network/Ipfs/Api/Swarm.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Swarm.hs @@ -0,0 +1,49 @@ +-- | +-- Module : Network.Ipfs.Api.Swarm +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- Api calls with `swarm` prefix. +-- + +module Network.Ipfs.Api.Swarm where + +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text) + +import Network.Ipfs.Api.Internal (_swarmConnect, + _swarmDisconnect, + _swarmFilterAdd, + _swarmFilterRm, _swarmFilters, + _swarmPeers) +import Network.Ipfs.Api.Internal.Call (call) +import Network.Ipfs.Api.Types (SwarmObj, SwarmPeersObj) +import Network.Ipfs.Client (IpfsT) + +-- | List peers with open connections. +swarmPeers :: MonadIO m => IpfsT m SwarmPeersObj +swarmPeers = call _swarmPeers + +-- | Open connection to a given address. 'peerId' has to be of the format - /ipfs/id +connect :: MonadIO m => Text -> IpfsT m SwarmObj +connect = call . _swarmConnect . Just + +-- | Close connection to a given address. 'peerId' has to be of the format - /ipfs/id +disconnect :: MonadIO m => Text -> IpfsT m SwarmObj +disconnect = call . _swarmDisconnect . Just + +-- | Manipulate address filters. +filters :: MonadIO m => IpfsT m SwarmObj +filters = call _swarmFilters + +-- | Add an address filter. 'peerId' has to be of the format - /ip4/{IP addr of peer}/ipcidr/{ip network prefix} +filterAdd :: MonadIO m => Text -> IpfsT m SwarmObj +filterAdd = call . _swarmFilterAdd . Just + +-- | Remove an address filter. +filterRm :: MonadIO m => Text -> IpfsT m SwarmObj +filterRm = call . _swarmFilterRm . Just diff --git a/src/Network/Ipfs/Api/Types.hs b/src/Network/Ipfs/Api/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Types.hs @@ -0,0 +1,823 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +-- | +-- Module : Network.Ipfs.Api.Types +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- IPFS API types. +-- + +module Network.Ipfs.Api.Types where + +import Control.Arrow (left) +import Control.Monad +import Data.Aeson +import Data.ByteString.Lazy (toStrict) +import qualified Data.ByteString.Lazy.Char8 () +import qualified Data.HashMap.Strict as H +import Data.Int +import Data.Text (Text) +import qualified Data.Text.Encoding as TextS +import Data.Typeable +import Network.HTTP.Client () +import qualified Network.HTTP.Media as M ((//)) +import Servant.API + +type CatReturnType = Text +type ReprovideReturnType = Text +type GetReturnType = Text +type BlockReturnType = Text +type DagReturnType = Text +type ObjectReturnType = Text +type FilesReadType = Text + +data DirLink = DirLink + { dlName :: Text + , dlHash :: Text + , dlSize :: Int64 + , dlContentType :: Int + , dlTarget :: Text + } + deriving (Show, Eq) + +data DirObj = DirObj + { dirHash :: Text + , links :: [DirLink] + } + deriving (Show, Eq) + +data AddObj = AddObj + { name :: Text + , hash :: Text + , size :: Text + } + deriving (Show, Eq) + +instance FromJSON AddObj where + parseJSON (Object o) = + AddObj <$> o .: "Name" + <*> o .: "Hash" + <*> o .: "Size" + + parseJSON _ = mzero + +data LsObj = LsObj + { objs :: [DirObj] + } + deriving (Show, Eq) + +data SwarmStreamObj = SwarmStreamObj + { protocol :: Text + } + deriving (Show, Eq) + +data SwarmPeerObj = SwarmPeerObj + { address :: Text + , direction :: Int + , latency :: Text + , muxer :: Text + , peer :: Text + , streams :: Maybe [SwarmStreamObj] + } + deriving (Show, Eq) + +data SwarmPeersObj = SwarmPeersObj + { peers :: [SwarmPeerObj] + } + deriving (Show, Eq) + +data SwarmObj = SwarmObj + { strings :: [Text] + } + deriving (Show, Eq) + +data WantlistObj = WantlistObj + { forSlash :: Text + } + deriving (Show, Eq) + +data BitswapStatObj = BitswapStatObj + { blocksReceived :: Int64 + , blocksSent :: Int64 + , dataReceived :: Int64 + , dataSent :: Int64 + , dupBlksReceived :: Int64 + , dupDataReceived :: Int64 + , messagesReceived :: Int64 + , bitswapPeers :: [Text] + , provideBufLen :: Int + , wantlist :: [WantlistObj] + } + deriving (Show, Eq) + +data BitswapWLObj = BitswapWLObj + { bitswapKeys :: [WantlistObj] + } + deriving (Show, Eq) + +data BitswapLedgerObj = BitswapLedgerObj + { exchanged :: Int64 + , ledgerPeer :: Text + , recv :: Int64 + , sent :: Int64 + , value :: Double + } + deriving (Show, Eq) + +data CidBasesObj = CidBasesObj + { baseCode :: Int + , baseName :: Text + } + deriving (Show, Eq) + +data CidCodecsObj = CidCodecsObj + { codecCode :: Int + , codecName :: Text + } + deriving (Show, Eq) + +data CidHashesObj = CidHashesObj + { multihashCode :: Int + , multihashName :: Text + } + deriving (Show, Eq) + +data CidObj = CidObj + { cidStr :: Text + , errorMsg :: Text + , formatted :: Text + } + deriving (Show, Eq) + +data BlockObj = BlockObj + { key :: Text + , blockSize :: Int + } + deriving (Show, Eq) + +data DagCidObj = DagCidObj + { cidSlash :: Text + } + deriving (Show, Eq) + +data DagResolveObj = DagResolveObj + { cid :: DagCidObj + , remPath :: Text + } + deriving (Show, Eq) + +data DagPutObj = DagPutObj + { putCid :: DagCidObj + } + deriving (Show, Eq) + +data ConfigObj = ConfigObj + { configKey :: Text + , configValue :: Text + } + deriving (Show, Eq) + +data ObjectLinkObj = ObjectLinkObj + { linkHash :: Text + , linkName :: Text + , linkSize :: Int64 + } + deriving (Show, Eq) + +data ObjectObj = ObjectObj + { newObjectHash :: Text + } + deriving (Show, Eq) + +data ObjectLinksObj = WithLinks + { objectHash :: Text + , objectLinks :: [ObjectLinkObj] + } + | WithoutLinks + { objectHash :: Text + } + deriving (Show, Eq) + +data ObjectGetObj = ObjectGetObj + { objectName :: Text + , objectGetLinks :: [ObjectLinkObj] + } + deriving (Show, Eq) + +data ObjectStatObj = ObjectStatObj + { objBlockSize :: Int + , cumulativeSize :: Int + , dataSize :: Int + , objHash :: Text + , linksSize :: Int + , numLinks :: Int + } + deriving (Show, Eq) + +data DiffObj = DiffObj + { diffSlash :: Text + } + deriving (Show, Eq) + +data ObjectChangeObj = ObjectChangeObj + { after :: Maybe DiffObj + , before :: DiffObj + , path :: Text + , diffType :: Int + } + deriving (Show, Eq) + +data ObjectDiffObj = ObjectDiffObj + { changes :: [ObjectChangeObj] + } + deriving (Show, Eq) + +data PinObj = WithoutProgress + { pins :: [Text] + } + | WithProgress + { pins :: [Text] + , progress :: Int + } + deriving (Show, Eq) + +data BootstrapObj = BootstrapObj + { bootstrapPeers :: [Text] + } + deriving (Show, Eq) + +data StatsBwObj = StatsBwObj + { rateIn :: Double + , rateOut :: Double + , totalIn :: Int64 + , totalOut :: Int64 + } + deriving (Show, Eq) + +data StatsRepoObj = StatsRepoObj + { numObjects :: Int64 + , repoPath :: Text + , repoSize :: Int64 + , storageMax :: Int64 + , repoVersion :: Text + } + deriving (Show, Eq) + +data VersionObj = VersionObj + { commit :: Text + , golang :: Text + , repo :: Text + , system :: Text + , version :: Text + } + deriving (Show, Eq) + +data IdObj = IdObj + { addresses :: [Text] + , agentVersion :: Text + , id :: Text + , protocolVersion :: Text + , publicKey :: Text + } + deriving (Show, Eq) + +data DnsObj = DnsObj + { dnsPath :: Text + } + deriving (Show, Eq) + +data PubsubObj = PubsubObj + { pubsubStrings :: [Text] + } + deriving (Show, Eq) + +data LogLsObj = LogLsObj + { logLsStrings :: [Text] + } + deriving (Show, Eq) + +data LogLevelObj = LogLevelObj + { message :: Text + } + deriving (Show, Eq) + +data RepoVersionObj = RepoVersionObj + { repoVer :: Text + } + deriving (Show, Eq) + +data RepoFsckObj = RepoFsckObj + { repoMessage :: Text + } + deriving (Show, Eq) + +data KeyDetailsObj = KeyDetailsObj + { keyId :: Text + , keyName :: Text + } + deriving (Show, Eq) + +data KeyObj = KeyObj + { keys :: [KeyDetailsObj] + } + deriving (Show, Eq) + +data KeyRenameObj = KeyRenameObj + { peerId :: Text + , now :: Text + , overwrite :: Bool + , was :: Text + } + deriving (Show, Eq) + +data FilesStatObj = FilesStatObj + { fileObjectHash :: Text + , objectSize :: Int + , cumulativeObjectSize :: Int + , blocks :: Int + , objectType :: Text + } + deriving (Show, Eq) + +data FilesEntryObj = FilesEntryObj + { entryName :: Text + , entryType :: Int + , entrySize :: Int + , entryHash :: Text + } + deriving (Show, Eq) + +data FilesLsObj = FilesLsObj + { enteries :: [FilesEntryObj] + } + deriving (Show, Eq) + +data FilesFlushObj = FilesFlushObj + { fileCid :: Text + } + deriving (Show, Eq) + +instance FromJSON DirLink where + parseJSON (Object o) = + DirLink <$> o .: "Name" + <*> o .: "Hash" + <*> o .: "Size" + <*> o .: "Type" + <*> o .: "Target" + + parseJSON _ = mzero + +instance FromJSON DirObj where + parseJSON (Object o) = + DirObj <$> o .: "Hash" + <*> o .: "Links" + + parseJSON _ = mzero + +instance FromJSON LsObj where + parseJSON (Object o) = + LsObj <$> o .: "Objects" + + parseJSON _ = mzero + + +instance FromJSON SwarmStreamObj where + parseJSON (Object o) = + SwarmStreamObj <$> o .: "Protocol" + + parseJSON _ = mzero + +instance FromJSON SwarmPeerObj where + parseJSON (Object o) = + SwarmPeerObj <$> o .: "Addr" + <*> o .: "Direction" + <*> o .: "Latency" + <*> o .: "Muxer" + <*> o .: "Peer" + <*> o .: "Streams" + + parseJSON _ = mzero + +instance FromJSON SwarmPeersObj where + parseJSON (Object o) = + SwarmPeersObj <$> o .: "Peers" + + parseJSON _ = mzero + + +instance FromJSON SwarmObj where + parseJSON (Object o) = + SwarmObj <$> o .: "Strings" + + parseJSON _ = mzero + +instance FromJSON WantlistObj where + parseJSON (Object o) = + WantlistObj <$> o .: "/" + + parseJSON _ = mzero + +instance FromJSON BitswapStatObj where + parseJSON (Object o) = + BitswapStatObj <$> o .: "BlocksReceived" + <*> o .: "BlocksSent" + <*> o .: "DataReceived" + <*> o .: "DataSent" + <*> o .: "DupBlksReceived" + <*> o .: "DupDataReceived" + <*> o .: "MessagesReceived" + <*> o .: "Peers" + <*> o .: "ProvideBufLen" + <*> o .: "Wantlist" + + parseJSON _ = mzero + + +instance FromJSON BitswapWLObj where + parseJSON (Object o) = + BitswapWLObj <$> o .: "Keys" + + parseJSON _ = mzero + +instance FromJSON BitswapLedgerObj where + parseJSON (Object o) = + BitswapLedgerObj <$> o .: "Exchanged" + <*> o .: "Peer" + <*> o .: "Recv" + <*> o .: "Sent" + <*> o .: "Value" + + parseJSON _ = mzero + +instance FromJSON CidBasesObj where + parseJSON (Object o) = + CidBasesObj <$> o .: "Code" + <*> o .: "Name" + + parseJSON _ = mzero + +instance FromJSON CidCodecsObj where + parseJSON (Object o) = + CidCodecsObj <$> o .: "Code" + <*> o .: "Name" + + parseJSON _ = mzero + +instance FromJSON CidHashesObj where + parseJSON (Object o) = + CidHashesObj <$> o .: "Code" + <*> o .: "Name" + + parseJSON _ = mzero + +instance FromJSON CidObj where + parseJSON (Object o) = + CidObj <$> o .: "CidStr" + <*> o .: "ErrorMsg" + <*> o .: "Formatted" + + parseJSON _ = mzero + +instance FromJSON BlockObj where + parseJSON (Object o) = + BlockObj <$> o .: "Key" + <*> o .: "Size" + + parseJSON _ = mzero + +instance FromJSON DagCidObj where + parseJSON (Object o) = + DagCidObj <$> o .: "/" + + parseJSON _ = mzero + +instance FromJSON DagResolveObj where + parseJSON (Object o) = + DagResolveObj <$> o .: "Cid" + <*> o .: "RemPath" + + parseJSON _ = mzero + +instance FromJSON DagPutObj where + parseJSON (Object o) = + DagPutObj <$> o .: "Cid" + + parseJSON _ = mzero + +instance FromJSON ConfigObj where + parseJSON (Object o) = + ConfigObj <$> o .: "Key" + <*> o .: "Value" + + parseJSON _ = mzero + +instance FromJSON ObjectLinkObj where + parseJSON (Object o) = + ObjectLinkObj <$> o .: "Hash" + <*> o .: "Name" + <*> o .: "Size" + + parseJSON _ = mzero + +instance FromJSON ObjectObj where + parseJSON (Object o) = + ObjectObj <$> o .: "Hash" + + parseJSON _ = mzero + +instance FromJSON ObjectLinksObj where + parseJSON (Object v) = + case H.lookup "Links" v of + Just (_) -> WithLinks <$> v .: "Hash" + <*> v .: "Links" + + Nothing -> + case H.lookup "Hash" v of + Just (_) -> WithoutLinks <$> v .: "Hash" + Nothing -> mzero + + parseJSON _ = mzero + +instance FromJSON ObjectGetObj where + parseJSON (Object o) = + ObjectGetObj <$> o .: "Data" + <*> o .: "Links" + + parseJSON _ = mzero + +instance FromJSON ObjectStatObj where + parseJSON (Object o) = + ObjectStatObj <$> o .: "BlockSize" + <*> o .: "CumulativeSize" + <*> o .: "DataSize" + <*> o .: "Hash" + <*> o .: "LinksSize" + <*> o .: "NumLinks" + + parseJSON _ = mzero + +instance FromJSON ObjectChangeObj where + parseJSON (Object o) = + ObjectChangeObj <$> o .: "After" + <*> o .: "Before" + <*> o .: "Path" + <*> o .: "Type" + + parseJSON _ = mzero + +instance FromJSON DiffObj where + parseJSON (Object o) = + DiffObj <$> o .: "/" + + parseJSON _ = mzero + +instance FromJSON ObjectDiffObj where + parseJSON (Object o) = + ObjectDiffObj <$> o .: "Changes" + + parseJSON _ = mzero + +instance FromJSON PinObj where + parseJSON (Object v) = + case H.lookup "Progress" v of + Just (_) -> WithProgress <$> v .: "Pins" + <*> v .: "Progress" + + Nothing -> + case H.lookup "Pins" v of + Just (_) -> WithoutProgress <$> v .: "Pins" + Nothing -> mzero + + parseJSON _ = mzero + +instance FromJSON BootstrapObj where + parseJSON (Object o) = + BootstrapObj <$> o .: "Peers" + + parseJSON _ = mzero + +instance FromJSON StatsBwObj where + parseJSON (Object o) = + StatsBwObj <$> o .: "RateIn" + <*> o .: "RateOut" + <*> o .: "TotalIn" + <*> o .: "TotalOut" + + parseJSON _ = mzero + +instance FromJSON StatsRepoObj where + parseJSON (Object o) = + StatsRepoObj <$> o .: "NumObjects" + <*> o .: "RepoPath" + <*> o .: "RepoSize" + <*> o .: "StorageMax" + <*> o .: "Version" + + parseJSON _ = mzero + +instance FromJSON VersionObj where + parseJSON (Object o) = + VersionObj <$> o .: "Commit" + <*> o .: "Golang" + <*> o .: "Repo" + <*> o .: "System" + <*> o .: "Version" + + parseJSON _ = mzero + +instance FromJSON IdObj where + parseJSON (Object o) = + IdObj <$> o .: "Addresses" + <*> o .: "AgentVersion" + <*> o .: "ID" + <*> o .: "ProtocolVersion" + <*> o .: "PublicKey" + + parseJSON _ = mzero + +instance FromJSON DnsObj where + parseJSON (Object o) = + DnsObj <$> o .: "Path" + + parseJSON _ = mzero + +instance FromJSON PubsubObj where + parseJSON (Object o) = + PubsubObj <$> o .: "Strings" + + parseJSON _ = mzero + +instance FromJSON LogLsObj where + parseJSON (Object o) = + LogLsObj <$> o .: "Strings" + + parseJSON _ = mzero + +instance FromJSON LogLevelObj where + parseJSON (Object o) = + LogLevelObj <$> o .: "Message" + + parseJSON _ = mzero + +instance FromJSON RepoVersionObj where + parseJSON (Object o) = + RepoVersionObj <$> o .: "Version" + + parseJSON _ = mzero + +instance FromJSON RepoFsckObj where + parseJSON (Object o) = + RepoFsckObj <$> o .: "Message" + + parseJSON _ = mzero + + +instance FromJSON KeyDetailsObj where + parseJSON (Object o) = + KeyDetailsObj <$> o .: "Id" + <*> o .: "Name" + + parseJSON _ = mzero + +instance FromJSON KeyObj where + parseJSON (Object o) = + KeyObj <$> o .: "Keys" + + parseJSON _ = mzero + +instance FromJSON KeyRenameObj where + parseJSON (Object o) = + KeyRenameObj <$> o .: "Id" + <*> o .: "Now" + <*> o .: "Overwrite" + <*> o .: "Was" + + parseJSON _ = mzero + +instance FromJSON FilesStatObj where + parseJSON (Object o) = + FilesStatObj <$> o .: "Hash" + <*> o .: "Size" + <*> o .: "CumulativeSize" + <*> o .: "Blocks" + <*> o .: "Type" + + parseJSON _ = mzero + +instance FromJSON FilesEntryObj where + parseJSON (Object o) = + FilesEntryObj <$> o .: "Name" + <*> o .: "Type" + <*> o .: "Size" + <*> o .: "Hash" + + parseJSON _ = mzero + +instance FromJSON FilesLsObj where + parseJSON (Object o) = + FilesLsObj <$> o .: "Entries" + + parseJSON _ = mzero + +instance FromJSON FilesFlushObj where + parseJSON (Object o) = + FilesFlushObj <$> o .: "Cid" + + parseJSON _ = mzero + +-- | Defining a content type same as PlainText without charset +data IpfsText deriving Typeable + +instance Servant.API.Accept IpfsText where + contentType _ = "text" M.// "plain" + +-- | @left show . TextS.decodeUtf8' . toStrict@ +instance MimeUnrender IpfsText Text where + mimeUnrender _ = left show . TextS.decodeUtf8' . toStrict + + +-- | Defining a content type same as IpfsJSON +data IpfsJSON deriving Typeable + +instance Servant.API.Accept IpfsJSON where + contentType _ = "application" M.// "json" + +-- | @left show . TextS.decodeUtf8' . toStrict@ +instance MimeUnrender IpfsJSON Text where + mimeUnrender _ = left show . TextS.decodeUtf8' . toStrict + +type IpfsApi = "cat" :> Capture "arg" Text :> Get '[IpfsText] CatReturnType + :<|> "ls" :> Capture "arg" Text :> Get '[JSON] LsObj + :<|> "get" :> Capture "arg" Text :> Get '[IpfsText] GetReturnType + :<|> "swarm" :> "peers" :> Get '[JSON] SwarmPeersObj + :<|> "swarm" :> "connect" :> QueryParam "arg" Text :> Get '[JSON] SwarmObj + :<|> "swarm" :> "disconnect" :> QueryParam "arg" Text :> Get '[JSON] SwarmObj + :<|> "swarm" :> "filters" :> Get '[JSON] SwarmObj + :<|> "swarm" :> "filters" :> "add" :> QueryParam "arg" Text :> Get '[JSON] SwarmObj + :<|> "swarm" :> "filters" :> "rm" :> QueryParam "arg" Text :> Get '[JSON] SwarmObj + :<|> "bitswap" :> "stat" :> Get '[JSON] BitswapStatObj + :<|> "bitswap" :> "wantlist" :> Get '[JSON] BitswapWLObj + :<|> "bitswap" :> "ledger" :> Capture "peerId" Text :> Get '[JSON] BitswapLedgerObj + :<|> "bitswap" :> "reprovide" :> Get '[IpfsText] ReprovideReturnType + :<|> "cid" :> "bases" :> Get '[JSON] [CidBasesObj] + :<|> "cid" :> "codecs" :> Get '[JSON] [CidCodecsObj] + :<|> "cid" :> "hashes" :> Get '[JSON] [CidHashesObj] + :<|> "cid" :> "base32" :> Capture "cid" Text :> Get '[JSON] CidObj + :<|> "cid" :> "format" :> Capture "cid" Text :> Get '[JSON] CidObj + :<|> "block" :> "get" :> Capture "key" Text :> Get '[IpfsText] BlockReturnType + :<|> "block" :> "stat" :> Capture "key" Text :> Get '[JSON] BlockObj + :<|> "dag" :> "get" :> Capture "ref" Text :> Get '[IpfsJSON] DagReturnType + :<|> "dag" :> "resolve" :> Capture "ref" Text :> Get '[JSON] DagResolveObj + :<|> "config" :> Capture "ref" Text :> Get '[JSON] ConfigObj + :<|> "config" :> Capture "arg" Text :> QueryParam "arg" Text :> Get '[JSON] ConfigObj + :<|> "object" :> "data" :> Capture "ref" Text :> Get '[IpfsText] ObjectReturnType + :<|> "object" :> "new" :> Get '[JSON] ObjectObj + :<|> "object" :> "links" :> Capture "ref" Text :> Get '[JSON] ObjectLinksObj + :<|> "object" :> "patch" :> "add-link" :> Capture "arg" Text + :> QueryParam "arg" Text :> QueryParam "arg" Text :> Get '[JSON] ObjectLinksObj + :<|> "object" :> "patch" :> "rm-link" :> Capture "arg" Text + :> QueryParam "arg" Text :> Get '[JSON] ObjectLinksObj + :<|> "object" :> "get" :> Capture "arg" Text :> Get '[JSON] ObjectGetObj + :<|> "object" :> "diff" :> Capture "arg" Text :> QueryParam "arg" Text :> Get '[JSON] ObjectDiffObj + :<|> "object" :> "stat" :> Capture "arg" Text :> Get '[JSON] ObjectStatObj + :<|> "pin" :> "add" :> Capture "arg" Text :> Get '[JSON] PinObj + :<|> "pin" :> "rm" :> Capture "arg" Text :> Get '[JSON] PinObj + :<|> "bootstrap" :> "add" :> QueryParam "arg" Text :> Get '[JSON] BootstrapObj + :<|> "bootstrap" :> "list" :> Get '[JSON] BootstrapObj + :<|> "bootstrap" :> "rm" :> QueryParam "arg" Text :> Get '[JSON] BootstrapObj + :<|> "stats" :> "bw" :> Get '[JSON] StatsBwObj + :<|> "stats" :> "repo" :> Get '[JSON] StatsRepoObj + :<|> "version" :> Get '[JSON] VersionObj + :<|> "id" :> Get '[JSON] IdObj + :<|> "id" :> Capture "arg" Text :> Get '[JSON] IdObj + :<|> "dns" :> Capture "arg" Text :> Get '[JSON] DnsObj + :<|> "pubsub" :> "ls" :> Get '[JSON] PubsubObj + :<|> "pubsub" :> "peers" :> Get '[JSON] PubsubObj + :<|> "pubsub" :> "pub" :> Capture "arg" Text :> QueryParam "arg" Text :> Get '[JSON] NoContent + :<|> "log" :> "ls" :> Get '[JSON] LogLsObj + :<|> "log" :> "level" :> Capture "arg" Text :> QueryParam "arg" Text :> Get '[JSON] LogLevelObj + :<|> "repo" :> "version" :> Get '[JSON] RepoVersionObj + :<|> "repo" :> "fsck" :> Get '[JSON] RepoFsckObj + :<|> "key" :> "gen" :> Capture "arg" Text :> QueryParam "type" Text :> Get '[JSON] KeyDetailsObj + :<|> "key" :> "list" :> Get '[JSON] KeyObj + :<|> "key" :> "rename" :> Capture "arg" Text :> QueryParam "arg" Text :> Get '[JSON] KeyRenameObj + :<|> "key" :> "rm" :> Capture "arg" Text :> Get '[JSON] KeyObj + :<|> "files" :> "chcid" :> QueryParam "arg" Text :> QueryParam "cid-version" Int :> Get '[JSON] NoContent + :<|> "files" :> "cp" :> QueryParam "arg" Text :> QueryParam "arg" Text :> Get '[JSON] NoContent + :<|> "files" :> "flush" :> QueryParam "arg" Text :> Get '[JSON] FilesFlushObj + :<|> "files" :> "ls" :> QueryParam "arg" Text :> Get '[JSON] FilesLsObj + :<|> "files" :> "mkdir" :> QueryParam "arg" Text :> Get '[JSON] NoContent + :<|> "files" :> "mv" :> QueryParam "arg" Text :> QueryParam "arg" Text :> Get '[JSON] NoContent + :<|> "files" :> "read" :> QueryParam "arg" Text :> Get '[IpfsText] FilesReadType + :<|> "files" :> "rm" :> QueryParam "arg" Text :> QueryParam "recursive" Bool :> Get '[JSON] NoContent + :<|> "files" :> "stat" :> QueryParam "arg" Text :> Get '[JSON] FilesStatObj + :<|> "shutdown" :> Get '[JSON] NoContent diff --git a/src/Network/Ipfs/Api/Types/Stream.hs b/src/Network/Ipfs/Api/Types/Stream.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Api/Types/Stream.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +-- | +-- Module : Network.Ipfs.Api.Types.Stream +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Ipfs Stream API types. +-- + +module Network.Ipfs.Api.Types.Stream where + +import Control.Monad +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 () +import Data.Int +import Data.Text +import Network.HTTP.Client () +import Servant.API + +import Network.Ipfs.Api.Types (IpfsText) + +type LogReturnType = Text + +data PingObj = PingObj + { success :: Bool + , text :: Text + , time :: Int64 + } + deriving (Show, Eq) + +data ResponseObj = ResponseObj + { addrs :: Maybe [Text] + , id :: Text + } + deriving (Show, Eq) + +data DhtObj = DhtObj + { extra :: Text + , addrid :: Text + , responses :: Maybe [ResponseObj] + , addrType :: Int + } + deriving (Show, Eq) + +data RepoKeyObj = RepoKeyObj + { repoSlash :: Text + } + deriving (Show, Eq) + +data RepoGcObj = RepoGcObj + { repoKey :: RepoKeyObj + } + deriving (Show, Eq) + +data RepoVerifyObj = RepoVerifyObj + { msg :: Text + , progress :: Int + } + deriving (Show, Eq) + +data RefsObj = RefsObj + { error :: Text + , ref :: Text + } + deriving (Show, Eq) + +data PubsubSubObj = PubsubSubObj + { mssgdata :: Text + , from :: Text + , seqno :: Text + , topicIDs :: [Text] + } + deriving (Show, Eq) + +instance FromJSON PingObj where + parseJSON (Object o) = + PingObj <$> o .: "Success" + <*> o .: "Text" + <*> o .: "Time" + + parseJSON _ = mzero + +instance FromJSON DhtObj where + parseJSON (Object o) = + DhtObj <$> o .: "Extra" + <*> o .: "ID" + <*> o .: "Responses" + <*> o .: "Type" + + parseJSON _ = mzero + +instance FromJSON ResponseObj where + parseJSON (Object o) = + ResponseObj <$> o .: "Addrs" + <*> o .: "ID" + + parseJSON _ = mzero + +instance FromJSON RepoKeyObj where + parseJSON (Object o) = + RepoKeyObj <$> o .: "/" + + parseJSON _ = mzero + +instance FromJSON RepoGcObj where + parseJSON (Object o) = + RepoGcObj <$> o .: "Key" + + parseJSON _ = mzero + +instance FromJSON RepoVerifyObj where + parseJSON (Object o) = + RepoVerifyObj <$> o .: "Msg" + <*> o .: "Progress" + + parseJSON _ = mzero + +instance FromJSON RefsObj where + parseJSON (Object o) = + RefsObj <$> o .: "Err" + <*> o .: "Ref" + + parseJSON _ = mzero + +instance FromJSON PubsubSubObj where + parseJSON (Object o) = + PubsubSubObj <$> o .: "data" + <*> o .: "from" + <*> o .: "seqno" + <*> o .: "topicIDs" + + parseJSON _ = mzero + +type IpfsStreamApi = "ping" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO PingObj ) + :<|> "dht" :> "findpeer" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO DhtObj ) + :<|> "dht" :> "findprovs" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO DhtObj ) + :<|> "dht" :> "get" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO DhtObj ) + :<|> "dht" :> "provide" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO DhtObj ) + :<|> "dht" :> "query" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO DhtObj ) + :<|> "log" :> "tail" :> StreamGet NewlineFraming IpfsText ( SourceIO LogReturnType) + :<|> "repo" :> "gc" :> StreamGet NewlineFraming JSON ( SourceIO RepoGcObj) + :<|> "repo" :> "verify" :> StreamGet NewlineFraming JSON ( SourceIO RepoVerifyObj) + :<|> "refs" :> Capture "arg" Text :> StreamGet NewlineFraming JSON (SourceIO RefsObj) + :<|> "refs" :> "local" :> StreamGet NewlineFraming JSON (SourceIO RefsObj) + :<|> "pubsub" :> "sub" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO PubsubSubObj ) diff --git a/src/Network/Ipfs/Client.hs b/src/Network/Ipfs/Client.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ipfs/Client.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | +-- Module : Network.Ipfs.Client +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unknown +-- +-- IPFS daemon HTTP client. +-- + +module Network.Ipfs.Client where + +import Control.Monad.Except +import Control.Monad.Reader +import Network.HTTP.Client as Net hiding (Proxy) +import Servant.Client + +newtype IpfsT m a = IpfsT { unIpfs :: ReaderT (Manager, BaseUrl, String) (ExceptT ClientError m) a } + deriving ( Functor + , Applicative + , Monad + , MonadIO + , MonadReader (Manager, BaseUrl, String) + , MonadError ClientError + ) + +instance MonadTrans IpfsT where + lift = IpfsT . lift . lift + +type Ipfs a = IpfsT IO a + +-- | 'IpfsT' monad runner. +runIpfs' :: BaseUrl -> Ipfs a -> IO () +runIpfs' url ipfs = do + manager' <- liftIO $ newManager defaultManagerSettings + ret <- runExceptT (runReaderT (unIpfs ipfs) (manager', url, showBaseUrl url)) + case ret of + Left err -> putStrLn $ "Error: " ++ show err + Right _ -> putStr "" + +-- | 'IpfsT' monad runner with default arguments. +runIpfs :: Ipfs a -> IO () +runIpfs = runIpfs' (BaseUrl Http "localhost" 5001 "/api/v0") diff --git a/web3-ipfs.cabal b/web3-ipfs.cabal new file mode 100644 --- /dev/null +++ b/web3-ipfs.cabal @@ -0,0 +1,71 @@ +cabal-version: 1.12 +name: web3-ipfs +version: 1.0.0.0 +license: Apache-2.0 +license-file: LICENSE +copyright: (c) Aleksandr Krupenkin 2016-2021 +maintainer: mail@akru.me +author: Aleksandr Krupenkin +homepage: https://github.com/airalab/hs-web3#readme +bug-reports: https://github.com/airalab/hs-web3/issues +synopsis: IPFS support for Haskell Web3 library. +description: Client library for Third Generation of Web. +category: Network +build-type: Simple + +source-repository head + type: git + location: https://github.com/airalab/hs-web3 + +library + exposed-modules: + Network.Ipfs.Api.Bitswap + Network.Ipfs.Api.Block + Network.Ipfs.Api.Bootstrap + Network.Ipfs.Api.Cid + Network.Ipfs.Api.Config + Network.Ipfs.Api.Core + Network.Ipfs.Api.Dag + Network.Ipfs.Api.Dht + Network.Ipfs.Api.Files + Network.Ipfs.Api.Internal + Network.Ipfs.Api.Internal.Call + Network.Ipfs.Api.Internal.Stream + Network.Ipfs.Api.Key + Network.Ipfs.Api.Log + Network.Ipfs.Api.Object + Network.Ipfs.Api.Pin + Network.Ipfs.Api.Pubsub + Network.Ipfs.Api.Repo + Network.Ipfs.Api.Stats + Network.Ipfs.Api.Swarm + Network.Ipfs.Api.Types + Network.Ipfs.Api.Types.Stream + Network.Ipfs.Client + + hs-source-dirs: src + other-modules: Paths_web3_ipfs + default-language: Haskell2010 + ghc-options: + -funbox-strict-fields -Wduplicate-exports -Whi-shadowing + -Widentities -Woverlapping-patterns -Wpartial-type-signatures + -Wunrecognised-pragmas -Wtyped-holes -Wincomplete-patterns + -Wincomplete-uni-patterns -Wmissing-fields -Wmissing-methods + -Wmissing-exported-signatures -Wmissing-monadfail-instances + -Wmissing-signatures -Wname-shadowing -Wunused-binds + -Wunused-top-binds -Wunused-local-binds -Wunused-pattern-binds + -Wunused-imports -Wunused-matches -Wunused-foralls -Wtabs + + build-depends: + aeson >1.2 && <1.6, + base >4.11 && <4.15, + bytestring >0.10 && <0.11, + http-client >0.5 && <0.7, + http-media >0.6 && <0.8.1, + http-types >0.11 && <0.14, + mtl >2.2 && <2.3, + servant >0.12 && <0.19, + servant-client >0.12 && <0.19, + tar >0.4 && <0.6, + text >1.2 && <1.3, + unordered-containers >0.1 && <0.3