yesod-transloadit (empty) → 0.1.0.0
raw patch · 5 files changed
+364/−0 lines, 5 filesdep +aesondep +basedep +byteablesetup-changed
Dependencies added: aeson, base, byteable, bytestring, cryptohash, hspec, lens, lens-aeson, old-locale, shakespeare, text, time, transformers, yesod, yesod-core, yesod-form, yesod-test, yesod-transloadit
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- src/Yesod/Transloadit.hs +208/−0
- test/Tests.hs +78/−0
- yesod-transloadit.cabal +56/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Bob Long++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Yesod/Transloadit.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++module Yesod.Transloadit (+ YesodTransloadit(..),+ mkParams,+ transloadIt,+ handleTransloadit,+ tokenText,+ extractFirstResult,+ ParamsResult,+ ParamsError(..),+ Key(..),+ Template(..),+ Secret(..),+ TransloaditParams,+ Signature+ ) where++import Control.Applicative+import Control.Lens.Operators hiding ((.=))+import Control.Monad (mzero)+import Crypto.Hash+import Data.Aeson+import Data.Aeson.Encode (encodeToTextBuilder)+import Data.Aeson.Lens hiding (key)+import qualified Data.Aeson.Lens as AL+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import Data.Maybe+import Data.Monoid+import Data.Text+import qualified Data.Text.Lazy as TL+import Data.Text.Lazy.Builder (toLazyText)+import Data.Time+import System.Locale+import Text.Julius+import Yesod hiding (Key)+import Yesod.Form.Jquery (YesodJquery (..))++-- | Typeclass for your website to enable using Transloadit.+class YesodTransloadit master where+ -- | Override the 'transloaditRoot' to point at a different base Javascript directory.+ -- The default settings will load assets from assets.transloadit.com.+ transloaditRoot :: master -> Text+ transloaditRoot _ = "https://assets.transloadit.com/js/"+ {-# MINIMAL #-}++newtype Secret = Secret { secret :: BS.ByteString } deriving (Eq, Show)+newtype Key = Key { key :: Text } deriving (Eq, Show)+newtype Template = Template { template :: Text } deriving (Eq, Show)++data TransloaditParams = TransloaditParams {+ authExpires :: UTCTime,+ transloaditKey :: Key,+ transloaditTemplate :: Template,+ formIdent :: Text,+ transloaditSecret :: Secret+} deriving (Show)++data ParamsError = UnknownError+type ParamsResult = Either ParamsError TransloaditParams++-- | Smart constructor for Transloadit params+mkParams :: UTCTime -- ^ When the Transloadit signature should expire+ -> Key -- ^ Transloadit key+ -> Template -- ^ The Template to use in Transloadit+ -> Text -- ^ The id of the form to attach to+ -> Secret -- ^ Transloadit Secret+ -> ParamsResult+mkParams u k t f s = return (TransloaditParams u k t f s)++data TransloaditResponse = TransloaditResponse { raw :: Text, token :: Text } deriving (Show)++data Upload = Upload Text deriving (Show)+instance FromJSON Upload where+ parseJSON (Object o) = Upload <$> (o .: "ssl_url")+ parseJSON _ = mzero++formatExpiryTime :: UTCTime -> Text+formatExpiryTime = pack . formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S+00:00"++instance ToJSON TransloaditParams where+ toJSON (TransloaditParams a (Key k) (Template t) _ _) = object [+ "auth" .= object [+ "key" .= k,+ "expires" .= (formatExpiryTime a)+ ],+ "template_id" .= t+ ]++-- http://www.yesodweb.com/blog/2012/10/jqplot-widget+encodeText :: ToJSON a => a -> TL.Text+encodeText = toLazyText . encodeToTextBuilder . toJSON++type Signature = Text++sign :: TransloaditParams -> Signature+sign cfg = (pack . show . hmacGetDigest) h+ where h :: HMAC SHA1+ h = hmac (s cfg) ((BSL.toStrict . encode) cfg)+ s (transloaditSecret -> Secret s') = s'++-- | Calculate the signature, and embed Javascript to attach Transloadit to the form.+transloadIt :: (YesodJquery m, YesodTransloadit m) => TransloaditParams -> WidgetT m IO Signature+transloadIt t@(TransloaditParams {..}) = do+ master <- getYesod+ let root = transloaditRoot master+ signature = sign t+ addScriptEither $ urlJqueryJs master+ addScriptRemote $ root <> "jquery.transloadit2-v2-latest.js"+ toWidget [julius|+ $(function() {+ $('##{rawJS formIdent}').transloadit({+ wait : true,+ params : JSON.parse('#{(rawJS . encodeText) t}')+ });+ });+ |]+ return signature++-- | Helper method to grab the current CSRF token from the session. Returns 'mempty' if 'Nothing'+-- could be found.+tokenText :: (YesodJquery m, YesodTransloadit m) => WidgetT m IO Text+tokenText = do+ csrfToken <- fmap reqToken getRequest+ return $ fromMaybe mempty csrfToken++-- | Helper method to pull the Transloadit response and the CSRF token (named @_token@) from the request.+handleTransloadit :: (RenderMessage m FormMessage, YesodJquery m, YesodTransloadit m) => WidgetT m IO (Maybe Text)+handleTransloadit = do+ d <- runInputPost $ TransloaditResponse <$> ireq hiddenField "transloadit"+ <*> ireq hiddenField "_token"++ t <- tokenText++ return $ case (token d == t) of+ True -> return $ raw d+ _ -> Nothing++-- | Helper method to pull the first @ssl_url@ from the Transloadit response.+extractFirstResult :: AsValue s => Text -> Maybe s -> Maybe Value+extractFirstResult _ Nothing = Nothing+extractFirstResult k (Just uploads) = uploads ^? AL.key "results" . AL.key k . nth 0 . AL.key "ssl_url"++{-+-- Example web service demonstrating usage of the transloadIt widget++data Test = Test+mkYesod "Test" [parseRoutes| / HomeR GET POST |]++instance Yesod Test+instance YesodJquery Test+instance YesodTransloadit Test++instance RenderMessage Test FormMessage where+ renderMessage _ _ = defaultFormMessage+++getHomeR :: Handler Html+getHomeR = defaultLayout $ do+ now <- liftIO getCurrentTime++ -- Create an id for your form+ ident <- newIdent++ -- Create some Transloadit params, you need: Expiry time; Api key; Template Id; Form id+ let expiry = addUTCTime 3600 now+ key = Key "my_key"+ template = Template "my_template"+ secret = Secret "my_secret"+ params = TransloaditParams expiry key template ident secret++ -- Load the widget, and retrieve the given signature+ sig <- transloadIt params++ -- CSRF considerations+ t <- tokenText++ -- Create a form+ [whamlet|+ <form id="#{ident}" action=@{HomeR} method="POST">+ <input type="hidden" name="_token" value="#{t}">+ <input type="hidden" name="signature" value="#{sig}">+ <input type="file" name="my_file">+ <input type="submit" value="Upload">+ |]+ return ()++postHomeR :: Handler Html+postHomeR = defaultLayout $ do+ results <- handleTransloadit++ -- my_template contains a step called "cropped_thumb"+ case extractFirstResult "cropped_thumb" results of+ Just (String url) -> [whamlet| <img src="#{url}"/> |]+ _ -> [whamlet| No results :( |]++ return ()++exampleServer = warp 4567 Test+-}
+ test/Tests.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Main where++import Data.Text+import Data.Time+import System.Locale+import Test.Hspec+import Yesod hiding (Key, get)+import Yesod.Form.Jquery (YesodJquery (..))+import Yesod.Test+import Yesod.Transloadit++data Test = Test+mkYesod "Test" [parseRoutes| / HomeR GET |]++instance Yesod Test+instance YesodJquery Test+instance YesodTransloadit Test++instance RenderMessage Test FormMessage where+ renderMessage _ _ = defaultFormMessage++getHomeR :: Handler Html+getHomeR = defaultLayout $ do+ let now = UTCTime (ModifiedJulianDay 50000) (secondsToDiffTime 10)++ -- Create an id for your form+ ident <- newIdent++ -- Create some Transloadit params, you need: Expiry time; Api key; Template Id; Form id+ let expiry = addUTCTime 3600 now+ key = Key "my_key"+ template = Template "my_template"+ secret = Secret "my_secret"+ params = mkParams expiry key template ident secret++ -- Load the widget, and retrieve the given signature+ sig <- either (const $ error "nooo") transloadIt params++ -- CSRF considerations+ t <- tokenText++ -- Create a form+ [whamlet|+ <form id="#{ident}" action=@{HomeR} method="POST">+ <input type="hidden" name="_token" value="#{t}">+ <input type="hidden" name="signature" value="#{sig}">+ <input type="file" name="my_file">+ <input type="submit" value="Upload">+ |]+ return ()++formGenSpecs :: Spec+formGenSpecs = yesodSpec Test $ do+ ydescribe "Form generation" $ do+ yit "adds correct Transloadit params" $ do+ get HomeR+ bodyContains "params : JSON.parse('{\"auth\":{\"expires\":\"1995/10/10 01:00:10+00:00\",\"key\":\"my_key\"},\"template_id\":\"my_template\"}')"+ yit "computes the correct signature" $ do+ get HomeR+ bodyContains "<input type=\"hidden\" name=\"signature\" value=\"ad2784ec20c0f2d486125141409763ea603e1a10\">"+ yit "adds JQuery" $ do+ get HomeR+ bodyContains "<script src=\"//ajax.googleapis.com/ajax/libs/jquery/1.7/jquery.min.js\"></script>"+ yit "adds Transloadit" $ do+ get HomeR+ bodyContains "<script src=\"https://assets.transloadit.com/js/jquery.transloadit2-v2-latest.js\"></script>"+ ydescribe "Response parsing" $ do+ yit "works" $ do+ let sample = Just "{\"results\":{\"foo\":[{\"ssl_url\":\"bar\"}]}}" :: Maybe Text+ assertEqual "Basic example" (extractFirstResult "foo" sample) (Just (String "bar"))++main = hspec formGenSpecs
+ yesod-transloadit.cabal view
@@ -0,0 +1,56 @@+name: yesod-transloadit+version: 0.1.0.0+synopsis: Transloadit support for Yesod+description: Drop in Transloadit capabilites for Yesod web apps+license: MIT+license-file: LICENSE+author: Bob Long+maintainer: robertjflong@gmail.com+-- copyright:+category: Web+build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/bobjflong/yesod-transloadit.git++library+ exposed-modules: Yesod.Transloadit+ ghc-options: -Wall+ build-depends: base < 5+ , aeson+ , text+ , time+ , old-locale+ , cryptohash+ , bytestring+ , byteable+ , yesod+ , yesod-form+ , yesod-core+ , transformers+ , lens+ , shakespeare+ , lens-aeson++ hs-source-dirs: src+ default-language: Haskell2010++test-suite tests+ ghc-options: -Wall+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ hs-source-dirs: test++ build-depends: base,+ yesod-transloadit,+ yesod-test,+ hspec,+ yesod,+ yesod-form,+ time,+ old-locale,+ text++ default-language: Haskell2010