{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
module Antiope.S3.Types
( X.BucketName(..)
, X.ObjectKey(..)
, X.ETag(..)
, S3Uri(..)
, readBucketName
, readWhile
, Range(..)
) where
import Antiope.S3.Internal
import Control.Applicative
import Control.Lens
import Control.Monad
import Data.Char
import Data.Generics.Product.Any
import Data.List
import Data.String (fromString)
import GHC.Generics
import Network.AWS.Data
import Network.AWS.S3 (BucketName (..), ObjectKey (..))
import Network.URI (unEscapeString)
import qualified Data.Attoparsec.Combinator as DAC
import qualified Data.Attoparsec.Text as DAT
import qualified Data.Text as T
import qualified Network.AWS.S3.Types as X
import qualified Text.ParserCombinators.ReadPrec as RP
data S3Uri = S3Uri
{ bucket :: BucketName
, objectKey :: ObjectKey
} deriving (Show, Eq, Ord, Generic)
instance FromText S3Uri where
parser = do
_ <- DAT.string "s3://"
bn <- BucketName . T.pack <$> DAC.many1 (DAT.satisfy (\c -> c /= '/' && c /= ' '))
_ <- optional (DAT.char '/')
ok <- ObjectKey . T.pack <$> many DAT.anyChar
DAT.endOfInput
return (S3Uri bn ok)
instance ToText S3Uri where
toText loc = toS3Uri (loc ^. the @"bucket") (loc ^. the @"objectKey")
data Range = Range
{ first :: Int
, last :: Int
} deriving (Eq, Show, Generic)
readString :: String -> RP.ReadPrec String
readString s = do
remainder <- RP.look
if s `isPrefixOf` remainder
then do
replicateM_ (length s) RP.get
return s
else RP.pfail
readWhile :: (Char -> Bool) -> RP.ReadPrec String
readWhile f = do
remainder <- RP.look
let taken = takeWhile f remainder
replicateM_ (length taken) RP.get
return taken
readBucketName :: RP.ReadPrec BucketName
readBucketName = do
bucketName <- readWhile bucketNameChar
when (length bucketName < 3 || length bucketName > 63) RP.pfail
return (BucketName (T.pack bucketName))
where bucketNameChar c = isLower c || isDigit c || c == '.' || c == '-'
instance Read S3Uri where
readsPrec = RP.readPrec_to_S $ do
_ <- readString "s3://"
bn <- readBucketName
ok <- ObjectKey . T.pack . unEscapeString . drop 1 <$> readWhile (/= ' ')
return (S3Uri bn ok)