yesod-transloadit 0.2.0.0 → 0.2.1.0

raw patch · 3 files changed

+79/−81 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Yesod/Transloadit.hs +31/−80
• src/Yesod/Transloadit/OrderedJSON.hs +46/−0
• yesod-transloadit.cabal +2/−1

@@ -1,9 +1,9 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE QuasiQuotes           #-} {-# LANGUAGE RecordWildCards       #-}-{-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE ViewPatterns          #-} @@ -14,6 +14,7 @@     handleTransloadit,     tokenText,     extractFirstResult,+    extractNthResult,     ParamsResult,     ParamsError(..),     Key(..),@@ -23,21 +24,28 @@     Signature   ) where -import           Control.Lens.Operators hiding ((.=))-import           Control.Monad          (mzero)+import           Control.Applicative+import           Control.Lens.Operators        hiding ((.=))+import           Control.Monad                 (mzero) import           Crypto.Hash import           Data.Aeson-import           Data.Aeson.Lens        hiding (key)-import qualified Data.Aeson.Lens        as AL-import qualified Data.ByteString        as BS+import           Data.Aeson.Lens               hiding (key)+import qualified Data.Aeson.Lens               as AL+import qualified Data.ByteString               as BS import           Data.Maybe import           Data.Monoid import           Data.Text import           Data.Text.Encoding import           Data.Time import           Text.Julius-import           Yesod                  hiding (Key)-import           Yesod.Form.Jquery      (YesodJquery (..))+import           Yesod                         hiding (Key)+import           Yesod.Form.Jquery             (YesodJquery (..))+import           Yesod.Transloadit.OrderedJSON hiding (encode)+import qualified Yesod.Transloadit.OrderedJSON as OJ+#if MIN_VERSION_time(1,5,0)+#else+import           System.Locale                 (defaultTimeLocale)+#endif  -- | Typeclass for your website to enable using Transloadit. class YesodTransloadit master where@@ -73,11 +81,6 @@  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" @@ -85,7 +88,7 @@   toJSON (TransloaditParams a (Key k) (Template t) _ _) = object [       "auth" .= object [         "key" .= k,-        "expires" .= (formatExpiryTime a)+        "expires" .= formatExpiryTime a       ],       "template_id" .= t     ]@@ -93,10 +96,14 @@ -- encodeParams is similar to the exported ToJSON instance, except that it gives us the same order -- output of keys each time. This is very useful for testing that signatures are correct. encodeParams :: TransloaditParams -> Text-encodeParams (TransloaditParams a (Key k) (Template t) _ _) = mconcat [-  "{\"auth\":{\"expires\":\"", (formatExpiryTime a),-  "\",\"key\":\"", k, "\"},",-  "\"template_id\":\"", t, "\"}"]+encodeParams (TransloaditParams a (Key k) (Template t) _ _) = OJ.encode params+  where params = obj [+                   "auth" `is` obj [+                                 "expires" `is` str (formatExpiryTime a),+                                 "key" `is` str k+                               ],+                   "template_id" `is` str t+                 ]  type Signature = Text @@ -136,72 +143,16 @@ handleTransloadit = do   d <- runInputPost $ TransloaditResponse <$> ireq hiddenField "transloadit"                                           <*> ireq hiddenField "_token"-   t <- tokenText--  return $ case (token d == t) of+  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 ()+extractFirstResult = extractNthResult 0 -exampleServer = warp 4567 Test--}+-- | Helper method to pull the nth @ssl_url@ from the Transloadit response.+extractNthResult :: AsValue s => Int -> Text -> Maybe s -> Maybe Value+extractNthResult _ _ Nothing = Nothing+extractNthResult i k (Just uploads) = uploads ^? AL.key "results" . AL.key k . nth i . AL.key "ssl_url"

@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module Yesod.Transloadit.OrderedJSON (+    encode,+    is,+    obj,+    str+  ) where++import           Data.Text+import           Data.Monoid (mconcat)++type KeyValue = (Text, OrderedValue)++data OrderedValue = Object [KeyValue] | String Text deriving (Eq, Show)++quote :: Text+quote = "\""++lbrace :: Text+lbrace = "{"++rbrace :: Text+rbrace = "}"++colon :: Text+colon = ":"++comma :: Text+comma = ","++encodeKV :: KeyValue -> Text+encodeKV (t, v) = mconcat [quote, t, quote, colon, encode v]++encode :: OrderedValue -> Text+encode (String t) = mconcat [quote, t, quote]+encode (Object kvs) = mconcat [lbrace, intercalate comma $ fmap encodeKV kvs, rbrace]++is :: Text -> OrderedValue -> KeyValue+is = (,)++obj :: [KeyValue] -> OrderedValue+obj = Object++str :: Text -> OrderedValue+str = String

@@ -1,5 +1,5 @@ name:                yesod-transloadit-version:             0.2.0.0+version:             0.2.1.0 synopsis:            Transloadit support for Yesod description:         Drop in Transloadit capabilites for Yesod web apps license:             MIT@@ -18,6 +18,7 @@ library   exposed-modules:     Yesod.Transloadit   ghc-options:         -Wall+  other-modules:       Yesod.Transloadit.OrderedJSON   build-depends:       base < 5                        , aeson                        , text