Pinki, first working draft.

Main.hs

{-# 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