{-# 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 :: ClientM a -> IpfsT m a
call ClientM a
func = do
  (Manager
manager', BaseUrl
url, String
_) <- IpfsT m (Manager, BaseUrl, String)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Either ClientError a
resp <- IO (Either ClientError a) -> IpfsT m (Either ClientError a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM a
func (Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
manager' BaseUrl
url))
  case Either ClientError a
resp of
    Left ClientError
l  -> ClientError -> IpfsT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ClientError
l
    Right a
r -> a -> IpfsT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Call function for ‘multipart/form-data’.
multipartCall :: MonadIO m => Text -> Text -> IpfsT m (Net.Response ByteString)
multipartCall :: Text -> Text -> IpfsT m (Response ByteString)
multipartCall Text
funcUri Text
filePath = do
    (Manager
reqManager, BaseUrl
_, String
url) <- IpfsT m (Manager, BaseUrl, String)
forall r (m :: * -> *). MonadReader r m => m r
ask
    Request
req <- IO Request -> IpfsT m Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> IpfsT m Request) -> IO Request -> IpfsT m Request
forall a b. (a -> b) -> a -> b
$ String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (String -> Text
pack String
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
funcUri )
    IO (Response ByteString) -> IpfsT m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> IpfsT m (Response ByteString))
-> IO (Response ByteString) -> IpfsT m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ (Request -> Manager -> IO (Response ByteString))
-> Manager -> Request -> IO (Response ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Request -> Manager -> IO (Response ByteString)
httpLbs Manager
reqManager (Request -> IO (Response ByteString))
-> IO Request -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Part] -> Request -> IO Request
forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
formDataBody [Part]
form Request
req
  where
    form :: [Part]
form = [ Text -> String -> Part
partFileSource Text
"file" (String -> Part) -> String -> Part
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
filePath ]

-- | Call function for Streams.
streamCall :: (MonadIO m, Show a) => S.ClientM (SourceT IO a) -> m ()
streamCall :: ClientM (SourceT IO a) -> m ()
streamCall ClientM (SourceT IO a)
func = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Manager
manager' <- ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
    ClientM (SourceT IO a)
-> ClientEnv
-> (Either ClientError (SourceT IO a) -> IO ())
-> IO ()
forall a b.
ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
S.withClientM ClientM (SourceT IO a)
func (Manager -> BaseUrl -> ClientEnv
S.mkClientEnv Manager
manager' (Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Http String
"localhost" Int
5001 String
"/api/v0")) ((Either ClientError (SourceT IO a) -> IO ()) -> IO ())
-> (Either ClientError (SourceT IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Either ClientError (SourceT IO a)
e -> case Either ClientError (SourceT IO a)
e of
        Left ClientError
err -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ClientError -> String
forall a. Show a => a -> String
show ClientError
err
        Right SourceT IO a
rs -> (String -> IO ()) -> (a -> IO ()) -> SourceT IO a -> IO ()
forall (m :: * -> *) a.
Monad m =>
(String -> m ()) -> (a -> m ()) -> SourceT m a -> m ()
foreach String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> IO ()
forall a. Show a => a -> IO ()
print SourceT IO a
rs