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 :: ByteString -> m (Either Error CID)
addRaw ByteString
raw =
  [Opt] -> ByteString -> m (Either Error ByteString)
forall (m :: * -> *).
MonadLocalIPFS m =>
[Opt] -> ByteString -> m (Either Error ByteString)
IPFS.runLocal [Item [Opt]
"add", Item [Opt]
"-HQ"] ByteString
raw m (Either Error ByteString)
-> (Either Error ByteString -> m (Either Error CID))
-> m (Either Error CID)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right ByteString
result ->
      case ByteString -> [ByteString]
CL.lines ByteString
result of
        [Item [ByteString]
cid] ->
          Either Error CID -> m (Either Error CID)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error CID -> m (Either Error CID))
-> (ByteString -> Either Error CID)
-> ByteString
-> m (Either Error CID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CID -> Either Error CID
forall a b. b -> Either a b
Right (CID -> Either Error CID)
-> (ByteString -> CID) -> ByteString -> Either Error CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CID
mkCID (Text -> CID) -> (ByteString -> Text) -> ByteString -> CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Text -> Text
UTF8.stripN Natural
1 (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient (ByteString -> m (Either Error CID))
-> ByteString -> m (Either Error CID)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.toStrict ByteString
Item [ByteString]
cid

        [ByteString]
bad ->
          Either Error CID -> m (Either Error CID)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error CID -> m (Either Error CID))
-> (Text -> Either Error CID) -> Text -> m (Either Error CID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error CID
forall a b. a -> Either a b
Left (Error -> Either Error CID)
-> (Text -> Error) -> Text -> Either Error CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
UnexpectedOutput (Text -> m (Either Error CID)) -> Text -> m (Either Error CID)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Text
forall a. Show a => a -> Text
UTF8.textShow [ByteString]
bad

    Left Error
err ->
      Either Error CID -> m (Either Error CID)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error CID -> m (Either Error CID))
-> (Text -> Either Error CID) -> Text -> m (Either Error CID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error CID
forall a b. a -> Either a b
Left (Error -> Either Error CID)
-> (Text -> Error) -> Text -> Either Error CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
UnknownAddErr (Text -> m (Either Error CID)) -> Text -> m (Either Error CID)
forall a b. (a -> b) -> a -> b
$ Error -> Text
forall a. Show a => a -> Text
UTF8.textShow Error
err

addFile ::
  MonadLocalIPFS m
  => Lazy.ByteString
  -> IPFS.Name
  -> m (Either IPFS.Add.Error (IPFS.SparseTree, IPFS.CID))
addFile :: ByteString -> Name -> m (Either Error (SparseTree, CID))
addFile ByteString
raw Name
name =
  [Opt] -> ByteString -> m (Either Error ByteString)
forall (m :: * -> *).
MonadLocalIPFS m =>
[Opt] -> ByteString -> m (Either Error ByteString)
IPFS.runLocal [Opt]
opts ByteString
raw m (Either Error ByteString)
-> (Either Error ByteString -> m (Either Error (SparseTree, CID)))
-> m (Either Error (SparseTree, CID))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right ByteString
result ->
      case ByteString -> [ByteString]
CL.lines ByteString
result of
        [Item [ByteString]
inner, Item [ByteString]
outer] ->
          let
            sparseTree :: SparseTree
sparseTree  = Map Tag SparseTree -> SparseTree
Directory [(CID -> Tag
Hash CID
rootCID, SparseTree
fileWrapper)]
            fileWrapper :: SparseTree
fileWrapper = Map Tag SparseTree -> SparseTree
Directory [(Tag
fileName, CID -> SparseTree
Content CID
fileCID)]
            rootCID :: CID
rootCID     = Text -> CID
CID (Text -> CID) -> (ByteString -> Text) -> ByteString -> CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient (ByteString -> CID) -> ByteString -> CID
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.toStrict ByteString
Item [ByteString]
outer
            fileCID :: CID
fileCID     = Text -> CID
CID (Text -> CID) -> (ByteString -> Text) -> ByteString -> CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Text -> Text
UTF8.stripN Natural
1 (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient (ByteString -> CID) -> ByteString -> CID
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.toStrict ByteString
Item [ByteString]
inner
            fileName :: Tag
fileName    = Name -> Tag
Key Name
name
          in
            Either Error (SparseTree, CID)
-> m (Either Error (SparseTree, CID))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (SparseTree, CID)
 -> m (Either Error (SparseTree, CID)))
-> Either Error (SparseTree, CID)
-> m (Either Error (SparseTree, CID))
forall a b. (a -> b) -> a -> b
$ (SparseTree, CID) -> Either Error (SparseTree, CID)
forall a b. b -> Either a b
Right (SparseTree
sparseTree, CID
rootCID)

        [ByteString]
bad ->
          Either Error (SparseTree, CID)
-> m (Either Error (SparseTree, CID))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (SparseTree, CID)
 -> m (Either Error (SparseTree, CID)))
-> (Text -> Either Error (SparseTree, CID))
-> Text
-> m (Either Error (SparseTree, CID))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error (SparseTree, CID)
forall a b. a -> Either a b
Left (Error -> Either Error (SparseTree, CID))
-> (Text -> Error) -> Text -> Either Error (SparseTree, CID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
UnexpectedOutput (Text -> m (Either Error (SparseTree, CID)))
-> Text -> m (Either Error (SparseTree, CID))
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Text
forall a. Show a => a -> Text
UTF8.textShow [ByteString]
bad


    Left Error
err ->
      Either Error (SparseTree, CID)
-> m (Either Error (SparseTree, CID))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (SparseTree, CID)
 -> m (Either Error (SparseTree, CID)))
-> (Text -> Either Error (SparseTree, CID))
-> Text
-> m (Either Error (SparseTree, CID))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error (SparseTree, CID)
forall a b. a -> Either a b
Left (Error -> Either Error (SparseTree, CID))
-> (Text -> Error) -> Text -> Either Error (SparseTree, CID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
UnknownAddErr (Text -> m (Either Error (SparseTree, CID)))
-> Text -> m (Either Error (SparseTree, CID))
forall a b. (a -> b) -> a -> b
$ Error -> Text
forall a. Show a => a -> Text
UTF8.textShow Error
err

    where
      opts :: [Opt]
opts = [ Item [Opt]
"add"
             , Item [Opt]
"-wq"
             , Item [Opt]
"--stdin-name"
             , Name -> Opt
unName Name
name
             ]

addPath ::
  MonadLocalIPFS m
  => FilePath
  -> m (Either IPFS.Add.Error CID)
addPath :: Opt -> m (Either Error CID)
addPath Opt
path = [Opt] -> ByteString -> m (Either Error ByteString)
forall (m :: * -> *).
MonadLocalIPFS m =>
[Opt] -> ByteString -> m (Either Error ByteString)
IPFS.runLocal [Item [Opt]
"add", Item [Opt]
"-HQ", Opt
Item [Opt]
path] ByteString
"" m (Either Error ByteString)
-> (Either Error ByteString -> m (Either Error CID))
-> m (Either Error CID)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error CID -> m (Either Error CID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error CID -> m (Either Error CID))
-> (Either Error ByteString -> Either Error CID)
-> Either Error ByteString
-> m (Either Error CID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  Right ByteString
result ->
    case ByteString -> [ByteString]
CL.lines ByteString
result of
      [Item [ByteString]
cid] -> CID -> Either Error CID
forall a b. b -> Either a b
Right (CID -> Either Error CID)
-> (Text -> CID) -> Text -> Either Error CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CID
mkCID (Text -> CID) -> (Text -> Text) -> Text -> CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Text -> Text
UTF8.stripN Natural
1 (Text -> Either Error CID) -> Text -> Either Error CID
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a. Show a => a -> Text
UTF8.textShow ByteString
Item [ByteString]
cid
      [ByteString]
bad   -> Error -> Either Error CID
forall a b. a -> Either a b
Left (Error -> Either Error CID)
-> (Text -> Error) -> Text -> Either Error CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
UnexpectedOutput (Text -> Either Error CID) -> Text -> Either Error CID
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Text
forall a. Show a => a -> Text
UTF8.textShow [ByteString]
bad

  Left Error
err ->
    Error -> Either Error CID
forall a b. a -> Either a b
Left (Error -> Either Error CID)
-> (Text -> Error) -> Text -> Either Error CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
UnknownAddErr (Text -> Either Error CID) -> Text -> Either Error CID
forall a b. (a -> b) -> a -> b
$ Error -> Text
forall a. Show a => a -> Text
UTF8.textShow Error
err

addDir ::
  ( MonadIO m
  , MonadLocalIPFS m
  )
  => IPFS.Ignored
  -> FilePath
  -> m (Either IPFS.Add.Error IPFS.CID)
addDir :: Ignored -> Opt -> m (Either Error CID)
addDir Ignored
ignored Opt
path = Opt -> m Bool
forall (m :: * -> *). MonadIO m => Opt -> m Bool
doesFileExist Opt
path m Bool -> (Bool -> m (Either Error CID)) -> m (Either Error CID)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
True  -> Opt -> m (Either Error CID)
forall (m :: * -> *).
MonadLocalIPFS m =>
Opt -> m (Either Error CID)
addPath Opt
path
  Bool
False -> Ignored -> Opt -> m (Either Error CID)
forall (m :: * -> *).
(MonadIO m, MonadLocalIPFS m) =>
Ignored -> Opt -> m (Either Error CID)
walkDir Ignored
ignored Opt
path

walkDir ::
  ( MonadIO m
  , MonadLocalIPFS m
  )
  => IPFS.Ignored
  -> FilePath
  -> m (Either IPFS.Add.Error IPFS.CID)
walkDir :: Ignored -> Opt -> m (Either Error CID)
walkDir Ignored
ignored Opt
path = do
  [Opt]
files <- Opt -> m [Opt]
forall (m :: * -> *). MonadIO m => Opt -> m [Opt]
listDirectory Opt
path

  let
    toAdd :: [Opt]
toAdd = Ignored -> [Opt] -> [Opt]
removeIgnored Ignored
ignored [Opt]
files
    reducer :: Either Error Node -> Opt -> m (Either Error Node)
reducer = Opt -> Ignored -> Either Error Node -> Opt -> m (Either Error Node)
forall (m :: * -> *).
(MonadIO m, MonadLocalIPFS m) =>
Opt -> Ignored -> Either Error Node -> Opt -> m (Either Error Node)
foldResults Opt
path Ignored
ignored
    seed :: Either a Node
seed = Node -> Either a Node
forall a b. b -> Either a b
Right (Node -> Either a Node) -> Node -> Either a Node
forall a b. (a -> b) -> a -> b
$ Node :: Text -> [Link] -> Node
Node
      { $sel:dataBlock:Node :: Text
dataBlock = Text
"CAE="
      , $sel:links:Node :: [Link]
links = []
      }

  (Either Error Node -> Opt -> m (Either Error Node))
-> Either Error Node -> [Opt] -> m (Either Error Node)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Either Error Node -> Opt -> m (Either Error Node)
reducer Either Error Node
forall a. Either a Node
seed [Opt]
toAdd m (Either Error Node)
-> (Either Error Node -> m (Either Error CID))
-> m (Either Error CID)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Error
err   -> Either Error CID -> m (Either Error CID)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error CID -> m (Either Error CID))
-> Either Error CID -> m (Either Error CID)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error CID
forall a b. a -> Either a b
Left Error
err
    Right Node
node -> Node -> m (Either Error CID)
forall (m :: * -> *).
MonadLocalIPFS m =>
Node -> m (Either Error CID)
DAG.putNode Node
node

foldResults ::
  ( MonadIO m
  , MonadLocalIPFS m
  )
  => FilePath
  -> IPFS.Ignored
  -> Either IPFS.Add.Error Node
  -> FilePath
  -> m (Either IPFS.Add.Error Node)
foldResults :: Opt -> Ignored -> Either Error Node -> Opt -> m (Either Error Node)
foldResults Opt
_ Ignored
_ (Left Error
err) Opt
_ = Either Error Node -> m (Either Error Node)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error Node -> m (Either Error Node))
-> Either Error Node -> m (Either Error Node)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error Node
forall a b. a -> Either a b
Left Error
err
foldResults Opt
path Ignored
ignored (Right Node
node) Opt
filename = do
  Ignored -> Opt -> m (Either Error CID)
forall (m :: * -> *).
(MonadIO m, MonadLocalIPFS m) =>
Ignored -> Opt -> m (Either Error CID)
addDir Ignored
ignored (Opt
path Opt -> Opt -> Opt
</> Opt
filename) m (Either Error CID)
-> (Either Error CID -> m (Either Error Node))
-> m (Either Error Node)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Error
err ->  Either Error Node -> m (Either Error Node)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error Node -> m (Either Error Node))
-> Either Error Node -> m (Either Error Node)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error Node
forall a b. a -> Either a b
Left Error
err
    Right CID
cid ->
      CID -> Name -> m (Either Error Link)
forall (m :: * -> *).
MonadLocalIPFS m =>
CID -> Name -> m (Either Error Link)
DAG.Link.create CID
cid (Opt -> Name
IPFS.Name Opt
filename) m (Either Error Link)
-> (Either Error Link -> m (Either Error Node))
-> m (Either Error Node)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Error
err -> Either Error Node -> m (Either Error Node)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error Node -> m (Either Error Node))
-> (Error -> Either Error Node) -> Error -> m (Either Error Node)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error Node
forall a b. a -> Either a b
Left (Error -> m (Either Error Node)) -> Error -> m (Either Error Node)
forall a b. (a -> b) -> a -> b
$ Error -> Error
RecursiveAddErr Error
err
      Right Link
link ->
        Either Error Node -> m (Either Error Node)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error Node -> m (Either Error Node))
-> Either Error Node -> m (Either Error Node)
forall a b. (a -> b) -> a -> b
$ Node -> Either Error Node
forall a b. b -> Either a b
Right Node
node { $sel:links:Node :: [Link]
links = Link
linkLink -> [Link] -> [Link]
forall a. a -> [a] -> [a]
: Node -> [Link]
links Node
node }

removeIgnored :: IPFS.Ignored -> [FilePath] -> [FilePath]
removeIgnored :: Ignored -> [Opt] -> [Opt]
removeIgnored Ignored
ignored [Opt]
files = (Opt -> Bool) -> [Opt] -> [Opt]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (Bool -> Bool
not (Bool -> Bool) -> (Opt -> Bool) -> Opt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ignored -> Opt -> Bool
matchesAny Ignored
ignored) [Opt]
files

matchesAny :: IPFS.Ignored -> FilePath -> Bool
matchesAny :: Ignored -> Opt -> Bool
matchesAny Ignored
globs Opt
path = (Pattern -> Bool) -> Ignored -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.any (\Pattern
x -> Pattern -> Opt -> Bool
Glob.match Pattern
x Opt
path) Ignored
globs