Init basic functionality

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
diff --git a/main.hs b/main.hs
new file mode 100755
index 0000000..dc1d440
--- /dev/null
+++ b/main.hs
@@ -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"
+}