haskell/minio-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Remove dependency on text-format lib and fix bucket policy test (#86)

Browse Source
This commit is contained in:
Aditya Manthramurthy 2018-05-11 17:48:34 -07:00 committed by Harshavardhana
parent 0177953986
commit 522d49452f
8 changed files with 58 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
minio-hs.cabal
View File

@ -63,7 +63,6 @@ library
, memory
, resourcet
, text
, text-format
, time
, transformers
, unliftio
@ -152,7 +151,6 @@ test-suite minio-hs-live-server-test
, tasty-smallcheck
, temporary
, text
, text-format
, time
, transformers
, unliftio
@ -192,7 +190,6 @@ test-suite minio-hs-test
, tasty-smallcheck
, temporary
, text
, text-format
, time
, transformers
, unliftio

25
src/Lib/Prelude.hs
View File

@ -17,29 +17,16 @@
module Lib.Prelude
( module Exports
, both
, format
, formatBS
) where
import Protolude as Exports
import Protolude as Exports
import Data.Time as Exports (UTCTime(..), diffUTCTime)
import Control.Monad.Trans.Maybe as Exports (runMaybeT, MaybeT(..))
import Control.Monad.Trans.Maybe as Exports (MaybeT (..), runMaybeT)
import Data.Time as Exports (UTCTime (..),
diffUTCTime)
import Control.Monad.Catch as Exports (throwM, MonadThrow, MonadCatch)
import Data.Text.Format as Exports (Shown(..))
import qualified Data.Text.Format as TF
import Data.Text.Format.Params (Params)
format :: Params ps => TF.Format -> ps -> Text
format f args = toS $ TF.format f args
formatBS :: Params ps => TF.Format -> ps -> ByteString
formatBS f args = toS $ TF.format f args
-- import Data.Tuple as Exports (uncurry)
import Control.Monad.Catch as Exports (MonadCatch, MonadThrow,
throwM)
-- | Apply a function on both elements of a pair
both :: (a -> b) -> (a, a) -> (b, b)

26
src/Network/Minio/API.hs
View File

@ -28,18 +28,18 @@ module Network.Minio.API
, checkObjectNameValidity
) where
import qualified Data.Conduit as C
import Data.Conduit.Binary (sourceHandleRange)
import Data.Default (def)
import qualified Data.Map as Map
import qualified Data.Char as C
import qualified Data.Text as T
import qualified Data.ByteString as B
import qualified Data.ByteString as B
import qualified Data.Char as C
import qualified Data.Conduit as C
import Data.Conduit.Binary (sourceHandleRange)
import Data.Default (def)
import qualified Data.Map as Map
import qualified Data.Text as T
import Network.HTTP.Conduit (Response)
import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT
import Network.HTTP.Types.Header (hHost)
import Network.HTTP.Conduit (Response)
import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT
import Network.HTTP.Types.Header (hHost)
import Lib.Prelude
@ -128,9 +128,7 @@ buildRequest ri = do
-- otherwise compute sha256
| otherwise -> getPayloadSHA256Hash (riPayload ri)
let hostHeader = (hHost, formatBS "{}:{}" [connectHost ci,
show $ connectPort ci])
let hostHeader = (hHost, getHostAddr ci)
newRi = ri { riPayloadHash = Just sha256Hash
, riHeaders = hostHeader
: sha256Header sha256Hash

10
src/Network/Minio/Data.hs
View File

@ -24,13 +24,13 @@ import qualified Control.Monad.Catch as MC
import Control.Monad.IO.Unlift (MonadUnliftIO, UnliftIO (..),
askUnliftIO, withUnliftIO)
import Control.Monad.Trans.Resource
import qualified Data.ByteString as B
import Data.CaseInsensitive (mk)
import Data.Default (Default (..))
import qualified Data.Map as Map
import qualified Data.Text as T
import Data.Time (defaultTimeLocale, formatTime)
import GHC.Show (Show (show))
import Network.HTTP.Client (defaultManagerSettings)
import qualified Network.HTTP.Conduit as NC
import Network.HTTP.Types (ByteRange, Header, Method, Query,
@ -39,8 +39,6 @@ import qualified Network.HTTP.Types as HT
import Network.Minio.Errors
import Text.XML
import GHC.Show (Show (..))
import Lib.Prelude
-- | max obj size is 5TiB
@ -99,6 +97,12 @@ data ConnectInfo = ConnectInfo {
instance Default ConnectInfo where
def = ConnectInfo "localhost" 9000 "minio" "minio123" False "us-east-1" True
getHostAddr :: ConnectInfo -> ByteString
getHostAddr ci = toS $ T.concat [ connectHost ci, ":"
, Lib.Prelude.show $ connectPort ci
]
-- | Default AWS ConnectInfo. Connects to "us-east-1". Credentials
-- should be supplied before use, for e.g.:
--

9
src/Network/Minio/PresignedOperations.hs
View File

@ -71,8 +71,7 @@ makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do
ci <- asks mcConnInfo
let
host = formatBS "{}:{}" (connectHost ci, connectPort ci)
hostHeader = (hHost, host)
hostHeader = (hHost, getHostAddr ci)
ri = def { riMethod = method
, riBucket = bucket
, riObject = object
@ -89,7 +88,8 @@ makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do
scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci
return $ toS $ toLazyByteString $
scheme <> byteString host <> byteString (getPathFromRI ri) <> queryStr
scheme <> byteString (getHostAddr ci) <> byteString (getPathFromRI ri) <>
queryStr
-- | Generate a URL with authentication signature to PUT (upload) an
-- object. Any extra headers if passed, are signed, and so they are
@ -272,10 +272,9 @@ presignedPostPolicy p = do
-- compute POST upload URL
bucket = Map.findWithDefault "" "bucket" formData
scheme = byteString $ bool "http://" "https://" $ connectIsSecure ci
host = formatBS "{}:{}" (connectHost ci, connectPort ci)
region = connectRegion ci
url = toS $ toLazyByteString $ scheme <> byteString host <>
url = toS $ toLazyByteString $ scheme <> byteString (getHostAddr ci) <>
byteString "/" <> byteString (toS bucket) <> byteString "/"
return (url, formData)

6
src/Network/Minio/S3API.hs
View File

@ -280,8 +280,10 @@ putObjectPart bucket object uploadId partNumber headers payload = do
]
srcInfoToHeaders :: SourceInfo -> [HT.Header]
srcInfoToHeaders srcInfo = ("x-amz-copy-source", encodeUtf8 $ format "/{}/{}" [srcBucket srcInfo, srcObject srcInfo]) :
rangeHdr ++ zip names values
srcInfoToHeaders srcInfo = ("x-amz-copy-source",
toS $ T.concat ["/", srcBucket srcInfo,
"/", srcObject srcInfo]
) : rangeHdr ++ zip names values
where
names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match",
"x-amz-copy-source-if-unmodified-since",

25
test/LiveServer.hs
View File

@ -19,6 +19,7 @@ import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
import Conduit (replicateC)
import qualified Control.Monad.Catch as MC
import qualified Control.Monad.Trans.Resource as R
import qualified Data.ByteString as BS
@ -798,7 +799,7 @@ bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $
Left exn -> liftIO $ exn @?= ServiceErr "NoSuchBucketPolicy" "The bucket policy does not exist"
_ -> return ()
let expectedPolicyJSON = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket\"],\"Sid\":\"\"},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket/*\"],\"Sid\":\"\"}]}"
let expectedPolicyJSON = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket\"]},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::testbucket/*\"]}]}"
step "try a malformed policy, expect error"
resE'' <- MC.try $ setBucketPolicy bucket expectedPolicyJSON
@ -806,14 +807,28 @@ bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $
Left exn -> liftIO $ exn @?= ServiceErr "MalformedPolicy" "Policy has invalid resource."
_ -> return ()
let expectedPolicyJSON' = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::" <> bucket <> "\"],\"Sid\":\"\"},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::" <> bucket <> "/*\"],\"Sid\":\"\"}]}"
let expectedPolicyJSON' = "{\"Version\":\"2012-10-17\",\"Statement\":[{\"Action\":[\"s3:GetBucketLocation\",\"s3:ListBucket\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::" <> bucket <> "\"]},{\"Action\":[\"s3:GetObject\"],\"Effect\":\"Allow\",\"Principal\":{\"AWS\":[\"*\"]},\"Resource\":[\"arn:aws:s3:::" <> bucket <> "/*\"]}]}"
step "set bucket policy"
setBucketPolicy bucket expectedPolicyJSON'
step "verify if bucket policy was properly set"
policyJSON <- getBucketPolicy bucket
liftIO $ policyJSON @?= expectedPolicyJSON'
let obj = "myobject"
step "verify bucket policy: (1) create `myobject`"
putObject bucket obj (replicateC 100 "c") Nothing def
step "verify bucket policy: (2) get `myobject` anonymously"
connInfo <- asks mcConnInfo
let proto = bool "http://" "https://" $ connectIsSecure connInfo
url = BS.concat [proto, getHostAddr connInfo, "/", toS bucket,
"/", toS obj]
respE <- liftIO $ (fmap (Right . toS) $ NC.simpleHttp $ toS url) `catch`
(\(e :: NC.HttpException) -> return $ Left (show e :: Text))
case respE of
Left err -> liftIO $ assertFailure $ show err
Right s -> liftIO $ s @?= (BS.concat $ replicate 100 "c")
deleteObject bucket obj
step "delete bucket policy"
setBucketPolicy bucket T.empty

9
test/Network/Minio/API/Test.hs
View File

@ -19,13 +19,14 @@ module Network.Minio.API.Test
, objectNameValidityTests
) where
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty
import Test.Tasty.HUnit
import Lib.Prelude
import Lib.Prelude
import Network.Minio.API
import Network.Minio.API
assertBool' :: Bool -> Assertion
assertBool' = assertBool "Test failed!"
bucketNameValidityTests :: TestTree