~jonn/do-auth

ref: c5ec5c21709066bc9d788eefde6419b597c95225 do-auth/src/DoAuth/Json.hs -rw-r--r-- 1.2 KiB
c5ec5c21Jonn Problem: can't send detached signatures around 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
29
30
31
32
33
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module DoAuth.Json (b64encode, b64decode, base64StringDecode') 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.ByteString (ByteString (..))
import Data.Either (fromRight)
import Data.Text (Text)

-- | Encode a single Key-Value pair with Base64.
b64encode :: KeyValue a => Text -> ByteString -> [a]
b64encode label x =
    [ ("__HASKELL_BASE64_ENCODING__." <> label)
        .= (Bsu.toString . B64.encode) x
    ]

-- | Decodes a single-field Base64 object with the help of a constructor
--
-- TODO: Generalise over multi-field records.
b64decode :: Text -> (ByteString -> a) -> Value -> Parser a
b64decode label constructor = withObject "_" $ \obj -> do
  (x :: String) <-
    obj .: ("__HASKELL_BASE64_ENCODING__." <> label)
  pure $
    constructor $ base64StringDecode' "Challenge has to be valid Base64" x

-- | Very dangerous convenience function to decode base64-encoded strings
base64StringDecode' :: String -> String -> ByteString
base64StringDecode' msg x = fromRight (error msg) ((B64.decode . Bsu.fromString) x)