~jonn/do-auth

ref: e9acaf7c2d98b8aea72680b08c70b0f86572d687 do-auth/src/DoAuth/Json.hs -rw-r--r-- 871 bytes
e9acaf7cJonn Problem: Need B64 to send signed challenge back 1 year, 13 days ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module DoAuth.Json (b64encode, b64decode) where

import Data.Aeson (KeyValue ((.=)), Value, object, withObject, (.:))
import Data.Aeson.Types (Parser)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.UTF8 as Bsu
import Data.Either (fromRight)
import Data.Text (Text)

b64encode :: Text -> Bsu.ByteString -> Value
b64encode label x =
  object
    [ ("__HASKELL_BASE64_ENCODING__." <> label)
        .= (Bsu.toString . B64.encode) x
    ]

b64decode :: Text -> (Bsu.ByteString -> a) -> Value -> Parser a
b64decode label constructor = withObject "_" $ \obj -> do
  (x :: String) <-
    obj .: ("__HASKELL_BASE64_ENCODING__." <> label)
  pure $
    constructor $
      fromRight
        (error "Challenge has to be valid Base64")
        ((B64.decode . Bsu.fromString) x)