diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -18,12 +18,13 @@ ```haskell {-# LANGUAGE DeriveGeneric, OverloadedStrings #-} -import Data.Aeson (ToJSON, (.=)) +import Control.Monad (when) +import Data.Aeson (ToJSON, (.=), FromJSON) import Database.PostgreSQL.Simple -- For our automatic JSON instance: import GHC.Generics (Generic) import Gingersnap.Core -import Network.HTTP.Types.Status (internalServerError500) +import Network.HTTP.Types.Status (internalServerError500, unprocessableEntity422) import Snap.Core -- From the 'snap-server' package: import Snap.Http.Server (quickHttpServe) @@ -39,6 +40,7 @@ deriving (Show, Generic) instance ToJSON Character +instance FromJSON Character one :: Ctx -> Snap () one ctx = @@ -84,6 +86,7 @@ ("one", one ctx) , ("two", two ctx) , ("three", three ctx) + , ("four", method POST $ four ctx) ] ``` @@ -142,7 +145,7 @@ ``` $ curl 'localhost:8000/two' - {"result":{"age":6,"name":"Calvin"}} ~ $ + {"result":{"age":6,"name":"Calvin"}} Nice! This uses "inTransaction", another core tool in Gingersnap: @@ -162,6 +165,12 @@ (e.g. we could forget to commit/rollback in one case among many in a complicated branching expression) +If there's an error while running the `(Connection -> IO Rsp)` action: + - The transaction will be rolled back + - The `Connection` will be returned to the connection pool + - A JSON error response will be returned. If you're defining your own `ApiErr` + instance, that'll be `apiErr_unexpectedError` + ## Not everything's rspGood What if we don't want to send a successful ok200 message? Or maybe we don't even @@ -204,7 +213,7 @@ [...] < HTTP/1.1 500 Internal Server Error [...] - {"errorCode":6,"errorVals":[["n",0.250084751285613]],"errorMessage":"'n' too small"} + {"errorCode":6,"errorVals":[["n",0.2500847]],"errorMessage":"'n' too small"} If you'd like to write your own `ApiErr` instance (which you probably should if you're building something "real": @@ -212,6 +221,45 @@ for how to get a consistent JSON result. - You'll want to make that type the "CtxErrType" associated type for IsCtx +## Getting JSON + +We've sent a lot of JSON, but let's receive some! + +```haskell +four :: Ctx -> Snap () +four ctx = do + o <- reqObject ctx + character <- o .! "character" + amtToAge <- o .! "amt_to_age" + + when (amtToAge < (0 :: Int)) $ + errorEarlyCode $ + DefaultApiErr_Custom unprocessableEntity422 "Can't age backwards!" [] + + inTransaction ctx $ \conn -> do + [Only newAge] <- query conn " SELECT ? + ? " (age character, amtToAge) + pure $ rspGood $ character { age = newAge } +``` + +(Note with a custom `ApiErr` instance you won't have to specify the HTTP +response like 'unprocessableEntity422' etc.) + + $ curl 'localhost:8000/four' --data '{"character": {"name": "Calvin", "age": 6}, "amt_to_age": 1}' + + {"result":{"age":7,"name":"Calvin"}} + +`(.!)` requires that the value be present and short-circuits with a JSON error +if it's not or if it's malformed (i.e. if `fromJSON` would fail) + +`(.!?)` doesn't require the value to be present - it returns a `Maybe` value. If +the key is present but the value is malformed, however, it'll return a JSON error. + +A few things to note: + - If everything's not okay with the JSON inputs to the function, we never even + make it to the DB. + - `errorEarlyCode` is like (and uses) Snap's `finishWith`, but we don't have + to worry about a resource leak since `inTransaction` is separate + ## Not everything's JSON A JSON API is usually JSON but if you'd like to e.g. send a CSV or a file there @@ -219,10 +267,10 @@ If you don't see a function you need it's easy to define your own. + ## Other things to discover This tutorial is a work in progress, and these'll be the next concepts to be touched on: - - reqObject and (.!) for receiving JSON - returning JSON even when throwing an error diff --git a/gingersnap.cabal b/gingersnap.cabal --- a/gingersnap.cabal +++ b/gingersnap.cabal @@ -1,5 +1,5 @@ name: gingersnap -version: 0.2.2.2 +version: 0.2.2.3 synopsis: Tools for consistent and safe JSON APIs with snap-core and postgresql-simple description: diff --git a/src/Gingersnap/Core.hs b/src/Gingersnap/Core.hs --- a/src/Gingersnap/Core.hs +++ b/src/Gingersnap/Core.hs @@ -12,16 +12,16 @@ module Gingersnap.Core ( -- * Rsp - Rsp(..) - - , rspGood + rspGood , rspBad , rspBadCommit , rspBadRollback , rspGoodCSV , rspGoodLBS , rspEmptyGood + , Rsp(..) + -- * pureRsp , pureRsp @@ -321,11 +321,7 @@ RspPayload_Empty -> "Empty" RspPayload_Custom a b c -> "(Custom "++show (a,b,c)++")" --- | *If you hit the DB, use this function!* --- --- This is a lot like 'withTransaction', but it allows us to rollback if we --- want, without throwing an error. --- (Don't use 'withTransaction'!) +-- | _If you hit the DB, use this function!_ -- -- NOTE this is for IO actions, not Snap actions. This is to ensure we can't -- call e.g. 'finishEarly' and never hit the 'end transaction' code! @@ -344,7 +340,7 @@ inTransaction_readOnly ctx f = inTransactionMode ctx PSQL.Serializable PSQL.ReadOnly f --- | YOU SHOULD ONLY USE THIS ONCE +-- | _You should only use this once!_ -- -- This lets you do a write transaction during read-only mode (not a -- read-only transaction! A time where 'ctxGetReadOnlyMode' would return @@ -420,15 +416,12 @@ Snap.setHeader "Content-Type" "application/json" Snap.writeLBS $ JSON.encode $ x --- | NOTE: be very careful to not use this with any setup/teardown block like 'withTransaction' --- - causes resource leaks --- - BUT! This should never happen to you because all your DB code should --- use 'inTransaction'! --- --- NOTE: use 403 forbidden instead of unauthorized - unauth means not logged in at all --- --- Also note this returns any 'Snap x' so you can use it like a throw anywhere +-- | This returns any 'Snap x' so you can use it like a throw anywhere -- in your snap code +-- +-- NOTE: if you ever use 's 'withTransaction' (which we don't recommend!) +-- this function has the same caveats as 'finishWith' + errorEarlyCode :: ApiErr ae => ae -> Snap x errorEarlyCode err = do writeApiErr err