more progress
This commit is contained in:
parent
fb6bf1a9cb
commit
9d6ec0f6e5
21
app/Main.hs
21
app/Main.hs
@ -7,10 +7,25 @@ import Protolude
|
|||||||
import Network.Minio.Data
|
import Network.Minio.Data
|
||||||
|
|
||||||
import Network.Minio.API
|
import Network.Minio.API
|
||||||
import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)
|
import Control.Monad.Trans.Resource (runResourceT)
|
||||||
|
import qualified Data.Conduit as C
|
||||||
|
import qualified Data.Conduit.List as CL
|
||||||
|
import qualified Network.HTTP.Conduit as NC
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
mc <- connect defaultConnectInfo
|
mc <- connect defaultConnectInfo
|
||||||
res <- runResourceT $ runMinio mc $ getService
|
t <- runResourceT $ runMinio mc $ do
|
||||||
print $ rpiStatus <$> res
|
res <- getService
|
||||||
|
liftIO $ print $ NC.responseStatus res
|
||||||
|
liftIO $ print $ NC.responseHeaders res
|
||||||
|
-- liftIO print $ NC.responseHeaders <$> res
|
||||||
|
-- let bodyE = NC.responseBody <$> res
|
||||||
|
-- case bodyE of
|
||||||
|
-- Left x -> print x
|
||||||
|
-- Right body -> body C.$$+- CL.mapM_ putStrLn
|
||||||
|
-- body <- NC.responseBody <$> res
|
||||||
|
NC.responseBody res C.$$+- CL.mapM_ putStrLn
|
||||||
|
|
||||||
|
print "Hello"
|
||||||
|
print t
|
||||||
|
|||||||
@ -37,10 +37,14 @@ library
|
|||||||
, resourcet
|
, resourcet
|
||||||
, text
|
, text
|
||||||
, time
|
, time
|
||||||
|
, transformers
|
||||||
, transformers-base
|
, transformers-base
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
default-extensions: OverloadedStrings
|
default-extensions: FlexibleContexts
|
||||||
|
, FlexibleInstances
|
||||||
|
, OverloadedStrings
|
||||||
, NoImplicitPrelude
|
, NoImplicitPrelude
|
||||||
|
, MultiParamTypeClasses
|
||||||
, MultiWayIf
|
, MultiWayIf
|
||||||
|
|
||||||
executable minio-hs-exe
|
executable minio-hs-exe
|
||||||
@ -48,6 +52,7 @@ executable minio-hs-exe
|
|||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
|
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
|
||||||
build-depends: base
|
build-depends: base
|
||||||
|
, conduit
|
||||||
, minio-hs
|
, minio-hs
|
||||||
, protolude >= 0.1.6 && < 0.2
|
, protolude >= 0.1.6 && < 0.2
|
||||||
, http-conduit
|
, http-conduit
|
||||||
|
|||||||
@ -16,6 +16,8 @@ import Control.Monad.Trans.Resource (MonadResource, ResourceT, runResourceT)
|
|||||||
|
|
||||||
import Lib.Prelude
|
import Lib.Prelude
|
||||||
|
|
||||||
|
import qualified Data.Conduit as C
|
||||||
|
|
||||||
import Network.Minio.Data
|
import Network.Minio.Data
|
||||||
import Network.Minio.Data.Crypto
|
import Network.Minio.Data.Crypto
|
||||||
import Network.Minio.Sign.V4
|
import Network.Minio.Sign.V4
|
||||||
@ -32,7 +34,7 @@ import Network.Minio.Sign.V4
|
|||||||
-- -- print $ NC.requestBody r
|
-- -- print $ NC.requestBody r
|
||||||
-- NC.httpLbs r mgr
|
-- NC.httpLbs r mgr
|
||||||
|
|
||||||
mkSRequest :: RequestInfo -> Minio ResponseInfo
|
mkSRequest :: RequestInfo -> Minio (Response (C.ResumableSource Minio ByteString))
|
||||||
mkSRequest ri = do
|
mkSRequest ri = do
|
||||||
let PayloadSingle pload = payload ri
|
let PayloadSingle pload = payload ri
|
||||||
phash = hashSHA256 pload
|
phash = hashSHA256 pload
|
||||||
@ -59,17 +61,14 @@ mkSRequest ri = do
|
|||||||
}
|
}
|
||||||
|
|
||||||
response <- NC.http req mgr
|
response <- NC.http req mgr
|
||||||
return $ ResponseInfo
|
return response
|
||||||
(NC.responseStatus response)
|
|
||||||
(NC.responseHeaders response)
|
|
||||||
(NC.responseBody response)
|
|
||||||
|
|
||||||
requestInfo :: Method -> Maybe Bucket -> Maybe Object
|
requestInfo :: Method -> Maybe Bucket -> Maybe Object
|
||||||
-> Query -> [Header] -> Payload
|
-> Query -> [Header] -> Payload
|
||||||
-> RequestInfo
|
-> RequestInfo
|
||||||
requestInfo m b o q h p = RequestInfo m b o q h p ""
|
requestInfo m b o q h p = RequestInfo m b o q h p ""
|
||||||
|
|
||||||
getService :: Minio ResponseInfo
|
-- getService :: Minio _ -- ResponseInfo
|
||||||
getService = mkSRequest $
|
getService = mkSRequest $
|
||||||
requestInfo HT.methodGet Nothing Nothing [] [] $
|
requestInfo HT.methodGet Nothing Nothing [] [] $
|
||||||
PayloadSingle ""
|
PayloadSingle ""
|
||||||
|
|||||||
@ -3,7 +3,7 @@ module Network.Minio.Data
|
|||||||
(
|
(
|
||||||
ConnectInfo(..)
|
ConnectInfo(..)
|
||||||
, RequestInfo(..)
|
, RequestInfo(..)
|
||||||
, ResponseInfo(..)
|
-- , ResponseInfo(..)
|
||||||
, MinioConn(..)
|
, MinioConn(..)
|
||||||
, Bucket
|
, Bucket
|
||||||
, Object
|
, Object
|
||||||
@ -17,12 +17,13 @@ module Network.Minio.Data
|
|||||||
|
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.Conduit as C
|
import qualified Data.Conduit as C
|
||||||
import Network.HTTP.Client (defaultManagerSettings)
|
import Network.HTTP.Client (defaultManagerSettings, HttpException)
|
||||||
import Network.HTTP.Types (Method, Header, Query, Status)
|
import Network.HTTP.Types (Method, Header, Query, Status)
|
||||||
import qualified Network.HTTP.Conduit as NC
|
import qualified Network.HTTP.Conduit as NC
|
||||||
|
|
||||||
|
import Control.Monad.Trans.Class (MonadTrans(..))
|
||||||
import Control.Monad.Trans.Resource (MonadThrow, MonadResource, ResourceT, ResIO)
|
import Control.Monad.Trans.Resource (MonadThrow, MonadResource, ResourceT, ResIO)
|
||||||
import Control.Monad.Base (MonadBase)
|
import Control.Monad.Base (MonadBase(..))
|
||||||
|
|
||||||
import Lib.Prelude
|
import Lib.Prelude
|
||||||
|
|
||||||
@ -55,11 +56,6 @@ data RequestInfo = RequestInfo {
|
|||||||
, payloadHash :: ByteString
|
, payloadHash :: ByteString
|
||||||
}
|
}
|
||||||
|
|
||||||
data ResponseInfo = ResponseInfo {
|
|
||||||
rpiStatus :: Status
|
|
||||||
, rpiHeaders :: [Header]
|
|
||||||
, rpiBody :: C.ResumableSource Minio ByteString
|
|
||||||
}
|
|
||||||
|
|
||||||
getPathFromRI :: RequestInfo -> ByteString
|
getPathFromRI :: RequestInfo -> ByteString
|
||||||
getPathFromRI ri = B.concat $ parts
|
getPathFromRI ri = B.concat $ parts
|
||||||
@ -68,6 +64,7 @@ getPathFromRI ri = B.concat $ parts
|
|||||||
parts = maybe ["/"] (\b -> "/" : b : objPart) $ bucket ri
|
parts = maybe ["/"] (\b -> "/" : b : objPart) $ bucket ri
|
||||||
|
|
||||||
data MinioErr = MErrMsg ByteString
|
data MinioErr = MErrMsg ByteString
|
||||||
|
| MErrHttp HttpException
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
newtype Minio a = Minio {
|
newtype Minio a = Minio {
|
||||||
@ -85,7 +82,6 @@ newtype Minio a = Minio {
|
|||||||
, MonadResource
|
, MonadResource
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
-- MinioConn holds connection info and a connection pool
|
-- MinioConn holds connection info and a connection pool
|
||||||
data MinioConn = MinioConn {
|
data MinioConn = MinioConn {
|
||||||
mcConnInfo :: ConnectInfo
|
mcConnInfo :: ConnectInfo
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user