A simple key-value store.

KVStore.hs

#!/usr/bin/env stack
{- stack --resolver lts-7 --install-ghc runghc
    --package aeson
    --package servant-server
    --package text
    --package transformers
    --package unordered-containers
    --package warp
    -}

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Main where

import Control.Monad.IO.Class   (liftIO)
import Data.Aeson               (Value)
import Data.IORef               (IORef, newIORef, readIORef, atomicModifyIORef')
import Data.HashMap.Strict      (HashMap, lookup, insert, empty)
import Data.Text                (Text)
import Network.Wai.Handler.Warp (run)
import System.Environment       (getArgs)
import Prelude hiding           (lookup)
import Servant

type API
    =    "get" :> Capture "key" Text :> Get '[JSON] (Maybe Value)
    :<|> "put" :> Capture "key" Text
        :> ReqBody '[JSON] Value     :> Put '[JSON] Text

type Store = IORef (HashMap Text Value)

server :: Store -> Server API
server store = getValue store :<|> putValue store

getValue :: Store -> Text -> Handler (Maybe Value)
getValue store key = liftIO $ lookup key <$> readIORef store

putValue :: Store -> Text -> Value -> Handler Text
putValue store key value = liftIO $ atomicModifyIORef' store modify
    where modify kv = (insert key value kv, key)

kvAPI :: Proxy API
kvAPI = Proxy

main :: IO ()
main = do
    port <- read . head <$> getArgs :: IO Int
    run port . serve kvAPI . server =<< newIORef empty