diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rwxr-xr-x | main.hs | 70 | ||||
| -rw-r--r-- | test.http | 26 |
3 files changed, 98 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7d8757e --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +client_session_key.aes +.stack-work
\ No newline at end of file @@ -0,0 +1,70 @@ +#!/usr/bin/env stack +{- stack + --nix + --resolver lts-10.3 + --install-ghc + script + --package http-types + --package yesod + --package yesod-core + --package text + --package aeson +-} + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ScopedTypeVariables #-} + +import GHC.Generics +import Control.Monad +import Data.Maybe (isJust) +import Data.Text (Text, unpack) +import Yesod +import Network.HTTP.Types.Status (status400, status200) +import Data.Aeson + +data App = App + +mkYesod "App" [parseRoutes| +/query QueryR GET +/number NumberR POST +|] + +-- | Start a simple warp server on 3000 +main :: IO () +main = warp 3000 App + +-- | Initiate Yesod. The default method instances are fine for a prototype or +-- demo app. +instance Yesod App + +-- | A type to describe the shape of our core model +data Caller = Caller + { name :: Text + , number :: Text + , context :: Text + } + deriving (Show, Eq, Generic, ToJSON, FromJSON) + +-- FIXME +findByNumber = id + +getQueryR :: Handler RepJson +getQueryR = do + qm <- lookupGetParam "number" + case qm of + Nothing -> notFound + Just q -> + sendStatusJSON status200 $ object [ "msg" .= ("FIXME" :: Text) ] + + +postNumberR :: Handler RepJson +postNumberR = do + (obj :: Result Value) <- parseJsonBody + case obj of + Error err -> sendStatusJSON status400 $ object [ "msg" .= ("invalid body" :: Text) ] + Success v -> sendStatusJSON status200 $ object [ "msg" .= ("FIXME" :: Text) ] diff --git a/test.http b/test.http new file mode 100644 index 0000000..5827247 --- /dev/null +++ b/test.http @@ -0,0 +1,26 @@ +# -*- restclient -*- +# +# see https://github.com/pashky/restclient.el + +:host := "http://127.0.0.1:3000" +:headers = << +Accept: application/json +User-Agent: Emacs +# + +:form = << +Content-Type: application/x-www-form-urlencoded +# + +# should return {results: [{ “name”: “Bob Barker”, “number”: “+15556789090”, “context”: “personal”}]} +GET :host/query?number=%2B15556789090 +:headers + +# should return 200 +POST :host/number +:headers +{ + "name": "Jenny", + "number": "8675309", + "context": "Number on the wall" +} |