diff --git a/Aws/SSSP.hs b/Aws/SSSP.hs new file mode 100644 --- /dev/null +++ b/Aws/SSSP.hs @@ -0,0 +1,346 @@ +{-# LANGUAGE OverloadedStrings + , ParallelListComp + , RecordWildCards + , StandaloneDeriving + , PatternGuards + #-} +module Aws.SSSP where + +import Control.Applicative +import Control.Arrow ((***)) +import Control.Monad +import Data.Char +import Data.Either +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as Bytes +import qualified Data.List as List +import Data.Maybe +import Data.Monoid +import Data.Ord +import qualified Data.Set as Set +import Data.Word + +import qualified Aws as Aws +import qualified Aws.Core as Aws +import qualified Aws.S3 as Aws +import qualified Blaze.ByteString.Builder as Blaze +import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze +import Control.Monad.Trans +import Data.Attempt +import Data.Attoparsec.Text (Parser) +import qualified Data.Attoparsec.Text as Atto +import qualified Data.Conduit as Conduit +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Read as Text +import qualified Network.Wai as WWW +import qualified Network.HTTP.Conduit as Conduit +import qualified Network.HTTP.Types as HTTP + +import qualified Aws.SSSP.WWW as WWW + + +wai :: Ctx -> WWW.Application +wai ctx@Ctx{..} req@WWW.Request{..} = do + resolved <- task ctx requestMethod (resource req) + maybe (return badTask) id $ do + task <- resolved + Just $ case task of + Retrieve t -> do + maybe (return badTime) id $ do + seconds <- timeParam + Just $ do + sigInfo <- liftIO $ sigData (fromIntegral seconds) + let q = Aws.getObject bucket t + s = Aws.queryToUri (Aws.signQuery q s3 sigInfo) + b = Blaze.fromByteString (s `Bytes.snoc` '\n') + m = "max-age=" ++ show (seconds - 1) + headers = [("Cache-Control", Bytes.pack m) + ,("Content-Type", "text/plain") + ,("Location", s)] + if direct then WWW.proxied manager (Bytes.unpack s) + else return $ WWW.ResponseBuilder status307 headers b + Listing ts -> do + return $ WWW.ResponseBuilder + HTTP.status200 [("Content-Type", "text/plain")] + (mconcat (plusNL . s3Encode <$> ts)) + Remove ts -> do + let deletes = [ Aws.DeleteObject t bucket | t <- ts ] + responses <- mapM (Aws.aws aws s3 manager) deletes + let attempts = [ attempt | Aws.Response _meta attempt <- responses ] + d = [ mappend `uncurry` case a of + Success _ -> ("deleted: ", t) + Failure _ -> ("failed: ", t) | a <- attempts | t <- ts ] + status | all isSuccess attempts = HTTP.status200 + | otherwise = HTTP.status500 + return $ WWW.ResponseBuilder + status [("Content-Type", "text/plain")] + (Blaze.fromText . Text.unlines $ d) + Write t -> do + let len = join $ listToMaybe + [ fst <$> (listToMaybe . reads . Bytes.unpack) v + | (k, v) <- requestHeaders, k == "Content-Length" ] + maybe (return noLength) id $ do + n <- len + Just . maybe (return badTime) id $ do + seconds <- timeParam + Just $ do + sigInfo <- liftIO $ sigData (fromIntegral seconds) + let q = Aws.putObject bucket t (blazeBody n) + r = WWW.addHeaders q requestHeaders + s = Aws.queryToUri (Aws.signQuery r s3 sigInfo) + b = Blaze.fromByteString (s `Bytes.snoc` '\n') + m = "max-age=" ++ show (defaultSeconds - 1) + headers = [("Cache-Control", Bytes.pack m) + ,("Content-Type", "text/plain") + ,("Location", s)] + return $ WWW.ResponseBuilder status307 headers b + where + defaultSeconds = 10 + status307 = HTTP.Status 307 "Temporary Redirect" + sigData n = Aws.signatureData (Aws.ExpiresIn n) (Aws.credentials aws) + badTask = WWW.ResponseBuilder + HTTP.status400 [("Content-Type", "text/plain")] + (Blaze.fromByteString "Malformed task.\n") + noLength = WWW.ResponseBuilder + HTTP.status400 [("Content-Type", "text/plain")] + (Blaze.fromByteString "No Content-Length header.\n") + badTime = WWW.ResponseBuilder + HTTP.status400 [("Content-Type", "text/plain")] + (Blaze.fromByteString "Give time as t=2..40000000\n") + blazeBody len = Conduit.RequestBodySource len + . Conduit.mapOutput Blaze.fromByteString $ requestBody + timeParam = (maybe defaultSeconds id . listToMaybe) + <$> sequence [ f v | (k, Just v) <- queryString, k == "t" ] + where + f :: ByteString -> Maybe Integer + f = (validate =<<) . (fst <$>) . listToMaybe . reads . Bytes.unpack + validate i = guard (notTooMany i) >> Just i + notTooMany i = i >= 2 && i <= 40000000 -- About 16 months + direct = any ((=="direct") . fst) queryString + +task :: Ctx -> HTTP.Method -> Resource -> Conduit.ResourceT IO (Maybe Task) +task ctx method resource = do + urls <- fromAttempt <$> resolve ctx resource + return $ case (method, resource) of + ("GET", Singular _) -> Retrieve <$> (listToMaybe =<< urls) + ("GET", Plural _) -> Listing <$> urls + ("DELETE", _) -> Remove <$> urls + ("PUT", Singular _) -> Write <$> (listToMaybe =<< urls) + _ -> Nothing + +data Task = Retrieve Text + | Listing [Text] + | Remove [Text] + | Write Text -- (Conduit.RequestBody IO) + deriving (Eq, Ord, Show) + +-- | Resources are either singular or plural in character. URLs ending ending +-- in @/@ or containing set wildcards specify plural resources; all other +-- URLs indicate singular resources. A singular resource results in a +-- redirect while a plural resource results in a newline-separated list of +-- URLs (themselves singular in character). +data Resource = Singular [Either Text Wildcard] + | Plural [Either (Either Text Wildcard) SetWildcard] + deriving (Eq, Ord, Show) + +data Ctx = Ctx { bucket :: Aws.Bucket + , aws :: Aws.Configuration + , s3 :: Aws.S3Configuration Aws.NormalQuery + , manager :: Conduit.Manager } +instance Show Ctx where + show Ctx{..} = mconcat [ "Ctx { bucket=", show bucket + , ", aws=..., s3=", show s3, " }" ] + +data Order = ASCII | SemVer deriving (Eq, Ord, Show) +data Wildcard = Hi Order | Lo Order deriving (Eq, Ord, Show) +data SetWildcard = Include Word Wildcard | Exclude Word Wildcard + deriving (Eq, Ord, Show) + +-- | Interpret a request URL as a resource, expanding wildcards as needed. By +-- default, wildcards are expanded with @\@@ as the meta-character (@\@hi@, +-- @\@lo.semver5@) but the meta-character can be changed with a query +-- parameter so we pass the whole request here. +-- +-- The meta-character is in leading position in wildcard path components and +-- escapes itself in leading position, in a simple way: leading runs are +-- shortened by one character. Some examples of path components and their +-- interpretation are helpful: +-- +-- > hi -> The string "hi". +-- > @hi -> The hi.semver wildcard. +-- > @@hi -> The string "@hi". +-- > @@@hi -> The string "@@hi". +-- > ...and so on... +-- +-- Sending @meta=_@ as a query parameter changes the meta-character to an +-- underscore. The meta-character may be any single character; empty or +-- overlong @meta@ parameters are ignored. +resource :: WWW.Request -> Resource +resource WWW.Request{..} = url metaChar pathInfo + where + metaParams = [ b | Just (b, _) <- culled ] :: [Char] + where culled = [ Bytes.uncons v | (k, Just v) <- queryString, k == "meta" ] + metaChar = List.head (metaParams ++ ['@']) + +url :: Char -> [Text] -> Resource +url _ [] = Plural [] +url meta texts | singular = Singular (lefts components) + | otherwise = Plural components + where + (empty, full) = List.break (/= "") . List.reverse $ texts + empty' = if empty /= [] then [""] else [] + components = parse <$> List.reverse (empty' ++ full) + singular = empty == [] && rights components == [] + -- Parser is total but just to be on the safe side... + parse t = either (const . Left . Left $ t) id + (Atto.parseOnly (component meta) t) + +-- | Parse a single path component. +component :: Char -> Parser (Either (Either Text Wildcard) SetWildcard) +component meta = eitherRotate <$> Atto.eitherP + (Atto.eitherP (setWildcard meta) (wildcard meta) <* Atto.endOfInput) + (plain meta) + where + eitherRotate :: Either (Either SetWildcard Wildcard) Text + -> Either (Either Text Wildcard) SetWildcard + eitherRotate (Left (Right wc)) = Left (Right wc) + eitherRotate (Left (Left set)) = Right set + eitherRotate (Right text) = Left (Left text) + +-- | Parse a plain string, shrinking leading runs of the metacharacter by one. +plain :: Char -> Parser Text +plain c = mappend <$> (Text.drop 1 <$> Atto.takeWhile (== c)) <*> Atto.takeText + +-- | Match a simple, singular wildcard. +wildcard :: Char -> Parser Wildcard +wildcard meta = Atto.char meta *> Atto.choice matchers + where + matcher (t, w) = Atto.string t *> pure w + matchers = matcher <$> wildcards + +-- | Match a wildcard set, ending with a count (if it is inclusive) or an +-- optional count and a final tilde (if it is exclusive). +setWildcard :: Char -> Parser SetWildcard +setWildcard meta = star meta <|> wildcard meta <**> (exclude <|> include) + where + include = Include <$> Atto.decimal + exclude = Exclude <$> Atto.option 1 Atto.decimal <* Atto.char '~' + +star :: Char -> Parser SetWildcard +star meta = Atto.char meta *> Atto.char '*' + *> (Exclude 0 . Lo <$> Atto.option SemVer ordering) + where + ordering :: Parser Order + ordering = (Atto.string ".ascii" *> pure ASCII) + <|> (Atto.string ".semver" *> pure SemVer) + +-- | Wildcards and their textual representations. +wildcards :: [(Text, Wildcard)] +wildcards = [( "hi.ascii", Hi ASCII) ,( "lo.ascii", Lo ASCII) + ,("hi.semver", Hi SemVer) ,("lo.semver", Lo SemVer) + ,( "hi", Hi SemVer) ,( "lo", Lo SemVer)] +-- The order of these matters when they are translated to alternative +-- Attoparsec parsers, which is unfortunate and seemingly contrary to the +-- documentation. In lieu of left-factoring, we put the longer prefixes last. + + +-- | Translate a resource in to a listing of objects. While intermediate S3 +-- prefixes (directories) are traversed, the final match is always on keys +-- for objects. +resolve :: Ctx -> Resource -> Conduit.ResourceT IO (Attempt [Text]) +resolve Ctx{..} res = case res of + Plural [ ] -> (fst <$>) <$> listing Ctx{..} "" + Plural components -> resolve' "" (simplify <$> components) + Singular components -> resolve' "" (pluralize <$> components) + where + pluralize :: Either Text Wildcard -> Either Text SetWildcard + pluralize = either Left (Right . Include 1) + simplify :: Either (Either Text Wildcard) SetWildcard + -> Either Text SetWildcard + simplify = either pluralize Right + resolve' prefix [ ] = return (Success [prefix]) + resolve' prefix (h:t) = case h of + Left "" -> (fst <$>) <$> listing Ctx{..} prefix + Left text -> resolve' (prefix -/- text) t + Right set -> do + attempt <- listing Ctx{..} prefix + case names <$> attempt of + Success texts -> (List.concat <$>) . sequence <$> mapM recurse texts + Failure e -> return (Failure e) + where + recurse text = resolve' text t + names (objects, prefixes) = expand set $ case t of [ ] -> objects + _:_ -> prefixes + +listing :: Ctx -> Text -> Conduit.ResourceT IO (Attempt ([Text],[Text])) +listing Ctx{..} prefix = + ((concat *** concat) . unzip <$>) <$> listing' Nothing [] + where + listing' mark acc = do + Aws.Response _meta attempt <- Aws.aws aws s3 manager gb{Aws.gbMarker=mark} + case attempt of + Success Aws.GetBucketResponse{..} -> do + let (keys, pres) = (Aws.objectKey <$> gbrContents, gbrCommonPrefixes) + if length keys < 1000 -- TODO: Use truncation flag. + then (return . Success . reverse) ((keys, pres):acc) + else listing' (Just (last keys)) ((keys, pres):acc) + Failure e -> return (Failure e) + gb = Aws.GetBucket { Aws.gbBucket = bucket + , Aws.gbPrefix = Just (prefix -/- "") + , Aws.gbDelimiter = Just "/" + , Aws.gbMaxKeys = Just 1000 -- The Amazon maximum. + , Aws.gbMarker = Nothing } + +expand :: SetWildcard -> [Text] -> [Text] +expand set texts + | complement && count == 0 = ordered texts -- Special case for "all" wilcard. + | complement = complemented matching + | otherwise = matching + where + matching = (selected . ordered) texts + uniq = Set.fromList texts + complemented = ordered . Set.toList . Set.difference uniq . Set.fromList + (count, wc, complement) = case set of + Include count wc -> (fromIntegral count, wc, False) + Exclude count wc -> (fromIntegral count, wc, True) + (ordered, selected) = case wc of + Hi o -> (order o, List.reverse . List.take count . List.reverse) + Lo o -> (order o, List.take count) + +a -/- b | a == "" = mappend a b + | "/" `Text.isSuffixOf` a = mappend a b + | otherwise = mconcat [a, "/", b] + +-- | Split a URL into components, placing the balance of slashes in a slash +-- run to the left of the last slash. This is what all the Amazon APIs -- +-- including the HTTP interface -- seem to expect, based on experiment. +-- This function exists so that we can split a URL retrieved from S3, by way +-- of list bucket, for example, into pieces for later escaping. +s3Pieces :: Text -> [Text] +s3Pieces text = reverse . uncurry (:) $ List.foldl' f (leading', []) rest' + where + (leading, rest) = List.span (=="") (Text.split (=='/') text) + leading'' = Text.pack [ '/' | _ <- leading ] + (leading', rest') | h:t <- rest = (mappend leading'' h, t) + | otherwise = (leading'', []) + f (piece, pieces) "" = (piece `Text.snoc` '/', pieces) + f (piece, pieces) s = (s, piece:pieces) + +-- | Encode an S3 path to a URL, splitting on slashes but preserving slash +-- runs as appropriate. +s3Encode :: Text -> Blaze.Builder +s3Encode = HTTP.encodePathSegmentsRelative . s3Pieces + +plusNL :: Blaze.Builder -> Blaze.Builder +plusNL = (`mappend` Blaze.fromChar '\n') + +order :: Order -> [Text] -> [Text] +order ASCII = id -- Amazon returns them sorted anyways... +order SemVer = List.sortBy (comparing textSemVer) + +textSemVer :: Text -> [Integer] +textSemVer = (fst <$>) . rights . (Text.decimal <$>) . digitalPieces + where + digitalPieces = List.filter (/= "") . Text.split (not . isDigit) + diff --git a/Aws/SSSP/App.hs b/Aws/SSSP/App.hs new file mode 100644 --- /dev/null +++ b/Aws/SSSP/App.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings + #-} +module Aws.SSSP.App where + +import Control.Applicative +import qualified Data.ByteString.Char8 as Bytes +import Data.Monoid +import System.Environment +import System.Exit +import System.IO + +import qualified Network.Wai.Handler.Warp as WWW +import qualified Network.Wai.Middleware.RequestLogger as WWW + +import Aws.SSSP.Configuration +import Aws.SSSP + + +app = args =<< getArgs + +args [ ] = web +args ["web"] = web +args args = argumentError args + +web = do + res <- conf + case res of Left map -> err (misconfigured map) + Right (ctx, www) -> WWW.runSettings www (WWW.logStdout (wai ctx)) + where + misconfigured map = mappend "!!! Misconfigured for web; please check:\n" + (render map) + +argumentError args = (err . Bytes.unlines) + ("Not able to interpret these command line arguments:" : (fmt <$> args)) + where + fmt = (mappend " ") . Bytes.pack + +msg s = Bytes.hPutStrLn stderr s +err s = msg s >> exitFailure + diff --git a/Aws/SSSP/Configuration.hs b/Aws/SSSP/Configuration.hs new file mode 100644 --- /dev/null +++ b/Aws/SSSP/Configuration.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE OverloadedStrings + , TupleSections #-} +-- | Utilities for determining the server configuration from environment +-- variables and file input. +module Aws.SSSP.Configuration where + +import Control.Applicative +import Control.Exception +import Control.Monad +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as Bytes +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe +import Data.Monoid +import System.Environment +import System.IO +import System.IO.Error + +import qualified Aws as Aws +import qualified Aws.S3 as Aws +import Data.Attoparsec.Char8 +import qualified Data.Conduit.Network as Conduit +import Data.Default +import qualified Data.Text.Encoding as Text +import qualified Data.Text.Encoding.Error as Text +import qualified Network.HTTP.Conduit as Conduit +import qualified Network.Wai.Handler.Warp as WWW + +import Aws.SSSP (Ctx(..)) + + +variables = [ "AWS_ACCESS_KEY", "AWS_SECRET_KEY", + "AWS_ACCESS_KEY_ID", "AWS_SECRET_ACCESS_KEY", + "AWS_REGION", "SSSP_BUCKET", "SSSP_CONN", "PORT" ] + +fromEnv :: IO (Map ByteString ByteString) +fromEnv = Map.fromList . catMaybes <$> mapM paired variables + where + paired k = ((k,) <$>) <$> maybeGetEnv k + +maybeGetEnv :: ByteString -> IO (Maybe ByteString) +maybeGetEnv k = catchJust ((>> Just ()) . guard . isDoesNotExistError) + (Just . Bytes.pack <$> (getEnv . Bytes.unpack $ k)) + (const (return Nothing)) + +fromBytes :: ByteString -> Map ByteString ByteString +fromBytes bytes = Map.fromList + [ (k, v) | Right (k, v) <- parseOnly line <$> Bytes.lines bytes ] + +-- | Recognizes a parseable @k = v@ or @k: v@ style line. It's relatively +-- flexible on input but rejects lines that might have shell interpolations +-- in them -- lines containing one of @$`{}@ -- as well as lines with shell +-- quotes (@'\"@). This allows the file input parser to skip over such values +-- when a raw rc file is loaded. +line :: Parser (ByteString, ByteString) +line = optional (string "export") *> skipSpace *> do + (,) <$> choice (string <$> variables) <*> (copula *> chopped) + where + copula = skipWhile (==' ') *> (char '=' <|> char ':') <* skipWhile (==' ') + chopped = simple =<< fst . Bytes.spanEnd isSpace + <$> takeWhile1 (notInClass "\n\r") + simple s = guard (and [ Bytes.notElem c s | c <- "${}`\"'" ]) >> return s + +fromEnvAndSTDIN = do + env <- fromEnv + prune <$> do go <- checkForInput + if go then (`Map.union` env) . fromBytes <$> Bytes.getContents + else return env + where + checkForInput = catchJust ((>> Just ()) . guard . isEOFError) + (hReady stdin) + (const (return False)) + + +conf :: IO (Either (Map ByteString ByteString) (Ctx, WWW.Settings)) +conf = do + map <- fromEnvAndSTDIN + ctx' <- createCtx map + return $ maybe (Left map) Right ((,) <$> ctx' <*> createSettings map) + +createSettings :: Map ByteString ByteString -> Maybe WWW.Settings +createSettings map = do + (host,port) <- (splitConn =<< read "SSSP_CONN") <|> + ("127.0.0.1",) <$> (read "PORT" <|> Just "8000") + host <- parseHost host + port <- parsePort port + Just WWW.defaultSettings{WWW.settingsPort=port,WWW.settingsHost=host} + where + read k = Map.lookup k map + splitConn bs = case Bytes.split ':' bs of [host,port] -> Just (host, port) + _ -> Nothing + parsePort :: ByteString -> Maybe Int + parsePort = (fst <$>) . listToMaybe . reads . Bytes.unpack + parseHost :: ByteString -> Maybe Conduit.HostPreference + parseHost "*" = Just Conduit.HostAny + parseHost "*4" = Just Conduit.HostIPv4 + parseHost "*6" = Just Conduit.HostIPv6 + parseHost bs = Just (Conduit.Host (Bytes.unpack bs)) + +createCtx :: Map ByteString ByteString -> IO (Maybe Ctx) +createCtx map = do + manager <- Conduit.newManager def + return $ do + aws <- aws <$> (read "AWS_ACCESS_KEY" <|> read "AWS_ACCESS_KEY_ID") + <*> (read "AWS_SECRET_KEY" <|> read "AWS_SECRET_ACCESS_KEY") + s3 <- s3Configured <|> Just defS3 + bucket <- utf8 <$> read "SSSP_BUCKET" + Just Ctx{bucket=bucket, aws=aws, s3=s3{Aws.s3UseUri=True}, manager=manager} + where + read k = Map.lookup k map + aws id key = Aws.Configuration { Aws.timeInfo = Aws.Timestamp + , Aws.credentials = Aws.Credentials id key + , Aws.logger = Aws.defaultLog Aws.Warning } + s3Configured :: Maybe (Aws.S3Configuration Aws.NormalQuery) + s3Configured = do region <- read "AWS_REGION" + url <- endpoint region + Just defS3{Aws.s3Endpoint=url} + utf8 = Text.decodeUtf8With Text.lenientDecode + defS3 = Aws.defServiceConfig :: Aws.S3Configuration Aws.NormalQuery + +validate :: ByteString -> ByteString -> Maybe ByteString +validate "AWS_REGION" r = endpoint r +validate _ s = guard (s /= "") >> Just s + +prune :: Map ByteString ByteString -> Map ByteString ByteString +prune = Map.mapMaybeWithKey validate + +-- | Interpret a region name, like @us-west-1@, in accord with the Amazon's +-- documentation for endpoint lcoations. +-- +endpoint :: ByteString -> Maybe ByteString +endpoint "classic" = Just "s3.amazonaws.com" +endpoint "us-east-1" = Just "s3.amazonaws.com" +endpoint "us-west-2" = Just "s3-us-west-2.amazonaws.com" +endpoint "us-west-1" = Just "s3-us-west-1.amazonaws.com" +endpoint "eu-west-1" = Just "s3-eu-west-1.amazonaws.com" +endpoint "ap-southeast-1" = Just "s3-ap-southeast-1.amazonaws.com" +endpoint "ap-northeast-1" = Just "s3-ap-northeast-1.amazonaws.com" +endpoint "sa-east-1" = Just "s3-sa-east-1.amazonaws.com" +endpoint _ = Nothing + +render :: Map ByteString ByteString -> ByteString +render = Bytes.unlines . (kv <$>) . Map.toAscList + where + kv (k, v) = mconcat [k, ": ", v] + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ + + ©2012 Airbnb, Inc. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + . Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + . Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + + . Names of the contributors to this software may not be used to endorse or + promote products derived from this software without specific prior written + permission. + + This software is provided by the contributors "as is" and any express or + implied warranties, including, but not limited to, the implied warranties of + merchantability and fitness for a particular purpose are disclaimed. In no + event shall the contributors be liable for any direct, indirect, incidental, + special, exemplary, or consequential damages (including, but not limited to, + procurement of substitute goods or services; loss of use, data, or profits; + or business interruption) however caused and on any theory of liability, + whether in contract, strict liability, or tort (including negligence or + otherwise) arising in any way out of the use of this software, even if + advised of the possibility of such damage. + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,133 @@ +SYNOPSIS + sssp web? + +DESCRIPTION + SSSP is an HTTP proxy for S3 that can generate short-lived, signed URLs + for stored objects. By providing a server separate from S3 that can be + placed behind an authenticating proxy or firewall, SSSP allows a vari- + ety of common security mechanisms to be used to limit access to S3 + objects over HTTP while taking advantage of S3's considerable bandwidth + and parallelism. + + Use-cases for SSSP include: + + o sharing of large files within an organization, + + o media service for public facing web applications, + + o distribution of internal software. + + SSSP supports configuration via environment variables or STDIN. + +CONFIGURATION + These settings can be passed as environment variables or fed to the + server on STDIN in colon separated format. Both the new and old forms + of the AWS credential environment variables are supported. + + # AWS Settings + AWS_ACCESS_KEY = account access key + AWS_ACCESS_KEY_ID = account access key + AWS_SECRET_KEY = secret + AWS_SECRET_ACCESS_KEY = secret + AWS_REGION = eu-west-1, classic, us-east-1, ... + + # Storage settings + SSSP_BUCKET = DNS friendly bucket name + + # Server settings + SSSP_CONN = : pair + PORT = port to connect to, on localhost + + SSSP is fairly liberal when parsing STDIN. In fact, Bourne shell .rc + files, like the follow example, are parsed without error: + + export SSSP_BUCKET=dist + export SSSP_CONN=*:6000 + + However, SSSP skips over lines that contain quotes ("') or that appear + to require shell interpolation for their correct interpolation (lines + containing $`{}). + +REST INTERFACE + URLs in SSSP point to one of two objects: an item or a listing. Items + correspond to S3 objects; a GET retrieves a signed redirect to the + object. Listings are a sequence of URLs, in ascending order; a GET + retrieves the listing as a plaintext document, one URL per line. + + GET http://sssp.io/p/a/t/h # Signed for the default time (10s). + + A PUT to an item sets the item's content. DELETEs can be singular or + plural. A plural DELETE removes only the objects generated by a list- + ing. + + URLs are divided syntactically in to listings and items. A URL ending + with a slash is always a listing. + + GET http://sssp.io/dist # Signed redirect to an object called dist. + GET http://sssp.io/dist/ # Listing of items below the key `dist'. + + To make it easier to work with versioned or timestamped assets, SSSP + supports the @hi and @lo meta-paths. These correspond to the names that + sort highest and lowest according to semantic version sort, where + non-digit chars serve to delimit arrays of numbers. For common forms of + dates, these have the same effect as ASCII sort. (ASCII sort may speci- + fied, as well; please the section WILDCARDS, below.) + + GET http://sssp.io/dist/x/x-0.1.1.tgz + GET http://sssp.io/dist/x/x-0.1.4.tgz + GET http://sssp.io/dist/x/x-0.2.11.tgz + GET http://sssp.io/dist/x/x-0.2.9.tgz + + # Retrieval with @hi and @lo. + GET http://sssp.io/dist/x/@hi -307-> http://sssp.io/dist/x/x-0.2.11.tgz + GET http://sssp.io/dist/x/@lo -307-> http://sssp.io/dist/x/x-0.1.1.tgz + + Wildcards @hi and @lo used together with a count specify a set wild- + card; the result is a listing: + + GET http://sssp.io/dist/x/@lo2 -200-> dist/x/x-0.1.1.tgz + dist/x/x-0.1.4.tgz + + Counts are the natural numbers starting at 0. The wildcard @* refers to + "all the items". + + A counted wildcard, like @hi2, can be suffixed with a tilde to form its + complement -- so @hi2~ is everything but the highest two items. This + can be useful for bulk deletion of old/new things. + +WILDCARDS + @hi.semver, @lo.semver + Key with highest or lowest version, according to a liberal- + ized form of "semantic versioning", where version components + are delimited by any non-digit characters. + + @hi.ascii, @lo.ascii + Keys sorted ASCIIbetically, in the C locale (sorted purely by + byte value). + + @hi, @lo + The default sort, which is semantic version sort. + + @*, @*.semver, @*.ascii + All the items, in the default order (semantic version) or in + a specified order. + + ASCII sort can be substantially more performant than semantic version + sort, because S3 returns data in ASCII order and thus no real sorting + is necessary. + +EXAMPLES + # Start web application. + sssp < conf + + # Start web application with configuration provided by the environment. + export AWS_ACCESS_KEY_ID=... + export AWS_SECRET_ACCESS_KEY=... + sssp <= 1.10 +build-type : Simple +extra-source-files : README + , LICENSE + +source-repository head + type : git + location : http://github.com/airbnb/sssp.git + + +flag no-cli + description : Disable command line tool. + default : False + + +library + default-language : Haskell98 + build-depends : base >= 2 && <= 5 + , bytestring >= 0.9 + , containers + , attempt >= 0.4 + , attoparsec >= 0.10 + , aws >= 0.7 && < 0.8 + , blaze-builder >= 0.3 + , case-insensitive >= 0.4 + , conduit >= 0.5 + , data-default >= 0.4 + , http-conduit >= 1.5 + , http-types >= 0.6 + , mtl >= 2 + , network-conduit >= 0.5 + , text >= 0.11 + , wai >= 1.3 + , wai-extra >= 1.3 + , warp >= 1.3 + + exposed-modules : Aws.SSSP + Aws.SSSP.App + Aws.SSSP.Configuration + default-extensions : OverloadedStrings + ParallelListComp + PatternGuards + RecordWildCards + StandaloneDeriving + TupleSections + + +executable sssp + default-language : Haskell98 + main-is : sssp.hs + if flag(no-cli) + buildable : False + else + buildable : True + + build-depends : base >= 2 && <= 5 + , bytestring >= 0.9 + , containers + , attempt >= 0.4 + , attoparsec >= 0.10 + , aws >= 0.7 && < 0.8 + , blaze-builder >= 0.3 + , case-insensitive >= 0.4 + , conduit >= 0.5 + , data-default >= 0.4 + , http-conduit >= 1.5 + , http-types >= 0.6 + , mtl >= 2 + , network-conduit >= 0.5 + , text >= 0.11 + , wai >= 1.3 + , wai-extra >= 1.3 + , warp >= 1.3 + default-extensions : OverloadedStrings + ParallelListComp + PatternGuards + RecordWildCards + StandaloneDeriving + TupleSections diff --git a/sssp.hs b/sssp.hs new file mode 100644 --- /dev/null +++ b/sssp.hs @@ -0,0 +1,7 @@ +#!/usr/bin/env runhaskell +{-# LANGUAGE OverloadedStrings + #-} +import Aws.SSSP.App + +main = web +