From fb6bf1a9cb43bc1cad3eabed62d32e86775bf831 Mon Sep 17 00:00:00 2001
From: Aditya Manthramurthy <aditya.mmy@gmail.com>
Date: Sun, 18 Dec 2016 20:08:33 +0530
Subject: [PATCH] working program - with minio monad

---
 app/Main.hs               |  7 +++++--
 minio-hs.cabal            |  4 ++++
 src/Network/Minio/API.hs  | 12 +++++++++---
 src/Network/Minio/Data.hs | 25 +++++++++++++++++++++----
 4 files changed, 39 insertions(+), 9 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 81b21d5..61bfd5e 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -4,10 +4,13 @@ module Main where
 
 import Protolude
 
+import Network.Minio.Data
+
 import Network.Minio.API
+import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)
 
 main :: IO ()
 main = do
   mc <- connect defaultConnectInfo
-  res <- runMinio mc $ getService
-  print res
+  res <- runResourceT $ runMinio mc $ getService
+  print $ rpiStatus <$> res
diff --git a/minio-hs.cabal b/minio-hs.cabal
index a47495d..c255dcd 100644
--- a/minio-hs.cabal
+++ b/minio-hs.cabal
@@ -27,14 +27,17 @@ library
                      , protolude >= 0.1.6 && < 0.2
                      , bytestring
                      , case-insensitive
+                     , conduit
                      , containers
                      , cryptonite
                      , http-client
                      , http-conduit
                      , http-types
                      , memory
+                     , resourcet
                      , text
                      , time
+                     , transformers-base
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings
                      , NoImplicitPrelude
@@ -49,6 +52,7 @@ executable minio-hs-exe
                      , protolude >= 0.1.6 && < 0.2
                      , http-conduit
                      , http-types
+                     , resourcet
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings, NoImplicitPrelude
 
diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs
index bc28692..abd24a6 100644
--- a/src/Network/Minio/API.hs
+++ b/src/Network/Minio/API.hs
@@ -12,6 +12,8 @@ import           Network.HTTP.Conduit (Response)
 import qualified Network.HTTP.Conduit as NC
 import           Network.HTTP.Types (Method, Header, Query)
 
+import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)
+
 import           Lib.Prelude
 
 import           Network.Minio.Data
@@ -30,7 +32,7 @@ import           Network.Minio.Sign.V4
 --   -- print $ NC.requestBody r
 --   NC.httpLbs r mgr
 
-mkSRequest :: RequestInfo -> Minio (Response LByteString)
+mkSRequest :: RequestInfo -> Minio ResponseInfo
 mkSRequest ri = do
   let PayloadSingle pload = payload ri
       phash = hashSHA256 pload
@@ -56,14 +58,18 @@ mkSRequest ri = do
         , NC.requestBody = NC.RequestBodyBS pload
         }
 
-  NC.httpLbs req mgr
+  response <- NC.http req mgr
+  return $ ResponseInfo
+    (NC.responseStatus response)
+    (NC.responseHeaders response)
+    (NC.responseBody response)
 
 requestInfo :: Method -> Maybe Bucket -> Maybe Object
             -> Query -> [Header] -> Payload
             -> RequestInfo
 requestInfo m b o q h p = RequestInfo m b o q h p ""
 
-getService :: Minio (Response LByteString)
+getService :: Minio ResponseInfo
 getService = mkSRequest $
   requestInfo HT.methodGet Nothing Nothing [] [] $
   PayloadSingle ""
diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs
index 506a93e..e7797af 100644
--- a/src/Network/Minio/Data.hs
+++ b/src/Network/Minio/Data.hs
@@ -3,6 +3,7 @@ module Network.Minio.Data
   (
     ConnectInfo(..)
   , RequestInfo(..)
+  , ResponseInfo(..)
   , MinioConn(..)
   , Bucket
   , Object
@@ -15,10 +16,14 @@ module Network.Minio.Data
   ) where
 
 import qualified Data.ByteString as B
+import qualified Data.Conduit as C
 import           Network.HTTP.Client (defaultManagerSettings)
-import           Network.HTTP.Types (Method, Header, Query)
+import           Network.HTTP.Types (Method, Header, Query, Status)
 import qualified Network.HTTP.Conduit as NC
 
+import Control.Monad.Trans.Resource (MonadThrow, MonadResource, ResourceT, ResIO)
+import Control.Monad.Base (MonadBase)
+
 import           Lib.Prelude
 
 data ConnectInfo = ConnectInfo {
@@ -50,6 +55,12 @@ data RequestInfo = RequestInfo {
   , payloadHash :: ByteString
   }
 
+data ResponseInfo = ResponseInfo {
+    rpiStatus :: Status
+  , rpiHeaders :: [Header]
+  , rpiBody :: C.ResumableSource Minio ByteString
+  }
+
 getPathFromRI :: RequestInfo -> ByteString
 getPathFromRI ri = B.concat $ parts
   where
@@ -60,15 +71,21 @@ data MinioErr = MErrMsg ByteString
   deriving (Show)
 
 newtype Minio a = Minio {
-  unMinio :: ReaderT MinioConn (ExceptT MinioErr IO) a
-  } deriving (
+  unMinio :: ReaderT MinioConn (ExceptT MinioErr (ResourceT IO)) a
+  }
+  deriving (
       Functor
     , Applicative
     , Monad
     , MonadIO
     , MonadReader MinioConn
+    , MonadError MinioErr
+    , MonadThrow
+    , MonadBase IO
+    , MonadResource
     )
 
+
 -- MinioConn holds connection info and a connection pool
 data MinioConn = MinioConn {
     mcConnInfo :: ConnectInfo
@@ -80,5 +97,5 @@ connect ci = do
   mgr <- NC.newManager defaultManagerSettings
   return $ MinioConn ci mgr
 
-runMinio :: MinioConn -> Minio a -> IO (Either MinioErr a)
+runMinio :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
 runMinio conn = runExceptT . flip runReaderT conn . unMinio