diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,79 @@ +# servant-dhall - Servant Dhall bindings + +![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) + +Note: accepting dhall expressions from untrusted sources is a security risk. + +## Example + +Run example + +``` +cabal new-run example run +``` + +### Get + +``` +% curl 'localhost:8000/get' +[ +1, +2, +3, +4, +5, +6, +7, +8, +9, +10 ] : List Integer +``` + +### Post + +``` +% curl -D - -X POST -H 'Content-Type: application/x-dhall' --data-raw '[+10,+20]' 'localhost:8000/post' +HTTP/1.1 200 OK +Transfer-Encoding: chunked +Date: Wed, 13 Jun 2018 10:41:07 GMT +Server: Warp/3.2.22 +Content-Type: application/x-dhall + +[ +11, +21 ] : List Integer +``` + +### Error case: Unexpected type + +``` +% curl -D - -X POST -H 'Content-Type: application/x-dhall' --data-raw '[10]' 'localhost:8000/post' +curl: (7) Failed to connect to localhost port 8000: Connection refused +[FL973] ~/Documents/public-haskell/servant-dhall % curl -D - -X POST -H 'Content-Type: application/x-dhall' --data-raw '[10]' 'localhost:8000/post' +HTTP/1.1 400 Bad Request +Transfer-Encoding: chunked +Date: Wed, 13 Jun 2018 10:45:39 GMT +Server: Warp/3.2.22 + +Expected and actual types don't match : List Integer /= List Natural +``` + +### Error case: Type error + +``` +% curl -D - -X POST -H 'Content-Type: application/x-dhall' --data-raw 'True && +1' 'localhost:8000/post' +HTTP/1.1 400 Bad Request +Transfer-Encoding: chunked +Date: Wed, 13 Jun 2018 10:51:52 GMT +Server: Warp/3.2.22 + +Type error: +Error: ❰&&❱ only works on ❰Bool❱s + +True && +1 + +(input):1:1 +``` + +### Error case: Imports + +As deserialisation is done in pure context type-checking Dhall expressions with +imports is not possible. + +``` +% curl -D - -X POST -H 'Content-Type: application/x-dhall' --data-raw 'http://example.com/dhall' 'localhost:8000/post' +HTTP/1.1 400 Bad Request +Transfer-Encoding: chunked +Date: Wed, 13 Jun 2018 10:53:52 GMT +Server: Warp/3.2.22 + +Import found: http://example.com/dhall +``` diff --git a/servant-dhall.cabal b/servant-dhall.cabal --- a/servant-dhall.cabal +++ b/servant-dhall.cabal @@ -1,19 +1,19 @@ name: servant-dhall -version: 0.1 +version: 0.1.0.1 synopsis: Servant Dhall content-type description: Servant Dhall bindings. . - Provides @MineRender@ and @MimeUnrender@ instances. + Provides @MimeRender@ and @MimeUnrender@ instances. So you can accept and return Dhall expressions. . - /Note:/ Reading (and evaluating) Dhall expressions from untrust4ed source is a security risk. + /Note:/ Reading (and evaluating) Dhall expressions from untrusted sources is a security risk. homepage: http://haskell-servant.readthedocs.org/ license: BSD3 license-file: LICENSE author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com -copyright: 2015-2016 Servant Contributors +copyright: 2018 Servant Contributors category: Web, Servant, Dhall build-type: Simple cabal-version: >=1.10 @@ -22,6 +22,8 @@ GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 +extra-source-files: + README.md source-repository head type: git @@ -32,13 +34,12 @@ build-depends: base >=4.9 && <4.12 , base-compat >=0.10.1 && <0.11 , bytestring >=0.10.4.0 && <0.11 - , dhall >=1.14.0 && <1.15 - , formatting >=6.3.4 && <6.4 + , dhall >=1.15.1 && <1.16 , megaparsec >=6.5.0 && <6.6 , prettyprinter >=1.2.0.1 && <1.3 - , servant >=0.13 && <0.14 + , servant >=0.13 && <0.15 , text >=1.2.3.0 && <1.3 - , http-media + , http-media >=0.7.1.2 && <0.8 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Servant/Dhall.hs b/src/Servant/Dhall.hs --- a/src/Servant/Dhall.hs +++ b/src/Servant/Dhall.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} @@ -31,10 +32,10 @@ import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.Encoding as TLE import Data.Text.Prettyprint.Doc - (defaultLayoutOptions, layoutPretty, layoutSmart, line) + (Pretty (pretty), defaultLayoutOptions, layoutPretty, + layoutSmart, line) import Data.Text.Prettyprint.Doc.Render.String (renderString) import Data.Text.Prettyprint.Doc.Render.Text @@ -49,11 +50,7 @@ import qualified Dhall.Core import Dhall.Parser (exprFromText, unwrap) -import Dhall.Pretty - (prettyExpr) import qualified Dhall.TypeCheck -import Formatting.Buildable - (Buildable (..)) import qualified Network.HTTP.Media as M import Servant.API (Accept (..), MimeRender (..), MimeUnrender (..)) @@ -75,7 +72,7 @@ $ renderLazy $ layoutSmart defaultLayoutOptions $ (`mappend` line) - $ prettyExpr + $ pretty $ embed ty x where ty :: InputType a @@ -88,7 +85,7 @@ instance (Interpret a, HasInterpretOptions opts) => MimeUnrender (DHALL' opts) a where mimeUnrender _ lbs = do expr0 <- firstEither showParseError $ exprFromText "(input)" te - expr1 <- for expr0 $ \i -> Left $ "Import found: " ++ fromBuildable i + expr1 <- for expr0 $ \i -> Left $ "Import found: " ++ ppExpr i tyExpr <- firstEither showTypeError $ Dhall.TypeCheck.typeOf expr1 unless (Dhall.Core.judgmentallyEqual tyExpr $ expected ty) $ Left $ "Expected and actual types don't match : " @@ -98,17 +95,16 @@ Nothing -> Left "Invalid type" where showParseError = MP.parseErrorPretty . unwrap - showTypeError e = "Type error: " ++ fromBuildable e + showTypeError e = "Type error: " ++ ppExpr e - te = TLE.decodeUtf8With lenientDecode lbs + te = TL.toStrict $ + TLE.decodeUtf8With lenientDecode lbs ty :: Type a ty = autoWith (interpretOptions (Proxy :: Proxy opts)) - ppExpr = renderString . layoutPretty defaultLayoutOptions . prettyExpr - - fromBuildable :: Buildable b => b -> String - fromBuildable = TL.unpack . TLB.toLazyText . build + ppExpr :: Pretty pp => pp -> String + ppExpr = renderString . layoutPretty defaultLayoutOptions . pretty firstEither :: (a -> b) -> Either a c -> Either b c firstEither f (Left a) = Left (f a)