yesod-transloadit 0.2.1.0 → 0.3.0.0
raw patch · 4 files changed
+82/−29 lines, 4 filesdep +containersdep +unordered-containers
Dependencies added: containers, unordered-containers
Files
- src/Yesod/Transloadit.hs +48/−23
- src/Yesod/Transloadit/OrderedJSON.hs +1/−1
- test/Tests.hs +27/−3
- yesod-transloadit.cabal +6/−2
src/Yesod/Transloadit.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} @@ -13,8 +14,16 @@ transloadIt, handleTransloadit, tokenText,- extractFirstResult,- extractNthResult,+ nthStepResult,+ StepResult,+ resultId,+ name,+ baseName,+ extension,+ mime,+ field,+ url,+ sslUrl, ParamsResult, ParamsError(..), Key(..),@@ -25,13 +34,14 @@ ) where import Control.Applicative-import Control.Lens.Operators hiding ((.=))-import Control.Monad (mzero)+import Control.Lens+import Control.Monad 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 qualified Data.HashMap.Strict as HM import Data.Maybe import Data.Monoid import Data.Text@@ -67,6 +77,18 @@ transloaditSecret :: Secret } deriving (Show) +-- | The result of the execution of a single step+data StepResult = StepResult {+ _resultId :: Text,+ _name :: Text,+ _baseName :: Text,+ _extension :: Text,+ _mime :: Text,+ _field :: Text,+ _url :: Text,+ _sslUrl :: Text+} deriving (Show)+ data ParamsError = UnknownError type ParamsResult = Either ParamsError TransloaditParams @@ -84,15 +106,6 @@ 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- ]- -- 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@@ -144,15 +157,27 @@ d <- runInputPost $ TransloaditResponse <$> ireq hiddenField "transloadit" <*> ireq hiddenField "_token" t <- tokenText- return $ case token d == t of- True -> return $ raw d- _ -> Nothing+ return $ if token d == t then return (raw d) else Nothing --- | Helper method to pull the first @ssl_url@ from the Transloadit response.-extractFirstResult :: AsValue s => Text -> Maybe s -> Maybe Value-extractFirstResult = extractNthResult 0+_stepResult :: Getter Object (Maybe StepResult)+_stepResult = to parseResult --- | 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"+parseResult :: Object -> Maybe StepResult+parseResult hm = StepResult <$> v "id"+ <*> v "name"+ <*> v "basename"+ <*> v "ext"+ <*> v "mime"+ <*> v "field"+ <*> v "url"+ <*> v "ssl_url"+ where v s = case HM.lookup s hm of+ (Just (String t)) -> Just t+ _ -> Nothing++-- | Helper method to pull the nth @StepResult@ for a given key from the Transloadit response+nthStepResult :: AsValue s => Int -> Text -> Maybe s -> Maybe StepResult+nthStepResult _ _ Nothing = Nothing+nthStepResult i k (Just u) = join $ u ^? AL.key "results" . AL.key k . nth i . _Object . _stepResult++$(makeLenses ''StepResult)
src/Yesod/Transloadit/OrderedJSON.hs view
@@ -7,8 +7,8 @@ str ) where -import Data.Text import Data.Monoid (mconcat)+import Data.Text type KeyValue = (Text, OrderedValue)
test/Tests.hs view
@@ -6,6 +6,10 @@ module Main where +import Control.Lens+import Data.Aeson+import Data.Map+import Data.Maybe import Data.Text import Data.Time import System.Locale@@ -55,6 +59,13 @@ |] return () +sampleDict :: Map Text (Map Text [(Map Text Text)])+sampleDict = fromList [("results", results)]+ where results = fromList [("foo", stepResults)]+ stepResults = [fromList [("id","<id>"), ("name", "n"), ("basename", "b"), ("ext", "e"), ("mime", "m"), ("field", "f"), ("url", "u"), ("ssl_url", "<ssl_url>")]]++sampleResult = fromJust $ nthStepResult 0 "foo" (return $ encode sampleDict)+ formGenSpecs :: Spec formGenSpecs = yesodSpec Test $ do ydescribe "Form generation" $ do@@ -71,8 +82,21 @@ 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"))+ yit "grabs ssl_url" $ do+ assertEqual "ssl_url" (sampleResult ^. sslUrl) ("<ssl_url>" :: Text)+ yit "grabs id" $ do+ assertEqual "id" (sampleResult ^. resultId) ("<id>" :: Text)+ yit "grabs name" $ do+ assertEqual "name" (sampleResult ^. name) ("n" :: Text)+ yit "grabs basename" $ do+ assertEqual "basename" (sampleResult ^. baseName) ("b" :: Text)+ yit "grabs extension" $ do+ assertEqual "ext" (sampleResult ^. extension) ("e" :: Text)+ yit "grabs mime" $ do+ assertEqual "mime" (sampleResult ^. mime) ("m" :: Text)+ yit "grabs field" $ do+ assertEqual "field" (sampleResult ^. field) ("f" :: Text)+ yit "grabs url" $ do+ assertEqual "url" (sampleResult ^. url) ("u" :: Text) main = hspec formGenSpecs
yesod-transloadit.cabal view
@@ -1,5 +1,5 @@ name: yesod-transloadit-version: 0.2.1.0+version: 0.3.0.0 synopsis: Transloadit support for Yesod description: Drop in Transloadit capabilites for Yesod web apps license: MIT@@ -34,6 +34,7 @@ , lens , shakespeare , lens-aeson+ , unordered-containers hs-source-dirs: src default-language: Haskell2010@@ -52,6 +53,9 @@ yesod-form, time, old-locale,- text+ text,+ lens,+ aeson,+ containers default-language: Haskell2010