135 lines
3.5 KiB
Haskell
135 lines
3.5 KiB
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
|
|
module Network.Minio.Data
|
|
( ConnectInfo(..)
|
|
, RequestInfo(..)
|
|
, MinioConn(..)
|
|
, Bucket
|
|
, Object
|
|
, Location
|
|
, BucketInfo(..)
|
|
, getPathFromRI
|
|
, getRegionFromRI
|
|
, Minio
|
|
, MinioErr(..)
|
|
, MErrV(..)
|
|
, runMinio
|
|
, defaultConnectInfo
|
|
, connect
|
|
, Payload(..)
|
|
, s3Name
|
|
) where
|
|
|
|
import qualified Data.ByteString as B
|
|
import Network.HTTP.Client (defaultManagerSettings, HttpException)
|
|
import Network.HTTP.Types (Method, Header, Query)
|
|
import qualified Network.HTTP.Conduit as NC
|
|
|
|
-- import Control.Monad.Trans.Resource (MonadThrow, MonadResource, ResourceT,
|
|
-- MonadBaseControl(..))
|
|
import Control.Monad.Trans.Resource
|
|
import Control.Monad.Trans.Control
|
|
import Control.Monad.Base
|
|
|
|
import Text.XML
|
|
|
|
import Lib.Prelude
|
|
|
|
data ConnectInfo = ConnectInfo {
|
|
connectHost :: Text
|
|
, connectPort :: Int
|
|
, connectAccessKey :: Text
|
|
, connectSecretKey :: Text
|
|
, connectIsSecure :: Bool
|
|
} deriving (Eq, Show)
|
|
|
|
defaultConnectInfo :: ConnectInfo
|
|
defaultConnectInfo =
|
|
ConnectInfo "localhost" 9000 "minio" "minio123" False
|
|
|
|
type Bucket = Text
|
|
type Object = Text
|
|
|
|
-- FIXME: This could be a Sum Type with all defined regions for AWS.
|
|
type Location = Text
|
|
|
|
data BucketInfo = BucketInfo {
|
|
biName :: Bucket
|
|
, biCreationDate :: UTCTime
|
|
} deriving (Show, Eq)
|
|
|
|
|
|
data Payload = EPayload
|
|
| PayloadBS ByteString
|
|
| PayloadH Handle
|
|
Int64 -- offset
|
|
Int64 -- size
|
|
|
|
data RequestInfo = RequestInfo {
|
|
riMethod :: Method
|
|
, riBucket :: Maybe Bucket
|
|
, riObject :: Maybe Object
|
|
, riQueryParams :: Query
|
|
, riHeaders :: [Header]
|
|
, riPayload :: Payload
|
|
, riPayloadHash :: ByteString
|
|
, riRegion :: Maybe Location
|
|
}
|
|
|
|
|
|
getPathFromRI :: RequestInfo -> ByteString
|
|
getPathFromRI ri = B.concat $ parts
|
|
where
|
|
objPart = maybe [] (\o -> ["/", encodeUtf8 o]) $ riObject ri
|
|
parts = maybe ["/"] (\b -> "/" : encodeUtf8 b : objPart) $ riBucket ri
|
|
|
|
getRegionFromRI :: RequestInfo -> Text
|
|
getRegionFromRI ri = maybe "us-east-1" identity (riRegion ri)
|
|
|
|
data MErrV = MErrVSinglePUTSizeExceeded Int64
|
|
deriving (Show)
|
|
|
|
data MinioErr = MErrMsg ByteString -- generic
|
|
| MErrHttp HttpException -- http exceptions
|
|
| MErrXml ByteString -- XML parsing/generation errors
|
|
| MErrService ByteString -- error response from service
|
|
| MErrValidation MErrV -- client-side validation errors
|
|
| MErrIO IOException -- exceptions while working with files
|
|
deriving (Show)
|
|
|
|
newtype Minio a = Minio {
|
|
unMinio :: ReaderT MinioConn (ExceptT MinioErr (ResourceT IO)) a
|
|
}
|
|
deriving (
|
|
Functor
|
|
, Applicative
|
|
, Monad
|
|
, MonadIO
|
|
, MonadReader MinioConn
|
|
, MonadError MinioErr
|
|
, MonadThrow
|
|
, MonadBase IO
|
|
, MonadResource
|
|
)
|
|
|
|
instance MonadBaseControl IO Minio where
|
|
type StM Minio a = Either MinioErr a
|
|
liftBaseWith f = Minio $ liftBaseWith $ \q -> f (q . unMinio)
|
|
restoreM = Minio . restoreM
|
|
|
|
-- MinioConn holds connection info and a connection pool
|
|
data MinioConn = MinioConn {
|
|
mcConnInfo :: ConnectInfo
|
|
, mcConnManager :: NC.Manager
|
|
}
|
|
|
|
connect :: ConnectInfo -> IO MinioConn
|
|
connect ci = do
|
|
mgr <- NC.newManager defaultManagerSettings
|
|
return $ MinioConn ci mgr
|
|
|
|
runMinio :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
|
|
runMinio conn = runExceptT . flip runReaderT conn . unMinio
|
|
|
|
s3Name :: Text -> Name
|
|
s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing
|