Giter Club home page Giter Club logo

servant-hmac-auth's Introduction

servant-hmac-auth

Hackage MIT license Stackage Lts Stackage Nightly

Servant authentication with HMAC

Example

In this section, we will introduce the client-server example. To run it locally you can:

$ cabal new-build
$ cabal new-exec readme

So,it will run this on your machine.

Setting up

Since this tutorial is written using Literate Haskell, first, let's write all necessary pragmas and imports.

{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeOperators              #-}

import Control.Concurrent (forkIO, threadDelay)
import Data.Aeson (FromJSON, ToJSON)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import Network.HTTP.Client (defaultManagerSettings, newManager)
import Network.Wai.Handler.Warp (run)
import Servant.API ((:>), Get, JSON)
import Servant.Client (BaseUrl (..), Scheme (..), ClientError, mkClientEnv)
import Servant.Server (Application, Server, serveWithContext)

import Servant.Auth.Hmac (HmacAuth, HmacClientM, SecretKey (..), defaultHmacSettings,
                          hmacAuthServerContext, hmacClient, runHmacClient, signSHA256)

Server

Let's define our TheAnswer data type with the necessary instances for it.

newtype TheAnswer = TheAnswer Int
    deriving (Show, Generic, FromJSON, ToJSON)

getTheAnswer :: TheAnswer
getTheAnswer = TheAnswer 42

Now, let's introduce a very simple protected endpoint. The value of TheAnswer data type will be the value that our API endpoint returns. It our case we want it to return the number 42 for all signed requests.

type TheAnswerToEverythingUnprotectedAPI = "answer" :> Get '[JSON] TheAnswer
type TheAnswerToEverythingAPI = HmacAuth :> TheAnswerToEverythingUnprotectedAPI

As you can see this endpoint is protected by HmacAuth.

And now our server:

server42 :: Server TheAnswerToEverythingAPI
server42 = \_ -> pure getTheAnswer

Now we can turn server into an actual webserver:

topSecret :: SecretKey
topSecret = SecretKey "top-secret"

app42 :: Application
app42 = serveWithContext
    (Proxy @TheAnswerToEverythingAPI)
    (hmacAuthServerContext signSHA256 topSecret)
    server42

Client

Now let's implement client that queries our server and signs every request automatically.

client42 :: HmacClientM TheAnswer
client42 = hmacClient @TheAnswerToEverythingUnprotectedAPI

Now we need to write function that runs our client:

runClient :: SecretKey -> HmacClientM a -> IO (Either ClientError a)
runClient sk client = do
    manager <- newManager defaultManagerSettings
    let env = mkClientEnv manager $ BaseUrl Http "localhost" 8080 ""
    runHmacClient (defaultHmacSettings sk) env client

Main

And we're able to run our server in separate thread and perform two quiries:

  • Properly signed
  • Signed with different key
main :: IO ()
main = do
    _ <- forkIO $ run 8080 app42

    print =<< runClient topSecret client42
    print =<< runClient (SecretKey "wrong!") client42

    threadDelay $ 10 ^ (6 :: Int)

servant-hmac-auth's People

Contributors

arbus avatar bargsteen avatar chshersh avatar jhrcek avatar kahlil29 avatar michivi avatar nitinprakash96 avatar ocharles avatar vrom911 avatar

Stargazers

 avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar

Watchers

 avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar

servant-hmac-auth's Issues

Implement Servant Auth that uses HMAC

Something like this:

type HmacAuth = AuthProtect "hmac-smth"

type instance AuthServerData (AuthProtect "hmac-smth") = ??? -- what should go here?

hmacAuthHandler :: AuthHandler Request ???
authHandler env = mkAuthHandler handler
  where
    handler :: Request -> Handler ???
    handler = error "Not Implemented"

Request for maintainership

As @circuithub use this in production, we're interested in keeping it current - and we'd love to help! Could I request maintainer access? I just plan to keep things building, not much more than that for now.

Pinging @arbus.

Convert `Request` from `servant-client` to `RequestPayload`

This data type in servant-client library:

Unfortunately, it's not enough to have only this data type. You also need to pass BaseUrl to this function:

BaseUrl is a part of ClientEnv, so if we have a monad that wraps ClientM we can assume that we have BaseUrl

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    ๐Ÿ–– Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. ๐Ÿ“Š๐Ÿ“ˆ๐ŸŽ‰

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google โค๏ธ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.