S3-0.1.0.0: Library for accessing S3 compatible storage services

Copyright© Herbert Valerio Riedel 2016-2019
LicenseGPL-3.0-or-later
Safe HaskellNone
LanguageHaskell2010

Network.S3

Contents

Description

Simple lightweight S3 API implementation

This implementation has been tested succesfully against MinIO's, Dreamhost's, and AWS' S3 server implementations

API Usage Example

The example below shows how to create, populate, list, and finally destroy a bucket again.

 -- demo credentials for http://play.min.io/
 let s3cfg = defaultS3Cfg { s3cfgBaseUrl = "https://play.min.io:9000" }
     creds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"

 -- we'll create this bucket and delete it again
 let testBucket = BucketId "haskell-test-bucket-42"

 withConnection s3cfg $ conn -> do
   createBucket conn creds testBucket Nothing

   etag1 <- putObject conn creds testBucket (ObjKey "folder/file1") "content1" (CType "text/plain") Nothing
   etag2 <- putObject conn creds testBucket (ObjKey "file2") "content2" (CType "text/plain") Nothing

   -- will list the key "file2" and the common-prefix "folder/"
   print =<< listObjects conn creds testBucket nullObjKey (Just '/')
   -- will list only the key "folder/file1"
   print =<< listObjects conn creds testBucket (ObjKey "folder/") (Just '/')
   -- will list the two keys "folder/file1" and "file2" (and no common prefix)
   print =<< listObjects conn creds testBucket nullObjKey Nothing

   -- ...and now we remove the two objects we created above
   deleteObject conn creds testBucket (ObjKey "folder/file1")
   deleteObject conn creds testBucket (ObjKey "file2")

   deleteBucket conn creds testBucket
Synopsis

Operations on Buckets

newtype BucketId Source #

S3 Bucket identifier

Constructors

BucketId ShortByteString

Must be valid as DNS name component; S3 server implementations may have additional restrictions (see e.g. AWS S3's "Rules for Bucket Naming")

Instances
Eq BucketId Source # 
Instance details

Defined in Network.S3.Types

Ord BucketId Source # 
Instance details

Defined in Network.S3.Types

Show BucketId Source # 
Instance details

Defined in Network.S3.Types

Generic BucketId Source # 
Instance details

Defined in Network.S3.Types

Associated Types

type Rep BucketId :: Type -> Type #

Methods

from :: BucketId -> Rep BucketId x #

to :: Rep BucketId x -> BucketId #

NFData BucketId Source # 
Instance details

Defined in Network.S3.Types

Methods

rnf :: BucketId -> () #

Hashable BucketId Source # 
Instance details

Defined in Network.S3.Types

Methods

hashWithSalt :: Int -> BucketId -> Int #

hash :: BucketId -> Int #

type Rep BucketId Source # 
Instance details

Defined in Network.S3.Types

type Rep BucketId = D1 (MetaData "BucketId" "Network.S3.Types" "S3-0.1.0.0-ICJYI1Ni7n55Gr22u6JgTL" True) (C1 (MetaCons "BucketId" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ShortByteString)))

data BucketInfo Source #

Bucket metadata reported by listBuckets

Constructors

BucketInfo !BucketId !UTCTime 
Instances
Show BucketInfo Source # 
Instance details

Defined in Network.S3

Generic BucketInfo Source # 
Instance details

Defined in Network.S3

Associated Types

type Rep BucketInfo :: Type -> Type #

NFData BucketInfo Source # 
Instance details

Defined in Network.S3

Methods

rnf :: BucketInfo -> () #

type Rep BucketInfo Source # 
Instance details

Defined in Network.S3

data Acl Source #

Access permissions (aka Canned ACLs)

This has different meanings depending on whether it's set for buckets or objects

The owner of an entity has always full read & write access

For buckets, read access denotes the ability to list objects

Instances
Show Acl Source # 
Instance details

Defined in Network.S3

Methods

showsPrec :: Int -> Acl -> ShowS #

show :: Acl -> String #

showList :: [Acl] -> ShowS #

Generic Acl Source # 
Instance details

Defined in Network.S3

Associated Types

type Rep Acl :: Type -> Type #

Methods

from :: Acl -> Rep Acl x #

to :: Rep Acl x -> Acl #

NFData Acl Source # 
Instance details

Defined in Network.S3

Methods

rnf :: Acl -> () #

type Rep Acl Source # 
Instance details

Defined in Network.S3

type Rep Acl = D1 (MetaData "Acl" "Network.S3" "S3-0.1.0.0-ICJYI1Ni7n55Gr22u6JgTL" False) ((C1 (MetaCons "AclPrivate" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "AclPublicRead" PrefixI False) (U1 :: Type -> Type)) :+: (C1 (MetaCons "AclPublicReadWrite" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "AclPublicAuthenticatedRead" PrefixI False) (U1 :: Type -> Type)))

listBuckets :: Connection -> Credentials -> IO [BucketInfo] Source #

List buckets owned by user

createBucket :: Connection -> Credentials -> BucketId -> Maybe Acl -> IO () Source #

Create bucket

deleteBucket :: Connection -> Credentials -> BucketId -> IO () Source #

Delete bucket

NOTE: Most S3 implementations require the bucket to be empty before it can be deleted. See documentation of listObjectsFold for a code example deleting a non-empty bucket.

listObjects Source #

Arguments

:: Connection 
-> Credentials 
-> BucketId 
-> ObjKey

prefix

-> Maybe Char

delimiter

-> IO ([ObjMetaInfo], [ObjKey])
(objects, prefixes)

List all objects in a bucket

This operation may cause multiple HTTP requests to be issued

See also listObjectsChunk and listObjectsFold

listObjectsFold Source #

Arguments

:: Connection 
-> Credentials 
-> BucketId 
-> ObjKey

prefix

-> Maybe Char

delimiter

-> Word16

max number of keys per iteration

-> a

initial value of accumulator argument to folding function

-> (a -> [ObjMetaInfo] -> [ObjKey] -> IO a)

folding function

-> IO a

returns final value of accumulator value

Convenient foldM-like object listing operation

Here's an usage example for iterating over the list of objects in chunks of 100 objects and deleting those; and finally deleting the bucket:

destroyBucket conn creds bid = do
  listObjectsFold conn creds bid nullObjKey Nothing 100 () $ \() objs [] ->
    forM_ objs $ \omi -> deleteObject conn creds bid (omiKey omi)
  deleteBucket conn creds bid

listObjectsChunk Source #

Arguments

:: Connection 
-> Credentials 
-> BucketId 
-> ObjKey

prefix (use isNullObjKey if none)

-> Maybe Char

delimiter

-> ObjKey

marker (use isNullObjKey if none)

-> Word16

max-keys (set 0 to use default which is usually 1000)

-> IO (ObjKey, [ObjMetaInfo], [ObjKey])
(next-marker, objects, prefixes)

Primitive operation for list objects

This operation corresponds to a single HTTP service request

The listObjectsChunk and listObjects operations build on this primitive building block.

Operations on Objects

Object keys

newtype ObjKey Source #

The name for a key is a non-empty sequence of Unicode characters whose UTF-8 encoding is at most 1024 bytes long.

See also remarks in s3cfgEncodingUrl about permissible code-points.

See also AWS S3's documentation on "Object Key and Metadata"

Constructors

ObjKey ShortText 
Instances
Eq ObjKey Source # 
Instance details

Defined in Network.S3.Types

Methods

(==) :: ObjKey -> ObjKey -> Bool #

(/=) :: ObjKey -> ObjKey -> Bool #

Ord ObjKey Source # 
Instance details

Defined in Network.S3.Types

Show ObjKey Source # 
Instance details

Defined in Network.S3.Types

Generic ObjKey Source # 
Instance details

Defined in Network.S3.Types

Associated Types

type Rep ObjKey :: Type -> Type #

Methods

from :: ObjKey -> Rep ObjKey x #

to :: Rep ObjKey x -> ObjKey #

NFData ObjKey Source # 
Instance details

Defined in Network.S3.Types

Methods

rnf :: ObjKey -> () #

Hashable ObjKey Source # 
Instance details

Defined in Network.S3.Types

Methods

hashWithSalt :: Int -> ObjKey -> Int #

hash :: ObjKey -> Int #

type Rep ObjKey Source # 
Instance details

Defined in Network.S3.Types

type Rep ObjKey = D1 (MetaData "ObjKey" "Network.S3.Types" "S3-0.1.0.0-ICJYI1Ni7n55Gr22u6JgTL" True) (C1 (MetaCons "ObjKey" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ShortText)))

isNullObjKey :: ObjKey -> Bool Source #

Test whether ObjKey is the nullObjKey

nullObjKey :: ObjKey Source #

Represents the null (or empty) ObjKey

Object metadata

data ObjMetaInfo Source #

Object Metadata

Constructors

OMI 
Instances
Eq ObjMetaInfo Source # 
Instance details

Defined in Network.S3.Types

Ord ObjMetaInfo Source # 
Instance details

Defined in Network.S3.Types

Show ObjMetaInfo Source # 
Instance details

Defined in Network.S3.Types

Generic ObjMetaInfo Source # 
Instance details

Defined in Network.S3.Types

Associated Types

type Rep ObjMetaInfo :: Type -> Type #

NFData ObjMetaInfo Source # 
Instance details

Defined in Network.S3.Types

Methods

rnf :: ObjMetaInfo -> () #

type Rep ObjMetaInfo Source # 
Instance details

Defined in Network.S3.Types

newtype CType Source #

Content-type

Constructors

CType ShortText 
Instances
Eq CType Source # 
Instance details

Defined in Network.S3.Types

Methods

(==) :: CType -> CType -> Bool #

(/=) :: CType -> CType -> Bool #

Show CType Source # 
Instance details

Defined in Network.S3.Types

Methods

showsPrec :: Int -> CType -> ShowS #

show :: CType -> String #

showList :: [CType] -> ShowS #

Generic CType Source # 
Instance details

Defined in Network.S3.Types

Associated Types

type Rep CType :: Type -> Type #

Methods

from :: CType -> Rep CType x #

to :: Rep CType x -> CType #

NFData CType Source # 
Instance details

Defined in Network.S3.Types

Methods

rnf :: CType -> () #

Hashable CType Source # 
Instance details

Defined in Network.S3.Types

Methods

hashWithSalt :: Int -> CType -> Int #

hash :: CType -> Int #

type Rep CType Source # 
Instance details

Defined in Network.S3.Types

type Rep CType = D1 (MetaData "CType" "Network.S3.Types" "S3-0.1.0.0-ICJYI1Ni7n55Gr22u6JgTL" True) (C1 (MetaCons "CType" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ShortText)))

noCType :: CType Source #

Unspecified CType

data ETag Source #

Denotes an ETag

Constructors

ETag !ShortByteString 
ETagMD5 !MD5Val

This constructor will be used if the ETag looks like a proper MD5 based ETag

Instances
Eq ETag Source # 
Instance details

Defined in Network.S3.Types

Methods

(==) :: ETag -> ETag -> Bool #

(/=) :: ETag -> ETag -> Bool #

Ord ETag Source # 
Instance details

Defined in Network.S3.Types

Methods

compare :: ETag -> ETag -> Ordering #

(<) :: ETag -> ETag -> Bool #

(<=) :: ETag -> ETag -> Bool #

(>) :: ETag -> ETag -> Bool #

(>=) :: ETag -> ETag -> Bool #

max :: ETag -> ETag -> ETag #

min :: ETag -> ETag -> ETag #

Show ETag Source # 
Instance details

Defined in Network.S3.Types

Methods

showsPrec :: Int -> ETag -> ShowS #

show :: ETag -> String #

showList :: [ETag] -> ShowS #

Generic ETag Source # 
Instance details

Defined in Network.S3.Types

Associated Types

type Rep ETag :: Type -> Type #

Methods

from :: ETag -> Rep ETag x #

to :: Rep ETag x -> ETag #

NFData ETag Source # 
Instance details

Defined in Network.S3.Types

Methods

rnf :: ETag -> () #

Hashable ETag Source # 
Instance details

Defined in Network.S3.Types

Methods

hashWithSalt :: Int -> ETag -> Int #

hash :: ETag -> Int #

type Rep ETag Source # 
Instance details

Defined in Network.S3.Types

MD5 hashes

data MD5Val Source #

MD5 Hash

Instances
Eq MD5Val Source # 
Instance details

Defined in Internal

Methods

(==) :: MD5Val -> MD5Val -> Bool #

(/=) :: MD5Val -> MD5Val -> Bool #

Ord MD5Val Source # 
Instance details

Defined in Internal

Show MD5Val Source # 
Instance details

Defined in Internal

IsString MD5Val Source # 
Instance details

Defined in Internal

Methods

fromString :: String -> MD5Val #

NFData MD5Val Source # 
Instance details

Defined in Internal

Methods

rnf :: MD5Val -> () #

Hashable MD5Val Source # 
Instance details

Defined in Internal

Methods

hashWithSalt :: Int -> MD5Val -> Int #

hash :: MD5Val -> Int #

md5hash :: ByteString -> MD5Val Source #

Compute MD5 hash

md5hex :: MD5Val -> ByteString Source #

Hex-encode MD5 digest value

md5unhex :: ByteString -> Maybe MD5Val Source #

Hex-decode MD5 digest value

md5ToSBS :: MD5Val -> ShortByteString Source #

Extract MD5 digest value

md5FromSBS :: ShortByteString -> Maybe MD5Val Source #

Construct MD5 digest value from 16 octets

Operations

putObject Source #

Arguments

:: Connection 
-> Credentials 
-> BucketId 
-> ObjKey

Object key

-> ByteString

Object payload data

-> CType

content-type (e.g. application/binary); see also noCType

-> Maybe Acl 
-> IO ETag 

PUT Object

copyObject Source #

Arguments

:: Connection 
-> Credentials 
-> BucketId 
-> ObjKey 
-> (BucketId, ObjKey)

source object to copy

-> Maybe Acl 
-> IO ETag 

Copy Object

getObject Source #

Arguments

:: Connection 
-> Credentials 
-> BucketId 
-> ObjKey

Object key

-> IO (ETag, CType, ByteString) 

GET Object

deleteObject :: Connection -> Credentials -> BucketId -> ObjKey -> IO () Source #

DELETE Object

Conditional operations

data Condition Source #

Conditional Request

Note that S3 server implementations vary in their support for conditional requests

Constructors

IfExists
If-Match: *
IfNotExists
If-None-Match: *
IfMatch !ETag
If-Match: ...
IfNotMatch !ETag
If-None-Match: ...
Instances
Eq Condition Source # 
Instance details

Defined in Network.S3.Types

Show Condition Source # 
Instance details

Defined in Network.S3.Types

Generic Condition Source # 
Instance details

Defined in Network.S3.Types

Associated Types

type Rep Condition :: Type -> Type #

NFData Condition Source # 
Instance details

Defined in Network.S3.Types

Methods

rnf :: Condition -> () #

type Rep Condition Source # 
Instance details

Defined in Network.S3.Types

type Rep Condition = D1 (MetaData "Condition" "Network.S3.Types" "S3-0.1.0.0-ICJYI1Ni7n55Gr22u6JgTL" False) ((C1 (MetaCons "IfExists" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "IfNotExists" PrefixI False) (U1 :: Type -> Type)) :+: (C1 (MetaCons "IfMatch" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 ETag)) :+: C1 (MetaCons "IfNotMatch" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 ETag))))

putObjectCond Source #

Arguments

:: Connection 
-> Credentials 
-> BucketId 
-> ObjKey

Object key

-> ByteString

Object payload data

-> CType

content-type (e.g. application/binary); see also noCType

-> Maybe Acl 
-> Condition 
-> IO (Maybe ETag) 

Errors

data ErrorCode Source #

S3-level errors

Instances
Show ErrorCode Source # 
Instance details

Defined in Network.S3

Generic ErrorCode Source # 
Instance details

Defined in Network.S3

Associated Types

type Rep ErrorCode :: Type -> Type #

NFData ErrorCode Source # 
Instance details

Defined in Network.S3

Methods

rnf :: ErrorCode -> () #

Exception ErrorCode Source # 
Instance details

Defined in Network.S3

type Rep ErrorCode Source # 
Instance details

Defined in Network.S3

type Rep ErrorCode = D1 (MetaData "ErrorCode" "Network.S3" "S3-0.1.0.0-ICJYI1Ni7n55Gr22u6JgTL" False) (((C1 (MetaCons "AccessDenied" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "BucketAlreadyExists" PrefixI False) (U1 :: Type -> Type)) :+: (C1 (MetaCons "BucketAlreadyOwnedByYou" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "BucketNotEmpty" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "MalformedXML" PrefixI False) (U1 :: Type -> Type)))) :+: ((C1 (MetaCons "NoSuchBucket" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "NoSuchKey" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "InvalidArgument" PrefixI False) (U1 :: Type -> Type))) :+: (C1 (MetaCons "InvalidDigest" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "SignatureDoesNotMatch" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "UnknownError" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 ShortText))))))

data ProtocolError Source #

Protocol-level errors and exceptions

Instances
Show ProtocolError Source # 
Instance details

Defined in Network.S3

Generic ProtocolError Source # 
Instance details

Defined in Network.S3

Associated Types

type Rep ProtocolError :: Type -> Type #

Exception ProtocolError Source # 
Instance details

Defined in Network.S3

type Rep ProtocolError Source # 
Instance details

Defined in Network.S3

Authentication

data Credentials Source #

S3 Credentials

We use memory pinned ByteStrings because we don't want to have the credential data copied around more than necessary.

Constructors

Credentials 

Fields

Instances
Eq Credentials Source # 
Instance details

Defined in Network.S3.Types

Show Credentials Source # 
Instance details

Defined in Network.S3.Types

Generic Credentials Source # 
Instance details

Defined in Network.S3.Types

Associated Types

type Rep Credentials :: Type -> Type #

NFData Credentials Source # 
Instance details

Defined in Network.S3.Types

Methods

rnf :: Credentials -> () #

type Rep Credentials Source # 
Instance details

Defined in Network.S3.Types

type Rep Credentials = D1 (MetaData "Credentials" "Network.S3.Types" "S3-0.1.0.0-ICJYI1Ni7n55Gr22u6JgTL" False) (C1 (MetaCons "Credentials" PrefixI True) (S1 (MetaSel (Just "s3AccessKey") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 ByteString) :*: S1 (MetaSel (Just "s3SecretKey") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 ByteString)))

noCredentials :: Credentials Source #

Anonymous access

Connection handling

data S3Cfg Source #

Configure S3 endpoint

Constructors

S3Cfg 

Fields

  • s3cfgBaseUrl :: !URL

    Service endpoint (i.e without BucketId); Only scheme, host and port are used currently , s3cfgPathStyle :: !Bool -- ^ use path-style access mode (i.e. http://s3.example.org/bucket-id instead of virtual-hosted style http://bucket-id.s3.example.org/)

  • s3cfgRegion :: !ByteString

    E.g. "us-east-1" this is currently only used for computing the signature when s3cfgSigVersion is set to SignatureV4

  • s3cfgSigVersion :: !SignatureVersion

    Which signature algorithm to use for authentication; SignatureV4 is recommended unless there's reason to use the legacy SignatureV2 variant.

  • s3cfgEncodingUrl :: !Bool

    Enable use of encoding=url feature for some operations

    This is only needed when object keys contain Unicode code-points not representable in XML 1.0; the XML 1.0 representable code-points are

    Char ::= #x9 | #xA | #xD | [#x20-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]

    Note that some S3 server implementations exhibit bugs when using LF or CR characters in object keys.

    Note also that some S3 implementation have been observed to incorrectly implement encoding=url so it's generally advisable to disable this feature unless there's actual need and it's been confirmed that the S3 server implementatio implements it correctly.

  • s3cfgDebug :: !Bool

    Enable protocol debugging output to stdout

Instances
Show S3Cfg Source # 
Instance details

Defined in Network.S3.Types

Methods

showsPrec :: Int -> S3Cfg -> ShowS #

show :: S3Cfg -> String #

showList :: [S3Cfg] -> ShowS #

Generic S3Cfg Source # 
Instance details

Defined in Network.S3.Types

Associated Types

type Rep S3Cfg :: Type -> Type #

Methods

from :: S3Cfg -> Rep S3Cfg x #

to :: Rep S3Cfg x -> S3Cfg #

NFData S3Cfg Source # 
Instance details

Defined in Network.S3.Types

Methods

rnf :: S3Cfg -> () #

type Rep S3Cfg Source # 
Instance details

Defined in Network.S3.Types

defaultS3Cfg :: S3Cfg Source #

Default S3Cfg value with recommended/default settings, i.e.

>>> defaultS3Cfg
S3Cfg {s3cfgBaseUrl = "", s3cfgRegion = "us-east-1", s3cfgSigVersion = SignatureV4, s3cfgEncodingUrl = False, s3cfgDebug = False}

NOTE: At the very least you have to override the s3cfgBaseUrl field.

data SignatureVersion Source #

Denotes version of the S3 request signing algorithm

Constructors

SignatureV2

Legacy HMAC-SHA1/MD5 based signing algorithm

SignatureV4

Current HMAC-SHA256 based signing algorithm (recommended)

Instances
Eq SignatureVersion Source # 
Instance details

Defined in Network.S3.Types

Show SignatureVersion Source # 
Instance details

Defined in Network.S3.Types

Generic SignatureVersion Source # 
Instance details

Defined in Network.S3.Types

Associated Types

type Rep SignatureVersion :: Type -> Type #

NFData SignatureVersion Source # 
Instance details

Defined in Network.S3.Types

Methods

rnf :: SignatureVersion -> () #

type Rep SignatureVersion Source # 
Instance details

Defined in Network.S3.Types

type Rep SignatureVersion = D1 (MetaData "SignatureVersion" "Network.S3.Types" "S3-0.1.0.0-ICJYI1Ni7n55Gr22u6JgTL" False) (C1 (MetaCons "SignatureV2" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "SignatureV4" PrefixI False) (U1 :: Type -> Type))

data Connection Source #

Represents a single-threaded HTTP channel to the S3 service

withConnection :: S3Cfg -> (Connection -> IO a) -> IO a Source #

Simple single-connection bracket style combinator over connect and close

If you need resource pool management you can use connect in combination with packages such as resource-pool.

connect :: S3Cfg -> IO Connection Source #

Create HTTP(s) connection based on S3Cfg

close :: Connection -> IO () Source #

Close connection constructed via connect