Skip to content

Instantly share code, notes, and snippets.

@wunki
Created August 6, 2013 19:12
Show Gist options
  • Save wunki/6167617 to your computer and use it in GitHub Desktop.
Save wunki/6167617 to your computer and use it in GitHub Desktop.
Pinki, first working draft.
{-# LANGUAGE OverloadedStrings #-}
{-
Pinki is a command line tool which helps you share files on S3 by
creating a static HTML page which is uploaded together with the file.
You could say it's Hakyll for file sharing.
-}
module Main where
import Control.Monad (forM)
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Configurator as C
import Data.Maybe (fromJust)
import Data.Monoid (mempty)
import Data.UUID.V4 (nextRandom)
import Graphics.Thumbnail (Thumbnail (lbs), mkThumbnail')
import Magic
import Network.AWS.AWSConnection (amazonS3Connection)
import Network.AWS.S3Object (S3Object (..), sendObject)
import Options.Applicative
import System.Posix.Files (fileExist)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes (href)
import Text.Blaze.Internal (stringValue)
-- Data types
data PinkiCmd = PinkiCmd { file :: String } deriving (Show)
type Key = String
data AWSCredentials = AWSCredentials { accessKey :: Maybe String
, secretKey :: Maybe String
, bucket :: Maybe String
} deriving (Show)
{-- TODO
data S3Upload = S3Upload { filename :: String
, mimeType :: String
, size :: String
, body :: L.ByteString
, uuid :: String
} deriving (Show)
--}
uploadFileS3 :: AWSCredentials -> Key -> String -> L.ByteString -> IO Bool
uploadFileS3 acc key mime file = do
let awsConnection = amazonS3Connection (fromJust $ accessKey acc) (fromJust $ secretKey acc)
let filesize = show $ L.length file
let object = S3Object (fromJust $ bucket acc) key mime [("Content-Length", filesize)] file
sendObject awsConnection object
return True
-- Generates the static HTML for this file.
-- This HTML file can be shared with others.
generateHtml :: String -> H.Html
generateHtml uuid = H.docTypeHtml $ do
H.head $ do
H.title "Pinki"
H.body $ do
H.p "You can download the file here:"
H.a ! href (stringValue uuid) $ "Download"
main :: IO ()
main = do
cmd <- execParser opts
-- Get the configuration values
-- TODO: Fail when one of these values is `Nothing`
cfg <- C.load [ C.Required "pinki.cfg" ]
[awsAccessKey, awsSecretKey, awsS3Bucket] <- forM ["s3.aws-access-key-id", "s3.aws-secret-access-key", "s3.bucket"] (\a -> C.lookup cfg a :: IO (Maybe String))
let awsCredentials = AWSCredentials awsAccessKey awsSecretKey awsS3Bucket
fileExists <- fileExist $ file cmd
case fileExists of
False -> error "Couldn't find the file you were trying to upload."
True -> do
let filename = file cmd
-- Generate unique UUID.
uuid <- show <$> nextRandom
-- Get mime-type
magic <- magicOpen [MagicMime]
magicLoadDefault magic
mime <- magicFile magic filename
-- Upload HTML
let html = renderHtml $ generateHtml uuid
key = uuid ++ ".html"
uploadFileS3 awsCredentials key "text/html" html
-- Upload file
f <- L.readFile filename
thumbnail <- mkThumbnail' ((100, 100), (400, 400)) f
case thumbnail of
Left _ -> error "Couldn't generate thumbnail from file."
Right t -> uploadFileS3 awsCredentials (uuid ++ "-thumb") mime (lbs t)
uploadFileS3 awsCredentials uuid mime f
putStrLn $ "Shared at: " ++ uuid
where
parser = PinkiCmd <$> argument str (metavar "FILE")
opts = info parser mempty
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment