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 -> m (Either Error ByteString)
getFileOrDirectory cid :: CID
cid@(IPFS.CID Text
hash) = [Opt] -> ByteString -> m (Either Error ByteString)
forall (m :: * -> *).
MonadLocalIPFS m =>
[Opt] -> ByteString -> m (Either Error ByteString)
IPFS.runLocal [Item [Opt]
"get", Text -> Opt
Text.unpack Text
hash] ByteString
"" m (Either Error ByteString)
-> (Either Error ByteString -> m (Either Error ByteString))
-> m (Either Error ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right ByteString
contents -> Either Error ByteString -> m (Either Error ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error ByteString -> m (Either Error ByteString))
-> Either Error ByteString -> m (Either Error ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Error ByteString
forall a b. b -> Either a b
Right ByteString
contents
  Left Error
err -> case Error
err of
    Process.Timeout Natural
secs   -> Either Error ByteString -> m (Either Error ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error ByteString -> m (Either Error ByteString))
-> (Error -> Either Error ByteString)
-> Error
-> m (Either Error ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error ByteString
forall a b. a -> Either a b
Left (Error -> m (Either Error ByteString))
-> Error -> m (Either Error ByteString)
forall a b. (a -> b) -> a -> b
$ CID -> Natural -> Error
TimedOut CID
cid Natural
secs
    Process.UnknownErr ByteString
raw -> Either Error ByteString -> m (Either Error ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error ByteString -> m (Either Error ByteString))
-> (Text -> Either Error ByteString)
-> Text
-> m (Either Error ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error ByteString
forall a b. a -> Either a b
Left (Error -> Either Error ByteString)
-> (Text -> Error) -> Text -> Either Error ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
UnknownErr (Text -> m (Either Error ByteString))
-> Text -> m (Either Error ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a. Show a => a -> Text
UTF8.textShow ByteString
raw

getFile :: MonadLocalIPFS m => IPFS.CID -> m (Either IPFS.Get.Error File.Serialized)
getFile :: CID -> m (Either Error Serialized)
getFile cid :: CID
cid@(IPFS.CID Text
hash) = [Opt] -> ByteString -> m (Either Error ByteString)
forall (m :: * -> *).
MonadLocalIPFS m =>
[Opt] -> ByteString -> m (Either Error ByteString)
IPFS.runLocal [Item [Opt]
"cat"] (Text -> ByteString
UTF8.textToLazyBS Text
hash) m (Either Error ByteString)
-> (Either Error ByteString -> m (Either Error Serialized))
-> m (Either Error Serialized)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right ByteString
contents -> Either Error Serialized -> m (Either Error Serialized)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error Serialized -> m (Either Error Serialized))
-> (Serialized -> Either Error Serialized)
-> Serialized
-> m (Either Error Serialized)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serialized -> Either Error Serialized
forall a b. b -> Either a b
Right (Serialized -> m (Either Error Serialized))
-> Serialized -> m (Either Error Serialized)
forall a b. (a -> b) -> a -> b
$ ByteString -> Serialized
File.Serialized ByteString
contents
  Left Error
err -> case Error
err of
    Process.Timeout Natural
secs -> Either Error Serialized -> m (Either Error Serialized)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error Serialized -> m (Either Error Serialized))
-> (Error -> Either Error Serialized)
-> Error
-> m (Either Error Serialized)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error Serialized
forall a b. a -> Either a b
Left (Error -> m (Either Error Serialized))
-> Error -> m (Either Error Serialized)
forall a b. (a -> b) -> a -> b
$ CID -> Natural -> Error
TimedOut CID
cid Natural
secs
    Process.UnknownErr ByteString
raw ->
      if ByteString -> ByteString -> Bool
Lazy.isPrefixOf ByteString
"Error: invalid 'ipfs ref' path" ByteString
raw
        then Either Error Serialized -> m (Either Error Serialized)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error Serialized -> m (Either Error Serialized))
-> (Error -> Either Error Serialized)
-> Error
-> m (Either Error Serialized)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error Serialized
forall a b. a -> Either a b
Left (Error -> m (Either Error Serialized))
-> Error -> m (Either Error Serialized)
forall a b. (a -> b) -> a -> b
$ Text -> Error
InvalidCID Text
hash
        else Either Error Serialized -> m (Either Error Serialized)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error Serialized -> m (Either Error Serialized))
-> (Text -> Either Error Serialized)
-> Text
-> m (Either Error Serialized)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error Serialized
forall a b. a -> Either a b
Left (Error -> Either Error Serialized)
-> (Text -> Error) -> Text -> Either Error Serialized
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
UnknownErr (Text -> m (Either Error Serialized))
-> Text -> m (Either Error Serialized)
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a. Show a => a -> Text
UTF8.textShow ByteString
raw